[FORGED] Re: [FORGED] lattice: control panel extent on device
Hi
I think your plots are not *quite* horizontally aligned (because of
differences in the lengths of y-axis labels). Here is a slight
modification that messes with the labels (but at least not manually) to
get things exact ...
valign_lattice <- function(x) {
if (inherits(x, "trellis")) x <- list(x)
if (!all(sapply(x, inherits, 'trellis')))
stop("all elements of x must inherit from trellis class")
nx <- length(x)
names(x) <- LETTERS[1:nx]
h1 <- 1/nx
y0 <- seq(from = 0, to = 1 - h1, length = nx)
n <- 1
grid.newpage()
pushViewport(viewport(y=y0[n], height=h1, just="bottom"))
# Force identical widths where we can
layout.widths <- lattice.options("layout.widths")[[1]]
layout.widths$ylab <- list(x=1, units="cm", data=NULL)
layout.widths$panel <- list(x=1, units="null", data=NULL)
layout.widths$key.right <- list(x=1, units="cm", data=NULL)
lattice.options(layout.widths=layout.widths)
# Force (width of) left axis labels to be the same
yrange <- x[[n]]$y.limits
yticks <- axisTicks(yrange, FALSE)
x[[n]] <- update(x[[n]],
scales=list(y=list(at=yticks,
labels=rep(" ", length(yticks)))))
prefix <- LETTERS[n]
print(x[[n]], newpage=FALSE, prefix=prefix)
downViewport(paste0(prefix,".panel.1.1.off.vp"))
# Draw proper left axis labels
grid.text(yticks, x=unit(0, "npc") - unit(1, "lines"),
y=unit(yticks, "native"), just="right",
gp=gpar(cex=.8))
# Determine width of levelplot panel
border <- grid.get("border", grep=TRUE)
width <- convertWidth(border$width, "in", valueOnly=TRUE)
xscale <- current.viewport()$xscale
upViewport(0)
if (nx > 1){
for (n in 2:nx){
pushViewport(viewport(y=y0[n], height=h1, just="bottom"))
# Force identical widths where we can
layout.widths$ylab <- list(x=1, units="cm", data=NULL)
layout.widths$panel <- list(x=width, units="in", data=NULL)
layout.widths$key.right <- list(x=1, units="cm", data=NULL)
lattice.options(layout.widths=layout.widths)
x[[n]] <- update(x[[n]], xlim = xscale)
# Force (width of) left axis labels to be the same
yrange <- x[[n]]$y.limits
yticks <- axisTicks(yrange, FALSE)
x[[n]] <- update(x[[n]],
scales=list(y=list(at=yticks,
labels=rep(" ",
length(yticks)))))
prefix <- LETTERS[n]
print(x[[n]], newpage=FALSE, prefix=prefix)
downViewport(paste0(prefix,".panel.1.1.off.vp"))
# Draw proper left axis labels
grid.text(yticks, x=unit(0, "npc") - unit(1, "lines"),
y=unit(yticks, "native"), just="right",
gp=gpar(cex=.8))
upViewport(0)
} #n-loop
}
}
Paul
On 27/10/16 04:21, Ben Tupper wrote:
Hi,
The following encapsulates what I hoped for using Paul's method. The
function accepts one or more trellis class objects and aligns them
vertically. I think I have automated most of the manual fiddling.
Depending upon your graphics device you may need to fiddle with the
aspect of the levelplot as I did below. There remains a good deal of
vertical white space but it is fine for my purposes as I only need
two objects aligned where it looks OK.
I couldn't get Richard's simplified steps to work - I'm still
noodling that out but the simplicity is very enticing.
Thanks again for the all the suggestions! Ben
#### START library(lattice) library(grid)
#' Vertically align one or more trellis class objects. #' #' Objects
are plotted in order from bottom up and all are restricted to the #'
horizontal extent across the device and to the data range of that of
the #' first object. #' #' @param x a list of one or more trellis
class objects valign_lattice <- function(x) {
if (inherits(x, "trellis")) x <- list(x)
if (!all(sapply(x, inherits, 'trellis'))) stop("all elements of x
must inherit from trellis class")
nx <- length(x) names(x) <- LETTERS[1:nx] h1 <- 1/nx y0 <- seq(from =
0, to = 1 - h1, length = nx) n <- 1 grid.newpage()
pushViewport(viewport(y=y0[n], height=h1, just="bottom")) # Force
identical widths where we can layout.widths <-
lattice.options("layout.widths")[[1]] layout.widths$ylab <- list(x=1,
units="cm", data=NULL) layout.widths$panel <- list(x=1, units="null",
data=NULL) layout.widths$key.right <- list(x=1, units="cm",
data=NULL) lattice.options(layout.widths=layout.widths) # Force
(width of) left axis labels to be the same prefix <- LETTERS[n]
print(x[[n]], newpage=FALSE, prefix=prefix)
downViewport(paste0(prefix,".panel.1.1.off.vp")) # Determine width of
levelplot panel border <- grid.get("border", grep=TRUE) width <-
convertWidth(border$width, "in", valueOnly=TRUE) xscale <-
current.viewport()$xscale upViewport(0)
if (nx > 1){ for (n in 2:nx){ pushViewport(viewport(y=y0[n],
height=h1, just="bottom")) # Force identical widths where we can
layout.widths$ylab <- list(x=1, units="cm", data=NULL)
layout.widths$panel <- list(x=width, units="in", data=NULL)
layout.widths$key.right <- list(x=1, units="cm", data=NULL)
lattice.options(layout.widths=layout.widths) x[[n]] <- update(x[[n]],
xlim = xscale) prefix <- LETTERS[n] print(x[[n]], newpage=FALSE,
prefix=prefix) downViewport(paste0(prefix,".panel.1.1.off.vp"))
upViewport(0) } #n-loop } }
d <- dim(volcano) xy <- data.frame( x = 1:d[1], y1 = volcano[,30], y2
= sqrt(volcano[,7]))
bottom <- levelplot(volcano, main = 'boom', ylab = 'foo', xlab =
'bar', aspect = 0.5) middle <- xyplot(y1 ~ x, data = xy, main =
'bam', xlab = '', ylab = 'elevation') top <- xyplot(y2 ~ x, data =
xy, main = 'bing', ylab = 'squished', xlab = '')
# just two x <- list(bottom, top) valign_lattice(x)
bottom <- update(bottom, aspect = 0.2) # three x <- list(bottom,
middle, top) valign_lattice(x)
#### END
On Oct 25, 2016, at 8:07 PM, Paul Murrell
<paul at stat.auckland.ac.nz> wrote:
Hi
This might work, though it's a teensy bit more complicated and a
bit manual (on the left axis labels) and it ignores heights and
vertical whitespace ...
library(lattice) d <- dim(volcano) xy <- data.frame(x = 1:d[1], y =
volcano[,30] ) library(grid) grid.newpage()
pushViewport(viewport(y=0, height=.5, just="bottom")) # Force
identical widths where we can layout.widths <-
lattice.options("layout.widths")[[1]] layout.widths$ylab <-
list(x=1, units="cm", data=NULL) layout.widths$panel <- list(x=1,
units="null", data=NULL) layout.widths$key.right <- list(x=1,
units="cm", data=NULL)
lattice.options(layout.widths=layout.widths) # Force (width of)
left axis labels to be the same vol_p <- levelplot(volcano,
scales=list(y=list(at=seq(10, 60, 10), labels=rep(" ", 6))))
print(vol_p, newpage=FALSE, prefix="vol_p")
downViewport("vol_p.panel.1.1.off.vp") # Draw proper left axis
labels grid.text(seq(10, 60, 10), x=unit(0, "npc") - unit(1,
"lines"), y=unit(seq(10, 60, 10), "native"), just="right",
gp=gpar(cex=.8)) # Determine width of levelplot panel border <-
grid.get("border", grep=TRUE) width <- convertWidth(border$width,
"in", valueOnly=TRUE) xscale <- current.viewport()$xscale
upViewport(0) pushViewport(viewport(y=.5, height=.5,
just="bottom")) # Force identical widths where we can
layout.widths$ylab <- list(x=1, units="cm", data=NULL)
layout.widths$panel <- list(x=width, units="in", data=NULL)
layout.widths$key.right <- list(x=1, units="cm", data=NULL)
lattice.options(layout.widths=layout.widths) # Force (width of)
left axis labels to be the same xy_p <- xyplot(y ~ x, data = xy,
xlim=xscale, scales=list(y=list(at=seq(100, 200, 20), labels=rep("
", 11)))) print(xy_p, newpage=FALSE, prefix="xy_p")
downViewport("xy_p.panel.1.1.off.vp") # Draw proper left axis
labels grid.text(seq(100, 200, 20), x=unit(0, "npc") - unit(1,
"lines"), y=unit(seq(100, 200, 20), "native"), just="right",
gp=gpar(cex=.8)) upViewport(0)
Paul
On 26/10/16 10:50, Ben Tupper wrote:
Hi, Almost but not quite. It certainly moves the ball down the field, and, dang, that would be way too easy! I have been fiddling with the panel.widths to the lattice::plot method. No joy yet. Ben
On Oct 25, 2016, at 5:14 PM, Paul Murrell <paul at stat.auckland.ac.nz> wrote: Hi Does this do what you want ? library(latticeExtra) c(vol_p, xy_p, x.same=TRUE) Paul On 26/10/16 04:30, Ben Tupper wrote:
Thanks, Bert. I have used latticeExtra for layering graphics. I'm not sure how I would use it to align graphics rather superimposing them. I shall look into the the custom panel plot but that is very new territory for me. Ben
On Oct 25, 2016, at 9:13 AM, Bert Gunter <bgunter.4567 at gmail.com> wrote: Write a custom panel function for levelplot() that calls panel.xyplot after panel.levelplot. I believe this can also be done by the + operator of the latticeExtra package. You do *not* want to call xyplot after levelplot, as that completely redraws the plot. Cheers, Bert On Oct 25, 2016 2:55 PM, "Ben Tupper" <btupper at bigelow.org <mailto:btupper at bigelow.org>> wrote: Hello, I am drawing a levelplot and an xyplot on a single device as shown in the runnable example below. I would like the x axes to align - that is for them to cover the same extent left-to-right on the device. How do I go about doing that? ####### # START ####### library(lattice) d <- dim(volcano) xy <- data.frame(x = 1:d[1], y = volcano[,30] ) vol_p <- levelplot(volcano) xy_p <- xyplot(y ~ x, data = xy) print(vol_p, split = c(1, 2, 1, 2), more = TRUE) print(xy_p, split = c(1, 1, 1, 2), more = FALSE) ###### #END ###### Thanks! Ben
sessionInfo()
R version 3.3.1 (2016-06-21) Platform: x86_64-apple-darwin13.4.0 (64-bit) Running under: OS X 10.11.6 (El Capitan) locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages: [1] stats graphics grDevices utils
datasets methods base other attached packages: [1] lattice_0.20-33 loaded via a namespace (and not attached): [1] tools_3.3.1 grid_3.3.1 Ben Tupper Bigelow Laboratory for Ocean Sciences 60 Bigelow Drive, P.O. Box 380 East Boothbay, Maine 04544 http://www.bigelow.org <http://www.bigelow.org/>
______________________________________________ R-help at r-project.org <mailto:R-help at r-project.org> mailing list -- To UNSUBSCRIBE and more, see https://stat.ethz.ch/mailman/listinfo/r-help <https://stat.ethz.ch/mailman/listinfo/r-help> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html <http://www.r-project.org/posting-guide.html> and provide commented, minimal, self-contained, reproducible code.
Ben Tupper Bigelow Laboratory for Ocean Sciences 60 Bigelow Drive, P.O. Box 380 East Boothbay, Maine 04544 http://www.bigelow.org [[alternative HTML version deleted]]
______________________________________________ R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see 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.
-- Dr Paul Murrell Department of Statistics The University of Auckland Private Bag 92019 Auckland New Zealand 64 9 3737599 x85392 paul at stat.auckland.ac.nz http://www.stat.auckland.ac.nz/~paul/
Ben Tupper Bigelow Laboratory for Ocean Sciences 60 Bigelow Drive, P.O. Box 380 East Boothbay, Maine 04544 http://www.bigelow.org
-- Dr Paul Murrell Department of Statistics The University of Auckland Private Bag 92019 Auckland New Zealand 64 9 3737599 x85392 paul at stat.auckland.ac.nz http://www.stat.auckland.ac.nz/~paul/
Ben Tupper Bigelow Laboratory for Ocean Sciences 60 Bigelow Drive, P.O. Box 380 East Boothbay, Maine 04544 http://www.bigelow.org
______________________________________________ R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see 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.
Dr Paul Murrell Department of Statistics The University of Auckland Private Bag 92019 Auckland New Zealand 64 9 3737599 x85392 paul at stat.auckland.ac.nz http://www.stat.auckland.ac.nz/~paul/