Last active
April 21, 2020 13:46
-
-
Save srgorelik/feb2d257cfa5d62d17351e44d2213af1 to your computer and use it in GitHub Desktop.
Quickly visualize a matrix or raster in R.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
img <- function(x, pal = 'j', cut = F, brks = 10, units = '', rev.pal = F, vals = F, axes = T, | |
na.col = 'black', fg = 'black', bg = 'white', draw.cells = F, legend = T, ...) { | |
# -------------------------------------------------------------------------------- | |
# Purpose: | |
# Quickly plot an image (using matrix or raster objects). | |
# | |
# Arguments: | |
# x Either a matrix or raster object. | |
# pal Color palette code (either letter or number selection). | |
# cut A logical flag to use a discrete color ramp instead of a continuous one. | |
# brks Either a single integer specifying the number of breaks or a vector | |
# specifying the exact breaks to create. | |
# units A string or expression specifying the units of the cell values. | |
# rev.pal A logical flag to reverse the color palette. | |
# vals Print cell values at the center of each grid cell. | |
# axes A logical flag to draw the axes including the tick marks and labels. | |
# na.col The color used for NoData cells. | |
# fg Foreground (text and lines) color. | |
# bg Background color. | |
# draw.cells A logical flag to draw borders around grid cells. | |
# legend A logical flag to draw or hide the legend. | |
# ... Additional arguments for rasterVis::levelplot and/or lattice:levelplot. | |
# | |
# Author: | |
# Seth Gorelik - October 2018 | |
# -------------------------------------------------------------------------------- | |
for (pkg in c('rasterVis','grid','colorRamps','viridis','matlab')) require(pkg, character.only = T, quietly = T, warn.conflicts = F) | |
col.pal <- switch(pal, | |
j = jet.colors(256), | |
v = viridis(256), | |
m = magma(256), | |
i = inferno(256), | |
p = plasma(256), | |
t = terrain.colors(256), | |
r = rainbow(256), | |
g = gray.colors(256), | |
s = colorRampPalette(brewer.pal(11, 'Spectral'))(256), | |
b = blue2red(256), | |
l = matlab.like(256), | |
1) | |
if ((length(col.pal) == 1) | (is.null(col.pal))) stop('incorrect color palette choice.', call. = F) | |
if (rev.pal) col.pal <- rev(col.pal) | |
min <- floor(min(as.matrix(x), na.rm = T)) | |
max <- ceiling(max(as.matrix(x), na.rm = T)) | |
if (!is.logical(cut)) { | |
stop('cut must be TRUE or FALSE.', call. = F) | |
} else if (!cut) { # continuous | |
brks <- seq(min, max, by = ((max-min)/256)) | |
ck <- list() | |
} else { # discrete | |
is.scalar <- function(x) is.atomic(x) && length(x) == 1L | |
if (is.scalar(brks)) brks <- seq(min, max, by = ((max-min)/brks)) | |
ck <- list(at = brks, labels = list(at = brks)) | |
} | |
if (!legend) ck <- F | |
if (is.matrix(x)) { | |
x <- t(apply(x, 2, rev)) | |
} | |
p <- levelplot(x, margin = F, ylab.right = units, col.regions = col.pal, at = brks, colorkey = ck, ...) | |
p$par.settings$panel.background$col <- na.col | |
p$par.settings$axis.line$col <- fg | |
p$par.settings$axis.text$col <- fg | |
p$par.settings$add.text$col <- fg | |
p$par.settings$background$col <- bg | |
p$par.settings$layout.heights$main <- 1.5 | |
p$par.settings$layout.heights$top.padding <- 2 | |
p$par.settings$layout.widths$axis.key.padding <- 1 | |
p$par.settings$layout.widths$ylab.right <- 2 | |
p$par.settings$par.ylab.text$col <- fg | |
if (is.matrix(x)) { | |
p$xlab <- 'column' | |
p$ylab <- 'row' | |
} | |
if (!axes) p$xlab <- p$ylab <- '' | |
p$main <- list(p$main, col = fg, font = 1) | |
p$xlab <- list(p$xlab, col = fg) | |
p$ylab <- list(p$ylab, col = fg) | |
p$x.scales$draw <- axes | |
p$y.scales$draw <- axes | |
if (vals) { | |
p$panel <- function(x, y, z, ..., subscripts = subscripts) { | |
panel.levelplot(x, y, z, ..., subscripts = subscripts) | |
panel.text(x = x[subscripts], | |
y = y[subscripts], | |
labels = round(z[subscripts], 1)) | |
} | |
} | |
if (draw.cells) { | |
p <- p + layer(panel.grid(h = 1, v = 1, col.line = fg), data = list(fg = fg)) | |
} | |
update(p, aspect = 1) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Examples using a dummy matrix:
To print values of cells at the center of grid cells:
To hide the legend:
Examples using a raster:
To plot a raster stack: