forked from emacs-ess/ESS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
C-cC-c-probl.R
122 lines (108 loc) · 4.72 KB
/
C-cC-c-probl.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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)
}