'Re: [R] [FORGED] [FORGED] lattice: control panel extent on device'

[prev in list] [next in list] [prev in thread] [next in thread] 

List:       r-help
Subject:    Re: [R] [FORGED]  [FORGED] lattice: control panel extent on device
From:       Ben Tupper <btupper () bigelow ! org>
Date:       2016-10-27 13:01:28
Message-ID: CB002D36-1927-43A2-9173-02B6319E75B6 () bigelow ! org
[Download RAW message or body]

Hi,

I had not noticed the difference, but now that I can see them side-by-side it's \
obvious.  I see that I shouldn't have taken out those modifications you had \
originally set up.  They were sort of like extra those extra parts you find after \
assembling a new gizmo - "Nah, I don't need those things."  Oops!

I just realized that I was calling the alignment vertical (because the plots are \
over-under), but you referred to the alignment as horizontal which sounds 'righter'.  \
I should challenge myself to do the same for vertical alignment for side-by-side \
plots.  If I get to it I'll post the results.

Thanks, again, for your time and help.

Cheers,
Ben

> On Oct 26, 2016, at 3:13 PM, Paul Murrell <paul@stat.auckland.ac.nz> wrote:
> 
> 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@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@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@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@bigelow.org
> > > > > > > <mailto:btupper@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@r-project.org <mailto:R-help@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@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@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@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@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@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@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.

[prev in list] [next in list] [prev in thread] [next in thread] 