Re: [R] grid.table + splom: how to nicely align panel entries

From: baptiste auguie <baptiste.auguie_at_googlemail.com>
Date: Thu, 21 Apr 2011 11:31:37 +1200

On 21 April 2011 09:54, Marius Hofert <m_hofert_at_web.de> wrote:
> Dear Baptiste,
>
> great, many thanks!
> One last thing: Do you know why the gpar(cex=0.1) argument is ignored?
>

Yes – the theme overrides it, you need to include it in the theme.list().

baptiste

> Cheers,
>
> Marius
>
> library(lattice)
> library(grid)
> library(gridExtra)
>
> ## function for correct digit alignment
> align.digits <- function(l){
>    sp <- strsplit(as.character(l), "\\.")
>    chars <- sapply(sp, function(x) nchar(x)[1])
>    n <- max(chars)-chars
>    l0 <- sapply(n, function(x) paste(rep("0", x), collapse=""))
>    labels <- sapply(seq_along(sp), function(i){
>        point <- if(is.na(sp[[i]][2])) NULL else quote(.)
>        as.expression(bquote(phantom(.(l0[i])) * .(sp[[i]][1]) * .(point) * .(sp[[i]][2]) ))})
> }
>
> ## splom with customized lower.panel
> ## x: data
> ## arr: array of containing expressions which are plotted in a grid table in the
> ##      lower panel (i,j)]
> splom2 <- function(x, arr, nr){
>    ## function for creating table
>    table.fun <- function(vec){ # vector containing lines for table for *one* panel
>        grid.table(matrix(vec, nrow=nr, byrow=TRUE),
>                   parse=TRUE, # parse labels as expressions
>                   gpar.coretext=gpar(cex=0.1), # text size
>                   theme=theme.list(
>                   gpar.corefill=gpar(fill=NA, col=NA), # make bg transparent
>                   core.just="left", padding.h=unit(0,"mm")) # justification of labels
>                   )
>    }
>    ## splom
>    splom(x, varname.cex=1.2,
>          superpanel=function(z, ...){
>              panel.pairs(z, upper.panel=panel.splom, lower.panel=function(i,j){
>                  table.fun(arr[i,j,])
>              }, ...)
>          })
> }
>
> ## create data and array of expressions
> d <- 4
> x <- matrix(runif(d*1000), ncol=d) # data to be plotted with splom
> nr <- 3 # number of rows for the panel entries
> nc <- 3 # number of cols for the panel entries
> arr <- array(list(rep(NA,nr*nc)), dim=c(d,d,nr*nc), dimnames=c("i","j","val")) # array containing the table entries per panel
> f <- function(i,j) (i+j)*10 # dummy function
> eq <- "phantom()==phantom()"
> for(i in 1:d){
>    for(j in 1:d){
>        numbers <- align.digits(c(round(pi,4), round(pi, 6), f(i,j)))
>        arr[i,j,] <- c("alpha", eq, numbers[1],
>                       "italic(bbb)", eq, numbers[2],
>                       "gamma", eq, numbers[3])
>    }
> }
>
> ## plot
> splom2(x, arr, nr=3)
>
>
> On 2011-04-20, at 22:38 , baptiste auguie wrote:
>
>> Try this,
>>
>> align.digits = function(l)
>> {
>>
>> sp <- strsplit(as.character(l), "\\.")
>> chars <- sapply(sp, function(x) nchar(x)[1])
>> n = max(chars) - chars
>> l0 = sapply(n, function(x) paste(rep("0", x), collapse=""))
>> labels = sapply(seq_along(sp), function(i) {
>>  point <- if(is.na(sp[[i]][2])) NULL else quote(.)
>>  as.expression(bquote(phantom(.(l0[i])) * .(sp[[i]][1])*
>> .(point)*.(sp[[i]][2]) ))})
>>
>> return(labels)
>> }
>>
>>
>> library(gridExtra)
>>
>> d <- align.digits(l = c(125.3, 1.23444444, 12))
>> grid.newpage()
>> grid.table(d, parse=T, core.just="left", gpar.coretext=gpar(cex=0.5))
>>
>> HTH,
>>
>> baptiste
>>
>> On 21 April 2011 03:07, Marius Hofert <m_hofert_at_web.de> wrote:
>>> Dear Baptiste,
>>>
>>> very nice, indeed!
>>>
>>> Two minor issues that remain, are:
>>> (1) I tried to omit the decimal dot for those numbers that do not have digits
>>>    after the decimal dot. But somehow it does not work...
>>> (2) Do you know how one can decrease the text size for the text appearing in the
>>>    lower panel? I tried to work with "cex=0.5"... but it was ignored all the time.
>>>
>>> Cheers,
>>>
>>> Marius
>>>
>>>
>>> library(lattice)
>>> library(grid)
>>> library(gridExtra)
>>>
>>> ## function for correct digit alignment
>>> align.digits <- function(l){
>>>    sp <- strsplit(as.character(l), "\\.")
>>>    chars <- sapply(sp, function(x) nchar(x)[1])
>>>    n <- max(chars)-chars
>>>    l0 <- sapply(n, function(x) paste(rep("0", x), collapse=""))
>>>    sapply(seq_along(sp), function(i){
>>>        if(length(sp[[1]])==1){
>>>            as.expression(bquote(phantom(.(l0[i])) * .(sp[[i]][1])))
>>>        }else{
>>>            as.expression(bquote(phantom(.(l0[i])) * .(sp[[i]][1])*.*.(sp[[i]][2])))
>>>        }
>>>    })
>>> }
>>>
>>> ## splom with customized lower.panel
>>> ## x: data
>>> ## arr: array of containing expressions which are plotted in a grid table in the
>>> ##      lower panel (i,j)]
>>> splom2 <- function(x, arr, nr){
>>>    ## function for creating table
>>>    table.fun <- function(vec){ # vector containing lines for table for *one* panel
>>>        grid.table(matrix(vec, nrow=nr, byrow=TRUE),
>>>                   parse=TRUE, # parse labels as expressions
>>>                   theme=theme.list(
>>>                   gpar.corefill=gpar(fill=NA, col=NA), # make bg transparent
>>>                   core.just="left", padding.h=unit(0,"mm")) # justification of labels
>>>                   )
>>>    }
>>>    ## splom
>>>    splom(x, varname.cex=1.2,
>>>          superpanel=function(z, ...){
>>>              panel.pairs(z, upper.panel=panel.splom, lower.panel=function(i,j){
>>>                  table.fun(arr[i,j,])
>>>              }, ...)
>>>          })
>>> }
>>>
>>> ## create data and array of expressions
>>> d <- 4
>>> x <- matrix(runif(d*1000), ncol=d) # data to be plotted with splom
>>> nr <- 3 # number of rows for the panel entries
>>> nc <- 3 # number of cols for the panel entries
>>> arr <- array(list(rep(NA,nr*nc)), dim=c(d,d,nr*nc), dimnames=c("i","j","val")) # array containing the table entries per panel
>>> f <- function(i,j) (i+j)*10 # dummy function
>>> eq <- "phantom()==phantom()"
>>> for(i in 1:d){
>>>    for(j in 1:d){
>>>        numbers <- align.digits(c(round(pi,4), round(pi, 6), f(i,j)))
>>>        arr[i,j,] <- c("alpha", eq, numbers[1],
>>>                       "italic(bbb)", eq, numbers[2],
>>>                       "gamma", eq, numbers[3])
>>>    }
>>> }
>>>
>>> ## plot
>>> splom2(x, arr, nr=3)
>>>
>>>
>>> On 2011-04-20, at 11:56 , baptiste auguie wrote:
>>>
>>>> On 20 April 2011 21:16, Marius Hofert <m_hofert_at_web.de> wrote:
>>>>> Dear expeRts,
>>>>>
>>>>> is there a way to get the entries in each panel correctly aligned according to the
>>>>> equality signs?
>>>>>
>>>>> Here is the "wish-list":
>>>>> (1) the equality signs in each panel should be vertically aligned
>>>>
>>>> You can put the equal signs in their own column,
>>>>
>>>> library(gridExtra)
>>>> d = matrix(c("italic(a)", "phantom()==phantom()", round(pi,4),
>>>> "italic(b)", "phantom()==phantom()", round(pi,6)), ncol=3, byrow=T)
>>>> grid.table(d, parse=T,theme=theme.list(core.just="left"))
>>>>
>>>>> (2) the numbers should be aligned on the decimal point
>>>>
>>>> You could place some phantom()s to do this,
>>>>
>>>> align.digits = function(l)
>>>> {
>>>>
>>>> sp <- strsplit(as.character(l), "\\.")
>>>> chars <- sapply(sp, function(x) nchar(x)[1])
>>>> n = max(chars) - chars
>>>> l0 = sapply(n, function(x) paste(rep("0", x), collapse=""))
>>>> labels = sapply(seq_along(sp), function(i) {
>>>>  as.expression(bquote(phantom(.(l0[i])) * .(sp[[i]][1])*.*.(sp[[i]][2])))})
>>>>
>>>> return(labels)
>>>> }
>>>>
>>>> library(gridExtra)
>>>>
>>>> d <- align.digits(l = c(125.3, 1.23444444))
>>>> grid.table(d, parse=T,core.just="left")
>>>>
>>>> HTH,
>>>>
>>>> baptiste
>>>>
>>>>> One could adjust the phantom()-arguments by hand to achieve (1), but is there a
>>>>> simpler solution? For (2) I have no idea.
>>>>>
>>>>> Cheers,
>>>>>
>>>>> Marius
>>>>>
>>>>>
>>>>> library(lattice)
>>>>> library(grid)
>>>>> library(gridExtra)
>>>>>
>>>>> ## splom with customized lower.panel
>>>>> ## x: data
>>>>> ## arr: array of containing expressions which are plotted in a grid table in the
>>>>> ##      lower panel (i,j)]
>>>>> splom2 <- function(x, arr){
>>>>>    ## function for creating table
>>>>>    table.fun <- function(vec){ # vector containing lines for table for *one* panel
>>>>>        grid.table(matrix(vec, ncol=2, byrow=TRUE),
>>>>>                   parse=TRUE, # parse labels as expressions
>>>>>                   theme=theme.list(
>>>>>                   gpar.corefill=gpar(fill=NA, col=NA), # make bg transparent
>>>>>                   core.just="left", padding.h=unit(0,"mm")) # justification of labels
>>>>>                   )
>>>>>    }
>>>>>    ## splom
>>>>>    splom(x, varname.cex=1.4,
>>>>>          superpanel=function(z, ...){
>>>>>              panel.pairs(z, upper.panel=panel.splom, lower.panel=function(i,j){
>>>>>                  table.fun(arr[i,j,])
>>>>>              }, ...)
>>>>>          })
>>>>> }
>>>>>
>>>>> ## create data and array of expressions
>>>>> d <- 4
>>>>> x <- matrix(runif(d*1000), ncol=d) # data to be plotted with splom
>>>>> arr <- array(list(rep(NA, 3*2)), dim=c(d,d,3*2), dimnames=c("i","j","val")) # array containing the table entries per panel
>>>>> f <- function(i,j) (i+j)*10+0.1 # dummy function
>>>>> for(i in 1:d){
>>>>>    for(j in 1:d){
>>>>>        arr[i,j,] <- c("alpha==phantom()", round(pi,4),
>>>>>                       "italic(bbb)==phantom()", round(pi,6),
>>>>>                       "gamma==phantom()", f(i,j))
>>>>>    }
>>>>> }
>>>>>
>>>>> ## plot
>>>>> splom2(x, arr)
>>>>>
>>>>> ______________________________________________
>>>>> 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.
>>>>>
>>>
>>> ______________________________________________
>>> 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.
>>>
>
>



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. Received on Wed 20 Apr 2011 - 23:35:29 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Thu 21 Apr 2011 - 00:50:31 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive