https://github.com/cran/fields
Tip revision: ce722edae3c1b9e1af2985ce3500b11058facf0e authored by Doug Nychka on 24 August 2006, 01:46:17 UTC
version 3.04
version 3.04
Tip revision: ce722ed
image.plot.R
"image.plot" <-
function (..., add = FALSE, nlevel = 64, legend.shrink = 0.9,
legend.width = 1.2, legend.mar = NULL, graphics.reset = FALSE,
horizontal = FALSE, bigplot = NULL, smallplot = NULL, legend.only = FALSE,
col = tim.colors(nlevel))
{
old.par <- par(no.readonly = TRUE)
# figure out zlim from passed arguments
info <- image.plot.info(...)
if (add) {
big.plot <- old.par$plt
}
if (legend.only) {
graphics.reset <- TRUE
}
if (is.null(legend.mar)) {
legend.mar <- ifelse(horizontal, 3.1,5.1)
}
#
# figure out how to divide up the plotting real estate.
#
temp <- image.plot.plt(add = add, legend.shrink = legend.shrink,
legend.width = legend.width, legend.mar = legend.mar,
horizontal = horizontal, bigplot = bigplot, smallplot = smallplot)
#
# bigplot are plotting region coordinates for image
# smallplot are plotting coordinates for legend
smallplot <- temp$smallplot
bigplot <- temp$bigplot
#
# draw the image in bigplot, just call the R base function
#
if (!legend.only) {
if (!add) {
par(plt = bigplot) }
image(..., add = add, col = col)
# add a box
box()
big.par <- par(no.readonly = TRUE)
}
##
## check dimensions of smallplot
if ((smallplot[2] < smallplot[1]) | (smallplot[4] < smallplot[3])) {
par(old.par)
stop("plot region too small to add legend\n")
}
# Following code draws the legend using the image function
# and a one column image.
#
# OLD code misaligns iy <- seq(info$zlim[1], info$zlim[2], , nlevel)
# This is corrected -- thanks to S. Woodhead
#
ix <- 1
minz <- info$zlim[1]
maxz <- info$zlim[2]
binwidth <- (maxz - minz) / nlevel
midpoints <- seq(minz + binwidth/2, maxz - binwidth/2, by = binwidth)
iy <- midpoints
iz <- matrix(iy, nrow = 1, ncol = length(iy))
breaks<- list(...)$breaks
# draw either horizontal or vertical legends.
# either using either suggested breaks or not
# -- a total of four cases.
# modify the lines for axis or image to fine tune how legend looks
#
# next par line sets up a new plotting region just for the legend strip
# at the plot coordinates
par(new = TRUE, pty = "m", plt = smallplot, err = -1)
if (!horizontal) {
if( is.null( breaks)){
image(ix, iy, iz, xaxt = "n", yaxt = "n", xlab = "",
ylab = "", col = col )
axis(4, mgp = c(3, 1, 0), las = 2)}
else{
image(ix, iy, iz,
xaxt = "n", yaxt = "n", xlab = "", ylab = "",
col = col, breaks=breaks )
#
# add axis but label where there are breaks
axis(4, at=breaks, labels=format( breaks), mgp = c(3, 1, 0), las = 2)}
}
else {
if( is.null( breaks)){
image(iy, ix, t(iz), xaxt="n",yaxt = "n", xlab = "", ylab = "",
col = col)
axis(1, mgp = c(3, 1, 0))}
else{
image(iy, ix, t(iz),
xaxt = "n", yaxt = "n", xlab = "", ylab = "",
col = col, breaks=breaks )
axis(1, at=breaks, labels=format( breaks), mgp = c(3, 1, 0))}
}
# add a box around legend strip
box()
# clean up graphics device settings
# reset to larger plot region with right user coordinates.
mfg.save <- par()$mfg
if (graphics.reset | add) {
par(old.par)
par(mfg = mfg.save, new = FALSE)
invisible()
}
else {
par(big.par)
par(plt = big.par$plt, xpd = FALSE)
par(mfg = mfg.save, new = FALSE)
invisible()
}
}