R/GA_diagplot.R

In RepeatedHighDim: Methods for High-Dimensional Repeated Measures Data

#' A diagnostic plot that compares the entries of two correlation
#' matrices using a color scale.
#'
#' A diagnostic plot that compares the entries of two correlation
#' matrices using a color scale.
#' @title Diagnostic plot for comparison of two correlation matrices.
#' @param R Specified correlation matrix.
#' @param Rt Correlation matrix of the data generated by the genetic
#'   algorithm.
#' @param eps Permitted difference between the entries of two
#'   matrices. Must only be specified if col.method="trafficlight".
#' @param col.method Method to use for color scaling the difference
#'   between the matrices. If method="trafficlight" only two colors
#'   are used, indicating whether the entries deviated at least by a
#'   difference of eps. If method="updown" a discrete gray scale is
#'   used.
#' @param color Value of two color that are used if method="trafficlight"
#' @param top Specifies the main title of the plot
#' @return NULL
#' @author Jochen Kruppa, Klaus Jung
#' @references
#' Kruppa, J., Lepenies, B., & Jung, K. (2018). A genetic algorithm for simulating correlated binary data from biomedical research. \emph{Computers in biology and medicine}, \strong{92}, 1-8. \doi{10.1016/j.compbiomed.2017.10.023}
#' @importFrom  graphics rect
#' @importFrom  graphics text
#' @importFrom  graphics box
#' @importFrom  graphics grid
#' @importFrom grDevices gray
#' @export
#' @examples
#' R1 = diag(10)
#' X0 <- start_matrix(p=c(0.4, 0.2, 0.5, 0.15, 0.4, 0.35, 0.2, 0.25, 0.3, 0.4), k = 5000)
#' Xt <- iter_matrix(X0, R = diag(10), T = 10000, e.min = 0.00001)
#' GA_diagplot(R1, Rt = Xt$Rt, col.method = "trafficlight")
#' GA_diagplot(R1, Rt = Xt$Rt, col.method = "updown")
GA_diagplot <- function(R, Rt, eps=0.05, col.method="trafficlight", color=c(0, 8), top="") {
  rotate = function(x) t(apply(x, 2, rev))
  D = R - Rt
  D = rotate(D)
  m = dim(D)[1]
  if (col.method=="trafficlight") {
    COL = matrix(color[1], m, m)
    plot(0:m, 0:m, type="n", axes=FALSE, xlab="", ylab="", main=top)
    for (i in 0:(m-1)) {
      for (j in 0:(m-1)) {
        if (abs(D[i+1,j+1])>eps) COL[i+1,j+1] = color[2]
        rect(i, j, i+1, j+1, col=COL[i+1,j+1], border=0)
      }}
  }
  if (col.method=="updown") {
    COL0 = gray(seq(1, 0, length.out=21))
    COL = matrix(COL0[11], m, m)
    plot(0:m, 0:m, type="n", axes=FALSE, xlab="", ylab="", main=top)
    for (i in 0:(m-1)) {
      for (j in 0:(m-1)) {
        COL[i+1,j+1] = COL0[round(100*D[i+1,j+1]+11)]
        rect(i, j, i+1, j+1, col=COL[i+1,j+1], border=0)
      }}
  }
  for (i in 1:m) text(i-0.5, m-0.5, i)
  for (i in 2:m) text(0.5, m-0.5-(i-1), i)
  box()
}