[R] [FORGED] lattice: control panel extent on device
Ben Tupper
btupper at bigelow.org
Wed Oct 26 17:21:52 CEST 2016
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
More information about the R-help
mailing list