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@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. ______________________________________________ R-help@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.
