123 lines
4.7 KiB
R
123 lines
4.7 KiB
R
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)
|
|
}
|