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.
Boris Steipe
2014-Apr-17 15:15 UTC
[R] plot legend in filled.contour plot with infinite limits
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.