Skip to content

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

8 messages · Marius Hofert, Baptiste Auguie

#
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  
(2) the numbers should be aligned on the decimal point

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)
#
On 20 April 2011 21:16, Marius Hofert <m_hofert at web.de> wrote:
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"))
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
#
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:

            
#
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,

great, many thanks!
One last thing: Do you know why the gpar(cex=0.1) argument is ignored?

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:

            
#
On 21 April 2011 09:54, Marius Hofert <m_hofert at web.de> wrote:
Yes ? the theme overrides it, you need to include it in the theme.list().

baptiste
#
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:

            
#
Here is the final solution with my minimal example :-)

library(lattice) 
library(grid)
library(gridExtra)

## function for correct alignment according to the decimal point
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)
## nr: number of rows in each lower.panel
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.coretext=gpar(cex=0.8), # text size
                   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-21, at 02:19 , Marius Hofert wrote: