tensor_predictors/tensorPredictors/R/matrixImage.R

66 lines
2.6 KiB
R
Raw Normal View History

2021-12-09 12:21:38 +00:00
#' Plots a matrix as an image
2021-12-07 14:03:47 +00:00
#'
#' @param A a matrix to be plotted
2022-01-13 10:13:34 +00:00
#' @param add.values boolean indicating if matrix values are to be written into
#' matrix element boxes
2021-12-07 14:03:47 +00:00
#' @param main overall title for the plot
2021-12-09 12:21:38 +00:00
#' @param sub sub-title of the plot
2021-12-07 14:03:47 +00:00
#' @param interpolate a logical vector (or scalar) indicating whether to apply
#' linear interpolation to the image when drawing.
2023-11-14 13:35:43 +00:00
#' @param new.plot Recreating the plot area (clearing the plot device). can be
#' used to update a plot but _not_ recreate it. Leads to smoother updating.
2021-12-07 14:03:47 +00:00
#' @param ... further arguments passed to \code{\link{rasterImage}}
#'
2022-01-13 10:13:34 +00:00
#' @examples
#' AR <- 0.5^abs(outer(1:10, 1:10, `-`))
#' matrixImage(AR, AR > 0.2, main = "Autoregressiv Covariance")
#'
2021-12-07 14:03:47 +00:00
#' @export
2022-01-13 10:13:34 +00:00
matrixImage <- function(A, add.values = FALSE,
main = NULL, sub = NULL, interpolate = FALSE, ..., zlim = NA,
2023-11-14 13:35:43 +00:00
axes = TRUE, asp = 1, col = hcl.colors(24, "Blue-Red 3", rev = FALSE),
col.values = par("col"), cex = 1,
2023-11-14 13:35:43 +00:00
digits = getOption("digits"), new.plot = TRUE
2022-01-13 10:13:34 +00:00
) {
2021-12-07 14:03:47 +00:00
# plot raster image
2023-11-14 13:35:43 +00:00
if (new.plot) {
plot(c(0, ncol(A)), c(0, nrow(A)), type = "n", bty = "n", col = "black",
xlab = "", ylab = "", xaxt = "n", yaxt = "n", main = main, sub = sub,
asp = asp)
}
2021-12-07 14:03:47 +00:00
2022-01-13 10:13:34 +00:00
# Scale values of `A` to [0, 1] with min mapped to 1 and max to 0.
if (missing(zlim)) {
S <- (max(A) - A) / diff(range(A))
} else {
S <- pmin(pmax(0, (zlim[2] - A) / diff(zlim)), 1)
}
# and not transform to color
S <- matrix(col[round((length(col) - 1) * S + 1)], nrow = nrow(A))
2022-01-13 10:13:34 +00:00
# Raster Image ploting the matrix with element values mapped to grayscale
# as big elements (original matrix A) are dark and small (negative) elements
# are white.
rasterImage(S, 0, 0, ncol(A), nrow(A), interpolate = interpolate, ...)
# X/Y axes index (matches coordinates to matrix indices)
2022-01-13 10:13:34 +00:00
x <- seq(1, ncol(A), by = 1)
y <- seq(1, nrow(A))
2023-11-14 13:35:43 +00:00
if (axes && new.plot) {
if (!is.character(xlabels <- colnames(A))) { xlabels <- x }
if (!is.character(ylabels <- rownames(A))) { ylabels <- y }
axis(1, at = x - 0.5, labels = xlabels, lwd = 0, lwd.ticks = 1)
axis(2, at = y - 0.5, labels = rev(ylabels), lwd = 0, lwd.ticks = 1, las = 1)
}
2021-12-07 14:03:47 +00:00
# Writes matrix values
2022-01-13 10:13:34 +00:00
if (any(add.values)) {
2022-03-22 15:26:24 +00:00
if (length(add.values) > 1) {
A[!add.values] <- NA
A[add.values] <- format(A[add.values], digits = digits)
}
text(rep(x - 0.5, each = nrow(A)), rep(rev(y - 0.5), ncol(A)), A,
adj = 0.5, cex = cex, col = col.values)
2022-01-13 10:13:34 +00:00
}
2021-12-07 14:03:47 +00:00
}