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:
> 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_hof...@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_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.
>>
______________________________________________
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.
