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