On 21 April 2011 09:54, Marius Hofert <m_hof...@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_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.