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

[Marius Hofert]

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.
>>