foobar <- function(...) {} rm(list=ls()) ##--------> consequence of the above experiments: ## the 2nd form is numerically "uniformly better" than the first ##--------> 2011-05-27: Change Frank's psiInv() to ## psiInv = function(t,theta) ## -log1p(exp(-theta)*expm1((1-t)*theta)/expm1(-theta)) ##--- In the following block, in the first line, C-c C-c did *NOT* behave th <- 48 # now do ls() and see what happened ... the horror !!! d <- 3 cpF <- list("Frank", list(th, 1:d)) cop <- acF <- cpF$copula ### Here, the bug (12.09-2, e.g.) has been that ### the function beginning is not found reliably: ### C-M-q -> should go to end; then C-M-a should go back to beginning (here) mplot4 <- function(x, vList, xvar, cvar, rvar, log = "", verbose=FALSE, show.layout=verbose) { dn <- dimnames(x) ## the variable displayed in one plot (with different colors): v <- setdiff(names(dn), c(xvar, cvar, rvar)) stopifnot(length(v) == 1, 1 <= (nv <- length(dn[[v]])), nv <= length(pcol), length(pspc) == 2, length(spc) == 2, length(axlabspc) == 2, length(labspc) == 2, length(auxcol) == 4) v.col <- colorRampPalette(pcol, space="Lab")(nv) # colors for v ## permute to know the component indices: x <- aperm(x, perm=c(rvar, cvar, v, xvar)) if(is.null(xlab)) # default: the expression from varlist xlab <- vList[[xvar]]$expr z <- as.numeric(vList[[xvar]]$value) # pick out different x values zrange <- range(z) # for forcing the same x axis limits per row ## set up the grid layout nx <- length(dn[[cvar]]) # number of plot columns nx. <- nx+1+(nx-1)+1 # +1: for y axis label; +(nx-1): for gaps; +1: for row labels ny <- length(dn[[rvar]]) # number of plot rows ny. <- ny+1+(ny-1)+1 # +1: for column labels; +(ny-1): for gaps; +1: for x axis label ## plot settings, restored on exit opar <- par(no.readonly=TRUE); on.exit(par(opar)) plot.new() # start (empty) new page with 'graphics' gl <- grid.layout(nx., ny., ## units in npc as for pdf(); no square plotting region otherwise: default.units="npc", widths=c(axlabspc[1], rep(c(pspc[1], spc[1]), nx-1), pspc[1], labspc[1]), heights=c(labspc[2], rep(c(pspc[2], spc[2]), ny-1), pspc[2], axlabspc[2])) if(show.layout) grid.show.layout(gl, vp=viewport(width=1.25, height=1.25)) pushViewport(viewport(layout=gl)) # use this layout in a viewport ## --- plot data --- for(i in 1:nx) { # rows i. <- 2*i # column index in layout (for jumping over gaps) if(verbose) cat(sprintf("plot row %d (%d): [columns:] ", i, i.)) yrange <- range(x[i,,,]) # for forcing the same y axis limits per row for(j in 1:ny) { # columns j. <- 2*j # row index in layout (for jumping over gaps) if(verbose) cat(sprintf("%d (%d) ", j, j.)) pushViewport(viewport(layout.pos.row=i., layout.pos.col=j.)) ## plot grid.rect(gp=gpar(col=NA, fill=auxcol[3])) # background ## start a 'graphics' plot par(plt = gridPLT()) ## Hmm, this is not really useful for debugging: ## rp <- tryCatch(par(plt=gridPLT()), error = function(e)e) ## if(inherits(rp, "error")) { ## cat("\n *** ERROR in mplot() :\n", rp$message,"\n"); return(gl) ## } par(new=TRUE) # always do this before each new 'graphics' plot ## set up coordinate axes: plot(zrange, yrange, log=log, type="n", ann=FALSE, axes=FALSE) ## background grid: grid(col=auxcol[4], lty="solid", lwd=grid.lwd, equilogs=FALSE) ## plot corresponding points/lines for(k in 1:nv) points(z, x[i,j,k,], type="b", col=v.col[k]) ## axes c1 <- auxcol[1] if(i == nx) # x axes axis(1, lwd=ax.lwd, col=NA, col.ticks=c1, col.axis=c1) if(j == 1) { # y axes if(packageVersion("sfsmisc") >= "1.0-21") ## allow for adjusting colors of small ticks eaxis(2, lwd=ax.lwd, col=NA, col.ticks=c1, col.axis=c1, small.args=list(col=NA, col.ticks=c1, col.axis=c1)) else eaxis(2, lwd=ax.lwd, col=NA, col.ticks=c1, col.axis=c1) } upViewport() ## column labels if(i == 1) { pushViewport(viewport(layout.pos.row=1, layout.pos.col=j.)) grid.rect(gp=gpar(col=NA, fill=auxcol[2])) grid.text(parse(text=dn[[cvar]][j]), x=0.5, y=0.5, gp=gpar(cex=tx.cex)) upViewport() } ## row labels if(j == 2) { pushViewport(viewport(layout.pos.row=i., layout.pos.col=nx.)) grid.rect(gp=gpar(col=NA, fill=auxcol[2])) grid.text(parse(text=dn[[rvar]][i]), x=0.5, y=0.5, gp=gpar(cex=tx.cex), rot=-90) upViewport() } }## for(j ..) if(verbose) cat("\n") }## for(i ..) ## legend pushViewport(viewport(layout.pos.row=ny., layout.pos.col=2:(ny.-1))) ll <- 0.01 # line length ## [... ... made example smaller ... ESS-bug still shows ....] upViewport() invisible(gl) }