[R] plot legend in filled.contour plot with infinite limits
Boris Steipe
boris.steipe at utoronto.ca
Thu Apr 17 17:15:33 CEST 2014
filled.contour() is written in R as a layout wrapper for .filled.contour(), which does the actual plotting. The code handles the construction of the key legend. I have added a parameter
key.extend = FALSE to the function and I believe it does what you were asking for, judging from the incredibly small thumbnail you were referring to.
The function code is here, followed by examples adapted from the help page.
Give it a spin and if it doesn't do what you need and you can't change it yourself, let me know.
Enjoy,
B.
filled.contour2 = function (x = seq(0, 1, length.out = nrow(z)), y = seq(0, 1,
length.out = ncol(z)), z, xlim = range(x, finite = TRUE),
ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE),
levels = pretty(zlim, nlevels), nlevels = 20, color.palette = cm.colors,
col = color.palette(length(levels) - 1), plot.title, plot.axes,
key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1,
key.extend = FALSE,
axes = TRUE, frame.plot = axes, ...)
{
if (missing(z)) {
if (!missing(x)) {
if (is.list(x)) {
z <- x$z
y <- x$y
x <- x$x
}
else {
z <- x
x <- seq.int(0, 1, length.out = nrow(z))
}
}
else stop("no 'z' matrix specified")
}
else if (is.list(x)) {
y <- x$y
x <- x$x
}
if (any(diff(x) <= 0) || any(diff(y) <= 0))
stop("increasing 'x' and 'y' values expected")
mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
on.exit(par(par.orig))
w <- (3 + mar.orig[2L]) * par("csi") * 2.54
w <- lcm(w * ifelse(key.extend, 0.9, 1.0))
layout(matrix(c(2, 1), ncol = 2L), widths = c(1, w))
par(las = las)
mar <- mar.orig
mar[4L] <- mar[2L]
mar[2L] <- 1
par(mar = mar)
plot.new()
plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i",
yaxs = "i")
if (key.extend) {
# expand levels by one step above and below
dl <- diff(levels[1:2]) # level to level distance
# draw key-color rectangles but skip the first and last level
last <- length(levels)
xi <- 0
xa <- 1
rect(xi, levels[2:(last-2)],
xa, levels[3:(last-1)],
col = col[2:(length(col)-1)])
# allow drawing triangles into the margins
apex <- 1.6 # apex height as factor of dl
clipmax <- apex + (0.05*apex) # add fudge factor 5%
# to account for line width
clip(xi,xa, levels[1]-(dl*clipmax), levels[last]+(dl*clipmax))
# draw the range extension polygons
polygon(c(xi,xi,xa,xa,xa/2),
c(levels[2]-(dl), levels[2], levels[2],
levels[2]-(dl), levels[1]-(dl*apex)),
col = col[1])
polygon(c(xi,xi,xa,xa,xa/2),
c(levels[last-1]+(dl), levels[last-1], levels[last-1],
levels[last-1]+(dl), levels[last]+(dl*apex)),
col = col[length(col)])
}
else {
rect(0, levels[-length(levels)], 1, levels[-1L], col = col)
}
if (missing(key.axes) && axes) {
if (key.extend) {axis(4, lwd = 0, lwd.tick=1)}
else {axis(4)}
}
else key.axes
if (key.extend) {
clip(xi,xa, levels[1]-(dl*apex), levels[last]+(dl* apex))
polygon(c(xi,xa/2,xa,xa,xa/2,xi),
c(levels[2]-(dl),
levels[1]-(dl*1.5),
levels[2]-(dl),
levels[last-1]+(dl),
levels[last]+(dl*1.5),
levels[last-1]+(dl) ),
lwd = 1.1 )
}
else {
box()
}
if (!missing(key.title))
key.title
mar <- mar.orig
mar[4L] <- 1
par(mar = mar)
plot.new()
plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
.filled.contour(x, y, z, levels, col)
if (missing(plot.axes)) {
if (axes) {
title(main = "", xlab = "", ylab = "")
Axis(x, side = 1)
Axis(y, side = 2)
}
}
else plot.axes
if (frame.plot)
box()
if (missing(plot.title))
title(...)
else plot.title
invisible()
}
# Examples:
# same as original:
filled.contour2(volcano, color = terrain.colors, asp = 1)
# with extended key:
filled.contour2(volcano, color = terrain.colors, asp = 1, key.extend = TRUE)
# more ...
x <- 10*1:nrow(volcano)
y <- 10*1:ncol(volcano)
filled.contour2(x, y, volcano, key.extend = TRUE, color = terrain.colors,
plot.title = title(main = "The Topography of Maunga Whau",
xlab = "Meters North", ylab = "Meters West"),
plot.axes = { axis(1, seq(100, 800, by = 100))
axis(2, seq(100, 600, by = 100)) },
key.title = title(main = "Height\n(meters)", cex.main=0.7),
key.axes = axis(4, seq(90, 190, by = 10)) ) # maybe also asp = 1
mtext(paste("filled.contour(.) from", R.version.string),
side = 1, line = 4, adj = 1, cex = .66)
a <- expand.grid(1:20, 1:20)
b <- matrix(a[,1] + a[,2], 20)
filled.contour2(x = 1:20, y = 1:20, z = b, key.extend = TRUE,
plot.axes = { axis(1); axis(2); points(10, 10) })
filled.contour2(cos(r^2)*exp(-r/(2*pi)), frame.plot = FALSE,
plot.axes = {}, key.extend=TRUE)
On 2014-04-16, at 11:07 AM, jlehm wrote:
> Dear R-users,
>
> <http://r.789695.n4.nabble.com/file/n4688905/example.jpg>
>
> I would like to manipulate the legend bar of a filled.contour plot in the
> same way as it is done in the attached example I found on the web.
>
> So, in particular, I would like to limit my z-range and then have triangles
> at the ends of the legend that indicate that higher values than max(z-range)
> or lower values than min(z-range) are included in the last color given at
> then ends of the legend.
>
> Does anyone have an idea how to do this?
>
> Any help would be highly appreciated as I just can't find a solution myself.
>
>
>
> --
> View this message in context: http://r.789695.n4.nabble.com/plot-legend-in-filled-contour-plot-with-infinite-limits-tp4688905.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
More information about the R-help
mailing list