Update packages

elpa/ess-20180524.1000/etc/C-cC-c-probl.R

@@ -0,0 +1,122 @@
+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)
+}