[R] Obtaining the true aspect ratio for a lattice plot

Wed Mar 10 19:48:05 CET 2010

Thanks much - very nice.  I hadn't thought of that approach.

I dug around in the lattice source and found another way to do it so  
for what it's worth, I'll post it - maybe it will be useful to  
someone.  Basically, I made a function from code found in  
plot.trellis() that gets the grid layout for a lattice object  
(layout=c(_, _) and aspect need to be specified for this to work).   
Then functions getHeight() or getWidth() calculate correct height or  
width for a given width or height by calculating the dimensions of all  
the non-data-region parts of the plot. etc.

trellis.getlayout <- function(x,
    panel.height = lattice.getOption("layout.heights")$panel,
    panel.width = lattice.getOption("layout.widths")$panel
) {

     if (!is.null(x$plot.args))
     {
         supplied <- names(x$plot.args)
         if ("panel.height" %in% supplied && missing(panel.height))  
panel.height <- x$plot.args$panel.height
         if ("panel.width"  %in% supplied && missing(panel.width))   
panel.width  <- x$plot.args$panel.width
     }

     original.condlevels <-
         used.condlevels <-
             lapply(x$condlevels, function(x) seq_along(x))
     used.condlevels <-
         mapply("[", used.condlevels, x$index.cond,
                MoreArgs = list(drop = FALSE),
                SIMPLIFY = FALSE)
     used.condlevels <- used.condlevels[x$perm.cond]
     inverse.permutation <- order(x$perm.cond) # used later

    cond.max.levels <- sapply(used.condlevels, length)
     number.of.cond <- length(cond.max.levels)

     panel.layout <- lattice:::compute.layout(x$layout,  
cond.max.levels, skip = x$skip)

     if(panel.layout[1] == 0)
        stop("invalid layout")

     axis.text <- trellis.par.get("axis.text")

     if (!x$aspect.fill)
         panel.height[[1]] <- x$aspect.ratio * panel.width[[1]]

     legend <- lattice:::evaluate.legend(x$legend)

     xaxis.cex <-
         if (is.logical(x$x.scales$cex)) rep(axis.text$cex, length = 2)
         else x$x.scales$cex
     xaxis.rot <-
         if (is.logical(x$x.scales$rot)) c(0, 0)
         else x$x.scales$rot

     yaxis.cex <-
         if (is.logical(x$y.scales$cex)) rep(axis.text$cex, length = 2)
         else x$y.scales$cex
     yaxis.rot <-
         if (!is.logical(x$y.scales$rot)) x$y.scales$rot
         else if (x$y.scales$relation != "same" && is.logical(x 
$y.scales$labels)) c(90, 90)
         else c(0, 0)

     cols.per.page <- panel.layout[1]
     rows.per.page <- panel.layout[2]

     x.alternating <- rep(x$x.scales$alternating, length =  
cols.per.page)
     y.alternating <- rep(x$y.scales$alternating, length =  
rows.per.page)
     x.relation.same <- x$x.scales$relation == "same"
     y.relation.same <- x$y.scales$relation == "same"

     main <-
         lattice:::grobFromLabelList(lattice:::getLabelList(x$main,

trellis.par.get("par.main.text")),
                           name = trellis.grobname("main"))
     sub <-
         lattice:::grobFromLabelList(lattice:::getLabelList(x$sub,

trellis.par.get("par.sub.text")),
                           name = trellis.grobname("sub"))
     xlab <-
         lattice:::grobFromLabelList(lattice:::getLabelList(x$xlab,

trellis.par.get("par.xlab.text"),
                                        x$xlab.default),
                           name = trellis.grobname("xlab"))
     ylab <-
         lattice:::grobFromLabelList(lattice:::getLabelList(x$ylab,

trellis.par.get("par.ylab.text"),
                                        x$ylab.default),
                           name = trellis.grobname("ylab"), orient = 90)

     par.strip.text <- trellis.par.get("add.text")
     par.strip.text$lines <- 1
     if (!is.null(x$par.strip.text))
         par.strip.text[names(x$par.strip.text)] <- x$par.strip.text

     trellis.par.set(p$par.settings) # set padding, etc.
     layoutCalculations <-
         lattice:::calculateGridLayout(x,
                             rows.per.page, cols.per.page,
                             number.of.cond,
                             panel.height, panel.width,
                             main, sub,
                             xlab, ylab,
                             x.alternating, y.alternating,
                             x.relation.same, y.relation.same,
                             xaxis.rot, yaxis.rot,
                             xaxis.cex, yaxis.cex,
                             par.strip.text,
                             legend)

     page.layout <- layoutCalculations$page.layout

     list(lyt=page.layout, ncols=cols.per.page, nrows=rows.per.page)
}

getWidth <- function(x, height) {
    require(grid)
    lyt <- trellis.getlayout(x)
    page.layout <- lyt$lyt
    nrows <- lyt$nrows
    ncols <- lyt$ncols

    H <- height

    h1 <- sum(unlist(lapply(page.layout$heights, function(x)  
as.numeric(convertY(x, "inches")))))
    w1 <- sum(unlist(lapply(page.layout$widths, function(x)  
as.numeric(convertX(x, "inches")))))

    w2 <- (H - h1) / (x$aspect.ratio * nrows)
    W <- w1 + w2*ncols
    W
}

getHeight <- function(x, width) {
    require(grid)
    lyt <- trellis.getlayout(x)
    page.layout <- lyt$lyt
    nrows <- lyt$nrows
    ncols <- lyt$ncols

    W <- width

    h1 <- sum(unlist(lapply(page.layout$heights, function(x)  
as.numeric(convertY(x, "inches")))))
    w1 <- sum(unlist(lapply(page.layout$widths, function(x)  
as.numeric(convertX(x, "inches")))))

    h2 <- (W - w1) * x$aspect.ratio / ncols
    H <- h1 + h2*nrows
    H
}

# example
library(lattice)

# get rid of extra padding around plot
mypars <- list(
    layout.heights = list(top.padding = 0, main.key.padding = 0,  
key.axis.padding = 0, axis.xlab.padding = 0, xlab.key.padding = 0,  
key.sub.padding = 0, bottom.padding = 0.5),
    layout.widths = list(left.padding = 0, key.ylab.padding = 0,  
ylab.axis.padding = 0, axis.key.padding = 0, right.padding = 0),
    axis.components=list(top=list(pad2 = 0), right=list(pad1 = 0, pad2  
= 0))
)

p <- xyplot(rnorm(100) ~ rnorm(100) | sample(c(0, 1), 100,  
replace=TRUE), aspect=1.5, layout=c(2, 1),
xlab="this is some extra text\n
to show that the\n
overall aspect ratio\n
of a plot is not always\n
easily determined by\n
the aspect ratio specified for the data",
par.settings=mypars
)

pdf("a.pdf", height=6, width=getWidth(p, 6))
plot(p)
dev.off()

On Mar 9, 2010, at 10:51 PM, Felix Andrews wrote:

> Basically you want to achieve an aspect ratio of 0.5 (say) when
> specifying aspect = "fill". You can calculate the aspect ratio after a
> lattice plot has been displayed:
>
> currAspect <- function() {
>    trellis.focus("panel", 1, 1, highlight = FALSE)
>    sz <- current.panel.limits("mm")
>    trellis.unfocus()
>    diff(sz$y) / diff(sz$x)
> }
>
> foo <-
> xyplot(rnorm(100) ~ rnorm(100), aspect="fill", ## NB "fill"
> xlab="this is some extra text\n
> to show that the\n
> overall aspect ratio\n
> of a plot is not always\n
> easily determined by\n
> the aspect ratio specified for the data")
>
> dev.new(width = 10, height = 5)
> print(foo)
> currAspect()
> #[1] 0.19003
>
> One problem is that fonts in pdf() seem to be very different to screen
> devices. You could probably work out which components of the plot have
> a fixed size, and therefore work out the requried aspect ratio... but
> I kinda like brute force:
>
> aspectObjective <- function(height, width, target, ...) {
>    tmp <- tempfile()
>    pdf(tmp, width = width, height = height, ...)
>    print(trellis.last.object())
>    asp <- currAspect()
>    dev.off()
>    file.remove(tmp)
>    abs(asp - target)
> }
>
> print(foo)
> height <- optimize(aspectObjective, c(1, 20), width = 10,
>                   target = 0.5, tol = 0.01)$min
>
> height
> #[1] 7.6928
>
> pdf("test.pdf", width = 10, height = height)
> print(foo)
> currAspect()
> #[1] 0.50013
> dev.off()
>
>
>
> On 10 March 2010 07:16, Ryan Hafen <rhafen at stat.purdue.edu> wrote:
>> I almost always supply my own aspect ratio when plotting using  
>> lattice.
>>  When I plot these to pdf, I would like to specify pdf dimensions  
>> that will
>> result in minimal margins around the plot.  In my application,  
>> resorting to
>> a pdf cropper after plotting is not an option - I must do it in R.   
>> The
>> problem is that I cannot determine the correct aspect ratio for the  
>> overall
>> plot (accounting for strip labels, keys, titles, labels, etc.) that  
>> would
>> help me determine the correct pdf dimensions.  I can roughly  
>> estimate what
>> the overall aspect ratio will be using the layout, etc., but this  
>> is not
>> good enough.  Is there a way to calculate the true overall aspect  
>> ratio for
>> the entire plot?
>>
>> Example: If I make a simple plot and specify aspect=0.5, you would  
>> think
>> that dimensions width=10, height=5 would be a good approximation,  
>> but for
>> example:
>>
>> library(lattice)
>> pdf("plot.pdf", width=10, height=5)
>> xyplot(rnorm(100) ~ rnorm(100), aspect=0.5,
>> xlab="this is some extra text\n
>> to show that the\n
>> overall aspect ratio\n
>> of a plot is not always\n
>> easily determined by\n
>> the aspect ratio specified for the data")
>> dev.off()
>>
>> doesn't work.  It looks like the true aspect ratio of the resulting
>> non-margin area in the pdf is about 0.86.  I'd like to know this in  
>> R before
>> making the pdf so I can specify dimensions accordingly.  Any ideas?
>>
>> ______________________________________________
>> 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.
>>
>
>
>
> -- 
> Felix Andrews / 安福立
> Postdoctoral Fellow
> Integrated Catchment Assessment and Management (iCAM) Centre
> Fenner School of Environment and Society [Bldg 48a]
> The Australian National University
> Canberra ACT 0200 Australia
> M: +61 410 400 963
> T: + 61 2 6125 4670
> E: felix.andrews at anu.edu.au
> CRICOS Provider No. 00120C
> -- 
> http://www.neurofractal.org/felix/