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

From: Marius Hofert <m_hofert_at_web.de>
Date: Thu, 21 Apr 2011 10:57:56 +0200

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:

> 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 - 09:00:38 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:10: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