[R] plot legend in filled.contour plot with infinite limits
Boris Steipe
boris.steipe at utoronto.ca
Thu Apr 17 19:41:11 CEST 2014
On 2014-04-17, at 12:21 PM, jlehm wrote:
> This is great!! Thank you so much!!!
>
> If have to admit, though, that this script is a bit too advanced for me as
> that I could understand it.
Most of it is the original code of the function :-)
> But perhaps I could ask you for one more thing?
>
> If possible, I would like, if the triangles replaced the first and the last
> box of the legend, instead of beeing added on top / below the legend maxima
> /minima.
This is intentional: the triangles are not simply added to the key rectangles, but the shape of the first and last rectangle is changed to indicate that this key extends beyond the plotted range. Note that there is no horizontal line between the triangular and the rectangular part. I think that's the right way to do it, from an information design perspective. If you must have it different, I have parametrized that part now: just set "kbh" to 0 (or some intermediate value) in the code.
> If also tried to change apex <- 1, so that the height of the triangle is the
> same as the height of the boxes. This worked for the filled triangle but not
> for its border. Could you tell me how to fix this?
Great. This is a bug - I overlooked to use the variable "apex" also when the "box" is drawn. Thanks for noticing. Updated below.
>
> By the way, sorry for the small thumbnail. I added a new larger figure that
> I just created with ferret.
:-(
They don't give units for their keys. You can do better now :-)
> Thanks again and happy Easter,
> J <http://r.789695.n4.nabble.com/file/n4689000/example_legend.png>
Cheers,
B
======== updated filled.contour2 ======================================
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.0 # apex height as factor of dl
kbh <- 1.0 # height of rectangular part of polygon
# as factor of dl. kbh <- 0 draws the polygon
# as a triangle.
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*kbh), levels[2], levels[2],
levels[2]-(dl*kbh), levels[1]-(dl*apex)),
col = col[1])
polygon(c(xi,xi,xa,xa,xa/2),
c(levels[last-1]+(dl*kbh), levels[last-1], levels[last-1],
levels[last-1]+(dl*kbh), 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*kbh),
levels[1]-(dl*apex),
levels[2]-(dl*kbh),
levels[last-1]+(dl*kbh),
levels[last]+(dl*apex),
levels[last-1]+(dl*kbh) ),
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()
}
=======================================================================
>
>
>
> --
> View this message in context: http://r.789695.n4.nabble.com/plot-legend-in-filled-contour-plot-with-infinite-limits-tp4688905p4689000.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