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

From: Marius Hofert <m_hofert_at_web.de>
Date: Thu, 21 Apr 2011 02:19:16 +0200

Dear Baptiste,

*fantastic*, thank you very much, *precisely* what I was looking for!

Cheers,

Marius

On 2011-04-21, at 01:31 , baptiste auguie wrote:

> 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 Thu 21 Apr 2011 - 00:21:57 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 - 09:40:32 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