[Robast-commits] r676 - in branches/robast-0.9/pkg/RobAStBase: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 8 22:12:57 CEST 2013
Author: ruckdeschel
Date: 2013-07-08 22:12:57 +0200 (Mon, 08 Jul 2013)
New Revision: 676
Modified:
branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R
branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R
branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R
branches/robast-0.9/pkg/RobAStBase/man/infoPlot.Rd
branches/robast-0.9/pkg/RobAStBase/man/internal_plots.Rd
Log:
can now reproduce Nataliya's nice information plot (see last example infoPlot)
Modified: branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R 2013-07-06 16:35:17 UTC (rev 675)
+++ branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R 2013-07-08 20:12:57 UTC (rev 676)
@@ -347,10 +347,10 @@
if(is(e1, "DiscreteDistribution"))
ICy <- jitter(ICy, factor = jitter.fac0)
- if(!is.na(al0)) col.pts <- sapply(col0, addAlphTrsp2col,alpha=al0)
+ col.pts <- if(!is.na(al0)) sapply(col0, addAlphTrsp2col,alpha=al0) else col0
do.call(points, args=c(list(y1, ICy, cex = log(absy0+1)*3*cex0,
- col = col0, pch = pch0), dwo0))
+ col = col.pts, pch = pch0), dwo0))
if(with.lab0){
text(x = y0s, y = ICy, labels = lab.pts0,
cex = log(absy0+1)*1.5*cex0, col = col0)
Modified: branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R 2013-07-06 16:35:17 UTC (rev 675)
+++ branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R 2013-07-08 20:12:57 UTC (rev 676)
@@ -30,13 +30,15 @@
scaleX.inv <- q(L2Fam)
}
-
+ withbox <- TRUE
+ if(!is.null(dots[["withbox"]])) withbox <- dots[["withbox"]]
+ dots["withbox"] <- NULL
dots["type"] <- NULL
xlab <- dots$xlab; if(is.null(xlab)) xlab <- "x"
dots$xlab <- dots$ylab <- NULL
trafO <- trafo(L2Fam at param)
- dims <- nrow(trafO)
+ dimsA <- dims <- nrow(trafO)
dimm <- ncol(trafO)
to.draw <- 1:(dims+1)
@@ -73,7 +75,7 @@
}
if(is.null(legend)){
legend <- vector("list",dims0+in1to.draw)
- legend <- distr:::.fillList(as.list(c("class. opt. IC", objectc)),
+ legend <- distr:::.fillList(list(as.list(c("class. opt. IC", objectc))),
dims0+in1to.draw)
}
}
@@ -151,7 +153,7 @@
if (is.logical(main)){
if (!main) mainL <- FALSE
else
- main <- gettextf("Plot for IC %%A") ###
+ main <- gettextf("Information Plot for IC %%A") ###
### double %% as % is special for gettextf
}
main <- .mpresubs(main)
@@ -225,8 +227,8 @@
}
- QFc <- diag(dims)
- if(is(object,"ContIC") & dims>1 )
+ QFc <- diag(dimsA)
+ if(is(object,"ContIC") & dimsA>1 )
{if (is(normtype(object),"QFNorm")) QFc <- QuadForm(normtype(object))
QFc0 <- solve( trafo %*% solve(L2Fam at FisherInfo) %*% t(trafo ))
if (is(normtype(object),"SelfNorm")|is(normtype(object),"InfoNorm"))
@@ -246,12 +248,12 @@
absInfoClass.f <- t(classIC) %*% QFc %*% classIC
absInfoClass <- absInfoEval(x.vec, absInfoClass.f)
- QF <- diag(dims)
- if(is(object,"ContIC") & dims>1 )
+ QF <- diag(dimsA)
+ if(is(object,"ContIC") & dimsA>1 )
{if (is(normtype(object),"QFNorm")) QF <- QuadForm(normtype(object))}
QF.5 <- sqrt(PosSemDefSymmMatrix(QF))
- IC1 <- as(diag(dims) %*% object at Curve, "EuclRandVariable")
+ IC1 <- as(diag(dimsA) %*% object at Curve, "EuclRandVariable")
absInfo.f <- t(IC1) %*% QF %*% IC1
absInfo <- absInfoEval(x.vec, absInfo.f)
@@ -266,9 +268,25 @@
# devNew()
omar <- par("mar")
- parArgs <- list(mar = c(bmar,omar[2],tmar,omar[4]))
- do.call(par,args=parArgs)
+ lpA <- max(length(to.draw),1)
+ parArgsL <- vector("list",lpA)
+ bmar <- rep(bmar, length.out=lpA)
+ tmar <- rep(tmar, length.out=lpA)
+ xaxt0 <- if(is.null(dots$xaxt)) {
+ if(is.null(dots$axes)||eval(dots$axes))
+ rep(par("xaxt"),lpA) else rep("n",lpA)
+ }else rep(eval(dots$xaxt),lpA)
+ yaxt0 <- if(is.null(dots$yaxt)) {
+ if(is.null(dots$axes)||eval(dots$axes))
+ rep(par("yaxt"),lpA) else rep("n",lpA)
+ }else rep(eval(dots$yaxt),lpA)
+ for( i in 1:lpA){
+ parArgsL[[i]] <- list(mar = c(bmar[i],omar[2],tmar[i],omar[4])
+ ,xaxt=xaxt0[i], yaxt= yaxt0[i]
+ )
+ }
+
pL.rel <- pL.abs <- pL <- expression({})
if(!is.null(dots$panel.last))
@@ -309,10 +327,10 @@
scaleX, scaleX.fct, scaleX.inv,
scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
- x.d <- resc.dat$X
- x.dC <- resc.datC$X
- y.d <- resc.dat$Y
- y.dC <- resc.datC$Y
+ x.dr <- resc.dat$X
+ x.dCr <- resc.datC$X
+ y.dr <- resc.dat$Y
+ y.dCr <- resc.datC$Y
lab.pts <- if(is.null(lab.pts))
cbind(i.d, i.dC)
@@ -338,18 +356,19 @@
f1 <- log(ICy0+1)*3*cex0[1]
f1c <- log(ICy0c+1)*3*cex0[2]
- if(!is.na(al0))
- col.pts <- sapply(col0, addAlphTrsp2col,alpha=al0)
+ col.pts <- if(!is.na(al0)) sapply(col0,
+ addAlphTrsp2col, alpha=al0) else col0
- do.pts(y0, ICy0, f1,col0[1],pch0[,1])
- do.pts(y0c, ICy0c, f1c,col0[2],pch0[,2])
+ do.pts(y0, ICy0r, f1,col.pts[1],pch0[,1])
+ do.pts(y0c, ICy0cr, f1c,col.pts[2],pch0[,2])
if(with.lab0){
- tx(y0, ICy0, lab.pts0, f1/2, col0[1])
- tx(y0c, ICy0c, lab.pts0C, f1c/2, col0[2])
+ tx(y0, ICy0r, lab.pts0, f1/2, col0[1])
+ tx(y0c, ICy0cr, lab.pts0C, f1c/2, col0[2])
}
pL0
- }, list(ICy0 = y.d, ICy0c = y.dC,
- pL0 = pL, y0 = x.d, y0c = x.dC,
+ }, list(ICy0c = y.dC, ICy0 = y.d,
+ ICy0r = y.dr, ICy0cr = y.dCr,
+ pL0 = pL, y0 = x.dr, y0c = x.dCr,
cex0 = cex.pts, pch0 = pch.pts, al0 = alp.v[1],
col0 = col.pts, with.lab0 = with.lab, n0 = n,
lab.pts0 = lab.pts[i.d], lab.pts0C = lab.pts[i.dC],
@@ -363,20 +382,29 @@
y0.vec <- jitter(y0.vec, factor = jitter.fac0[1])
y0c.vec <- jitter(y0c.vec, factor = jitter.fac0[2])
}
- f1 <- log(ICy0+1)*3*cex0[1]
- f1c <- log(ICy0c+1)*3*cex0[2]
- if(!is.na(al0))
- col.pts <- sapply(col0, addAlphTrsp2col, alpha=al0[i1])
+ col.pts <- if(!is.na(al0)) sapply(col0,
+ addAlphTrsp2col, alpha=al0[i1]) else col0
+ dotsP0 <- dotsP
+ resc.rel <- .rescalefct(y0, cbind(y0.vec,ICy0),
+ scaleX, scaleX.fct, scaleX.inv,
+ FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0)
+ resc.rel.c <- .rescalefct(y0c, cbind(y0c.vec,ICy0c),
+ scaleX, scaleX.fct, scaleX.inv,
+ FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0)
- do.pts(y0, y0.vec, f1,col0[1],pch0[,1])
- do.pts(y0c, y0c.vec, f1c,col0[2],pch0[,2])
+ f1 <- resc.rel$scy*3*cex0[1]
+ f1c <- resc.rel.c$scy*3*cex0[2]
+
+ do.pts(resc.rel$X, resc.rel$Y, f1,col.pts[1],pch0[,1])
+ do.pts(resc.rel.c$X, resc.rel.c$Y, f1c,col.pts[2],pch0[,2])
if(with.lab0){
- tx(y0, y0.vec, lab.pts0, f1/2, col0[1])
- tx(y0c, y0c.vec, lab.pts0C, f1c/2, col0[2])
+ tx(resc.rel$X, resc.rel$Y, lab.pts0, f1/2, col0[1])
+ tx(resc.rel.c$X, resc.rel.c$Y, lab.pts0C, f1c/2, col0[2])
}
pL0
}, list(ICy0c = y.dC, ICy0 = y.d,
+ ICy0r = y.dr, ICy0cr = y.dCr,
pL0 = pL, y0 = x.d, y0c = x.dC,
cex0 = cex.pts, pch0 = pch.pts, al0 = alp.v,
col0 = col.pts, with.lab0 = with.lab,n0 = n,
@@ -390,7 +418,7 @@
fac.leg <- if(dims0>1) 3/4 else .75/.8
-
+
dotsP$axes <- NULL
if(1 %in% to.draw){
resc <-.rescalefct(x.vec, function(x) absInfoEval(x,absInfo.f),
@@ -402,17 +430,23 @@
dotsP1 <- dotsP <- resc$dots
dotsP$yaxt <- dots$yaxt
- do.call(plot, args=c(list(resc$X, resc$Y, type = plty,
+ do.call(par, args = parArgsL[[1]])
+
+ do.call(plot, args=c(list(resc.C$X, resc.C$Y, type = plty,
lty = ltyI, col = colI, lwd = lwdI,
xlab = xlab, ylab = ylab.abs, panel.last = pL.abs),
dotsP1))
- do.call(lines, args=c(list(resc.C$X, resc.C$Y, type = plty,
+ do.call(lines, args=c(list(resc$X, resc$Y, type = plty,
lty = lty, lwd = lwd, col = col), dotsL))
- .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv,
- scaleY,scaleY.fct, scaleY.inv,
+ scaleX0 <- (xaxt0[1]!="n")
+ scaleY0 <- (yaxt0[1]!="n")
+ x.ticks0 <- if(xaxt0[1]!="n") x.ticks else NULL
+ y.ticks0 <- if(yaxt0[1]!="n") y.ticks[[1]] else NULL
+ .plotRescaledAxis(scaleX0, scaleX.fct, scaleX.inv,
+ scaleY0,scaleY.fct, scaleY.inv,
dots$xlim, dots$ylim, resc$X, ypts = 400,
- n = scaleN, x.ticks = x.ticks,
- y.ticks = y.ticks[[1]])
+ n = scaleN, x.ticks = x.ticks0,
+ y.ticks = y.ticks0, withbox = withbox)
if(with.legend)
legend(.legendCoord(legend.location[[1]], scaleX, scaleX.fct,
scaleY, scaleY.fct), legend = legend[[1]], bg = legend.bg,
@@ -426,15 +460,11 @@
}
if(dims > 1 && length(to.draw[to.draw!=1])>0){
- nrows <- trunc(sqrt(dims))
- ncols <- ceiling(dims/nrows)
+ nrows <- trunc(sqrt(dims0))
+ ncols <- ceiling(dims0/nrows)
if (!withSweave||!mfColRow)
- devNew()
- if(mfColRow)
- parArgs <- c(parArgs,list(mfrow = c(nrows, ncols)))
+ dN <- substitute({devNew()}) else substitute({})
- do.call(par,args=parArgs)
-
IC1.i.5 <- QF.5%*%IC1
classIC.i.5 <- QFc.5%*%classIC
for(i in 1:dims0){
@@ -449,6 +479,12 @@
y.vec1C <- sapply(resc.C$x, classIC.i.5 at Map[[indi]])^2/
absInfoEval(resc.C$x,absInfoClass.f)
+ if(mfColRow){
+ parArgsL[[i+in1to.draw]] <- c(parArgsL[[i+in1to.draw]],list(mfrow = c(nrows, ncols)))
+ eval(dN)
+ if(i==1) do.call(par,args=parArgsL[[i+in1to.draw]])
+ }else{do.call(par,args=parArgsL[[i+in1to.draw]])}
+
do.call(plot, args=c(list(resc$X, y.vec1, type = plty,
lty = lty, xlab = xlab, ylab = ylab.rel,
col = col, lwd = lwd, panel.last = pL.rel),
@@ -456,11 +492,15 @@
do.call(lines, args = c(list(resc.C$X, y.vec1C, type = plty,
lty = ltyI, col = colI, lwd = lwdI), dotsL))
- .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv,
+ scaleX0 <- (xaxt0[i+in1to.draw]!="n")
+ scaleY0 <- (yaxt0[i+in1to.draw]!="n")
+ x.ticks0 <- if(xaxt0[i+in1to.draw]!="n") x.ticks else NULL
+ y.ticks0 <- if(yaxt0[i+in1to.draw]!="n") y.ticks[[i+in1to.draw]] else NULL
+ .plotRescaledAxis(scaleX0, scaleX.fct, scaleX.inv,
FALSE,scaleY.fct, scaleY.inv, dots$xlim,
dots$ylim, resc$X, ypts = 400, n = scaleN,
- x.ticks = x.ticks,
- y.ticks = y.ticks[[i+in1to.draw]])
+ x.ticks = x.ticks0,
+ y.ticks = y.ticks0, withbox = withbox)
if(with.legend)
legend(.legendCoord(legend.location[[i1]],
scaleX, scaleX.fct, scaleY, scaleY.fct),
Modified: branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R 2013-07-06 16:35:17 UTC (rev 675)
+++ branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R 2013-07-08 20:12:57 UTC (rev 676)
@@ -14,25 +14,29 @@
# return value: list with (thinned out) x and y, X and Y and modified dots
X <- x
+ wI <- 1:length(x)
if(scaleX){
if(!is.null(xlim)){
dots$xlim <- scaleX.fct(xlim)
x <- x[x>=xlim[1] & x<=xlim[2]]
}
- X <- scaleX.fct(x)
+ Xo <- X <- scaleX.fct(x)
X <- distr:::.DistrCollapse(X, 0*X)$supp
+ wI <- sapply(X, function(uu){ w<- which(uu==Xo); if(length(w)>0) w[1] else NA})
+ wI <- wI[!is.na(wI)]
x <- scaleX.inv(X)
dots$axes <- NULL
dots$xaxt <- "n"
}
- Y <- y <- fct(x)
+ Y <- y <- if(is.function(fct)) fct(x) else fct[wI,1]
+ scy <- if(is.function(fct)) NA else fct[wI,2]
if(scaleY){
Y <- scaleY.fct(y)
if(!is.null(ylim)) dots$ylim <- scaleY.fct(ylim)
dots$axes <- NULL
dots$yaxt <- "n"
}
- return(list(x=x,y=y,X=X,Y=Y,dots=dots))
+ return(list(x=x,y=y,X=X,Y=Y,scy=scy,dots=dots))
}
if(FALSE){
@@ -53,7 +57,7 @@
.plotRescaledAxis <- function(scaleX,scaleX.fct, scaleX.inv,
scaleY,scaleY.fct, scaleY.inv,
xlim, ylim, X, ypts = 400, n = 11,
- x.ticks = NULL, y.ticks = NULL){
+ x.ticks = NULL, y.ticks = NULL, withbox = TRUE){
# plots rescaled axes acc. to logicals scaleX, scaleY
# to this end uses trafos scaleX.fct with inverse scale.inv
# resp. scaleY.fct; it respects xlim and ylim (given in orig. scale)
Modified: branches/robast-0.9/pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/man/infoPlot.Rd 2013-07-06 16:35:17 UTC (rev 675)
+++ branches/robast-0.9/pkg/RobAStBase/man/infoPlot.Rd 2013-07-08 20:12:57 UTC (rev 676)
@@ -46,8 +46,12 @@
\code{main} in \code{\link{plot.default}}.}
\item{sub}{logical: is a sub-title to be used? or \cr
just as argument \code{sub} in \code{\link{plot.default}}.}
- \item{tmar}{top margin -- useful for non-standard main title sizes}
- \item{bmar}{bottom margin -- useful for non-standard sub title sizes}
+ \item{tmar}{top margin -- useful for non-standard main title sizes;
+ may be a vector with individual values for
+ each of the panels to be plotted. }
+ \item{bmar}{bottom margin -- useful for non-standard sub title sizes;
+ may be a vector with individual values for
+ each of the panels to be plotted. }
\item{col}{color of IC in argument \code{object}.}
\item{lwd}{linewidth of IC in argument \code{object}.}
\item{lty}{line-type of IC in argument \code{object}.}
@@ -182,6 +186,15 @@
in panel "Abs", while the last 2*(number of plotted dimensions)
are the values for \code{ylim} for the plotted dimensions of the IC,
one pair for each dimension.
+
+Similarly, if argument \code{\dots} contains arguments \code{xaxt} or
+\code{yaxt}, these may be vectorized, with one value for each of the panels
+to be plotted. This is useful for stacking panels over each other, using
+a common x-axis (see example below).
+
+The \code{\dots} argument may also contain an argument \code{withbox} which
+if \code{TRUE} warrants that even if \code{xaxt} and \code{yaxt} both are
+\code{FALSE}, a box is drawn around the respective panel.
}
%\value{}
\references{
@@ -222,6 +235,19 @@
infoPlot(IC1, data=data[1:10], mfColRow = FALSE, panel.first= grid(),
with.lab = TRUE, cex.pts=0.7)
par(mfrow=c(1,1))
+
+ICr <- makeIC(list(function(x)sign(x),function(x)sign(abs(x)-qnorm(.75))),N)
+data <- r(N)(600)
+data.c <- c(data, 1000*data[1:30])
+par(mfrow=c(3,1))
+infoPlot(ICr, data=data.c, tmar=c(4.1,0,0), bmar=c(0,0,4.1),
+ xaxt=c("n","n","s"), mfColRow = FALSE, panel.first= grid(),
+ cex.pts=c(.9,.9), alpha.trsp=20, lwd=2, lwdI=1.5, col=3,
+ col.pts=c(3,2), colI=2, pch.pts=c(20,20), inner=FALSE,
+ scaleX = TRUE, scaleX.fct=pnorm, scaleX.inv=qnorm,
+ scaleY=TRUE, scaleY.fct=function(x) pchisq(x,df=1),
+ scaleY.inv=function(x)qchisq(x,df=1),legend.cex = 1.0)
+
}
}
Modified: branches/robast-0.9/pkg/RobAStBase/man/internal_plots.Rd
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/man/internal_plots.Rd 2013-07-06 16:35:17 UTC (rev 675)
+++ branches/robast-0.9/pkg/RobAStBase/man/internal_plots.Rd 2013-07-08 20:12:57 UTC (rev 676)
@@ -17,7 +17,7 @@
xlim, ylim, dots)
.plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct,
scaleY.inv, xlim, ylim, X, ypts = 400, n = 11,
- x.ticks = NULL, y.ticks = NULL)
+ x.ticks = NULL, y.ticks = NULL, withbox = TRUE)
.legendCoord(x, scaleX, scaleX.fct, scaleY, scaleY.fct)
.SelectOrderData(data, fct, which.lbs, which.Order)
}
@@ -66,6 +66,10 @@
a possible thin-out by \code{which.lbs} and after ordering in descending order
of the remaining observations. If this argument is \code{NULL} then no
(further) observation is excluded.}
+ \item{withbox}{logical of length 1. If \code{TRUE}, even if \code{scaleX} and
+ \code{scaleY} are both \code{FALSE} and, simultaneously, \code{x.ticks} and
+ \code{y.ticks} are both \code{NULL}, a respective box is drawn around the
+ panel; otherwise no box is drawn in this case. }
}
\details{
\code{.rescalefct} rescales, if necessary, x and y axis for use in plot
More information about the Robast-commits
mailing list