R: Examples for 'Matrix::image-methods'

### ** Examples

showMethods(image)

Function: image (package graphics)
x="ANY"
x="CHMfactor"
x="dgTMatrix"
x="Matrix"

## If you want to see all the methods' implementations:
showMethods(image, incl=TRUE, inherit=FALSE)

Function: image (package graphics)
x="ANY"
function (x, ...) 
UseMethod("image")


x="CHMfactor"
function (x, ...) 
image(.sparse2g(as(x, "TsparseMatrix")), ...)


x="dgTMatrix"
function (x, ...) 
{
    .local <- function (x, xlim = c(1, di[2L]), ylim = c(di[1L], 
        1), aspect = "iso", sub = sprintf("Dimensions: %d x %d", 
        di[1L], di[2L]), xlab = "Column", ylab = "Row", cuts = 15, 
        useRaster = FALSE, useAbs = NULL, colorkey = !useAbs, 
        col.regions = NULL, lwd = NULL, border.col = NULL, ...) 
    {
        di <- x@Dim
        xx <- x@x
        empty.x <- length(xx) == 0L && length(x) > 0L
        if (empty.x) {
            xx <- 0
            x@i <- x@j <- 0L
        }
        if (missing(useAbs)) 
            useAbs <- if (empty.x) 
                FALSE
            else min(xx, na.rm = TRUE) >= 0
        else if (useAbs) 
            xx <- abs(xx)
        if (is.null(col.regions)) {
            l.col <- empty.x || diff(rx <- range(xx, finite = TRUE)) == 
                0
            col.regions <- if (useAbs) {
                grey(if (l.col) 
                  0.9
                else seq(from = 0.7, to = 0, length.out = 100L))
            }
            else if (l.col) 
                "gray90"
            else {
                nn <- 100
                n0 <- min(nn, max(0, round((0 - rx[1L])/(rx[2L] - 
                  rx[1L]) * nn)))
                col.regions <- c(colorRampPalette(c("blue3", 
                  "gray80"))(n0), colorRampPalette(c("gray75", 
                  "red3"))(nn - n0))
            }
        }
        if (!is.null(lwd) && !(is.numeric(lwd) && all(lwd >= 
            0))) 
            stop("'lwd' must be NULL or non-negative numeric")
        stopifnot(length(xlim) == 2L, length(ylim) == 2L)
        ylim <- sort(ylim, decreasing = TRUE)
        if (all(xlim == round(xlim))) 
            xlim <- xlim + c(-0.5, +0.5)
        if (all(ylim == round(ylim))) 
            ylim <- ylim + c(+0.5, -0.5)
        panel <- if (useRaster) 
            panel.levelplot.raster
        else {
            function(x, y, z, subscripts, at, ..., col.regions) {
                x <- as.numeric(x[subscripts])
                y <- as.numeric(y[subscripts])
                numcol <- length(at) - 1L
                num.r <- length(col.regions)
                col.regions <- if (num.r <= numcol) 
                  rep_len(col.regions, numcol)
                else col.regions[1 + ((1:numcol - 1) * (num.r - 
                  1))%/%(numcol - 1)]
                zcol <- rep.int(NA_integer_, length(z))
                for (i in seq_along(col.regions)) zcol[!is.na(x) & 
                  !is.na(y) & !is.na(z) & at[i] <= z & z < at[i + 
                  1L]] <- i
                zcol <- zcol[subscripts]
                if (any(subscripts)) {
                  if (is.null(lwd)) {
                    wh <- grid::current.viewport()[c("width", 
                      "height")]
                    wh <- (par("cra")/par("cin")) * c(grid::convertWidth(wh$width, 
                      "inches", valueOnly = TRUE), grid::convertHeight(wh$height, 
                      "inches", valueOnly = TRUE))
                    pSize <- wh/di
                    pA <- prod(pSize)
                    p1 <- min(pSize)
                    lwd <- if (p1 < 2 || pA < 6) 
                      0.01
                    else if (p1 >= 4) 
                      1
                    else if (p1 > 3) 
                      0.5
                    else 0.2
                    Matrix.msg("rectangle size ", paste(round(pSize, 
                      1L), collapse = " x "), " [pixels];  --> lwd :", 
                      formatC(lwd))
                  }
                  else stopifnot(is.numeric(lwd), all(lwd >= 
                    0))
                  if (is.null(border.col) && lwd < 0.01) 
                    border.col <- NA
                  grid.rect(x = x, y = y, width = 1, height = 1, 
                    default.units = "native", gp = gpar(fill = col.regions[zcol], 
                      lwd = lwd, col = border.col))
                }
            }
        }
        levelplot(xx ~ (x@j + 1L) * (x@i + 1L), sub = sub, xlab = xlab, 
            ylab = ylab, xlim = xlim, ylim = ylim, aspect = aspect, 
            colorkey = colorkey, col.regions = col.regions, cuts = cuts, 
            par.settings = list(background = list(col = "transparent")), 
            panel = panel, ...)
    }
    .local(x, ...)
}


x="Matrix"
function (x, ...) 
image(..sparse2d(.sparse2g(as(x, "TsparseMatrix"))), ...)

## Don't show: 
## warnings should not happen here, notably when print(<trellis>)
op <- options(warn = 2)
## End(Don't show)
data(CAex)
image(CAex, main = "image(CAex)") -> imgC; imgC

plot of chunk example-Matrix-image-methods-1

stopifnot(!is.null(leg <- imgC$legend), is.list(leg$right)) # failed for 2 days ..
image(CAex, useAbs=TRUE, main = "image(CAex, useAbs=TRUE)")

cCA <- Cholesky(crossprod(CAex), Imult = .01)
## See  ?print.trellis --- place two image() plots side by side:
print(image(cCA, main="Cholesky(crossprod(CAex), Imult = .01)"),
      split=c(x=1,y=1,nx=2, ny=1), more=TRUE)
print(image(cCA, useAbs=TRUE),
      split=c(x=2,y=1,nx=2,ny=1))

data(USCounties)
image(USCounties)# huge

image(sign(USCounties))## just the pattern

    # how the result looks, may depend heavily on
    # the device, screen resolution, antialiasing etc
    # e.g. x11(type="Xlib") may show very differently than cairo-based

## Drawing borders around each rectangle;
    # again, viewing depends very much on the device:
image(USCounties[1:400,1:200], lwd=.1)

## Using (xlim,ylim) has advantage : matrix dimension and (col/row) indices:
image(USCounties, c(1,200), c(1,400), lwd=.1)

image(USCounties, c(1,300), c(1,200), lwd=.5 )

image(USCounties, c(1,300), c(1,200), lwd=.01)

## These 3 are all equivalent :
(I1 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE))

 I2 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE,        border.col=NA)
 I3 <- image(USCounties, c(1,100), c(1,100), useAbs=FALSE, lwd=2, border.col=NA)
stopifnot(all.equal(I1, I2, check.environment=FALSE),
          all.equal(I2, I3, check.environment=FALSE))
## using an opaque border color
image(USCounties, c(1,100), c(1,100), useAbs=FALSE, lwd=3, border.col = adjustcolor("skyblue", 1/2))

## Don't show: 
options(op)
## End(Don't show)
if(interactive() || nzchar(Sys.getenv("R_MATRIX_CHECK_EXTRA"))) {
## Using raster graphics: For PDF this would give a 77 MB file,
## however, for such a large matrix, this is typically considerably
## *slower* (than vector graphics rectangles) in most cases :
if(doPNG <- !dev.interactive())
   png("image-USCounties-raster.png", width=3200, height=3200)
image(USCounties, useRaster = TRUE) # should not suffer from anti-aliasing
if(doPNG)
   dev.off()
   ## and now look at the *.png image in a viewer you can easily zoom in and out
}#only if(doExtras)

png 
  2

Examples for 'Matrix::image-methods'

Methods for image() in Package 'Matrix'