[Robast-commits] r782 - in branches/robast-1.0/pkg/RobAStBase: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 10 23:43:33 CEST 2014
Author: ruckdeschel
Date: 2014-08-10 23:43:33 +0200 (Sun, 10 Aug 2014)
New Revision: 782
Modified:
branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R
branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R
branches/robast-1.0/pkg/RobAStBase/inst/NEWS
branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd
Log:
[RobAStBase]
+ qqplot: some speedup in examples
+ wrapper functions ICPlot, InfoPlot, and ComparePlot use refined grids, i.e.,
the grids are plotted on user given coordinates (or rescaled coordinates)
Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-10 17:58:50 UTC (rev 781)
+++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-10 21:43:33 UTC (rev 782)
@@ -312,7 +312,16 @@
pL.rel <- pL.abs <- pL <- expression({})
if(!is.null(dots$panel.last))
{pL.rel <- pL.abs <- pL <- dots$panel.last}
+ pF.rel <- pF.abs <- expression({})
+ if(!is.null(dots$panel.first))
+ {pF.rel <- pF.abs <- dots$panel.first}
+ pF.rel <- substitute({.absInd <- FALSE
+ pF}, list(pF=pF.rel))
+ pF.abs <- substitute({.absInd <- TRUE
+ pF}, list(pF=pF.abs))
+ dotsP$panel.last <- dotsP$panel.first <- NULL
+
if(!is.null(data)){
n <- if(!is.null(dim(data))) nrow(data) else length(data)
@@ -465,7 +474,8 @@
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),
+ xlab = xlab, ylab = ylab.abs, panel.last = pL.abs,
+ panel.first = pF.abs),
dotsP1))
do.call(lines, args=c(list(resc$X, resc$Y, type = plty,
lty = lty, lwd = lwd, col = col), dotsL))
@@ -529,8 +539,8 @@
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),
- dotsP))
+ col = col, lwd = lwd, panel.last = pL.rel,
+ panel.first = pF.rel), dotsP))
do.call(lines, args = c(list(resc.C$X, y.vec1C, type = plty,
lty = ltyI, col = colI, lwd = lwdI), dotsL))
Modified: branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-10 17:58:50 UTC (rev 781)
+++ branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-10 21:43:33 UTC (rev 782)
@@ -104,7 +104,23 @@
if(is.null(mc$with.legend)) mc$with.legend <- TRUE
if(is.null(mc$rescale)) mc$rescale <- FALSE
if(is.null(mc$withCall)) mc$withCall <- TRUE
+
+
+ ##### plotting in grid
+
+ ..panelFirst <- .producePanelFirstS(
+ dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), TRUE,
+ x.ticks = eval(dots[["x.ticks"]]),
+ scaleX = eval(dots[["scaleX"]]),
+ scaleX.fct = dots[["scaleX.fct"]],
+ y.ticks = eval(dots[["y.ticks"]]),
+ scaleY = eval(dots[["scaleY"]]),
+ scaleY.fct = dots[["scaleY.fct"]])
+
+ ..panelLast <- dots[["panel.last"]]
###
+
+ ###
### 2. build up the argument list for the (powerful/fullfledged)
### graphics/diagnostics function;
##
@@ -153,7 +169,8 @@
,cex.lab = substitute(1.5)
,cex = substitute(1.5)
,bty = substitute("o")
- ,panel.first= substitute(grid())
+ ,panel.first= ..panelFirst
+ ,panel.last= ..panelLast
,col = substitute("blue")
), scaleList)
@@ -170,6 +187,7 @@
}
args <- .merge.lists(argsList, dots)
+
###
### 3. build up the call but grab it and write it into an object
###
@@ -269,7 +287,22 @@
if(is.null(mc$with.legend)) mc$with.legend <- TRUE
if(is.null(mc$rescale)) mc$rescale <- FALSE
if(is.null(mc$withCall)) mc$withCall <- TRUE
+
+ ##### plotting in grid
+ ..panelFirst <- .producePanelFirstS(
+ dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), FALSE,
+ x.ticks = eval(dots[["x.ticks"]]),
+ scaleX = eval(dots[["scaleX"]]),
+ scaleX.fct = dots[["scaleX.fct"]],
+ y.ticks = eval(dots[["y.ticks"]]),
+ scaleY = eval(dots[["scaleY"]]),
+ scaleY.fct = dots[["scaleY.fct"]])
+
+ ..panelLast <- dots[["panel.last"]]
###
+
+
+ ###
### 2. build up the argument list for the (powerful/fullfledged)
### graphics/diagnostics function;
##
@@ -305,8 +338,9 @@
,cex.lab = substitute(1.5)
,cex = substitute(1.5)
,bty = substitute("o")
- ,panel.first= substitute(grid())
,col = substitute("blue")
+ ,panel.first= ..panelFirst
+ ,panel.last= ..panelLast
), scaleList)
if(!missing(y)){c(argsList, y = substitute(y)
,cex.pts = substitute(0.3)
@@ -325,9 +359,7 @@
,cex.main = substitute(1.5)
,cex.lab = substitute(1.5)
,cex = substitute(1.5)
- ,bty = substitute("o")
- ,panel.first= substitute(grid())
- ,col = substitute("blue"))
+ ,bty = substitute("o"))
}
##parameter for plotting
@@ -452,7 +484,22 @@
if(is.null(mc$rescale)) mc$rescale <- FALSE
if(is.null(mc$withCall)) mc$withCall <- TRUE
iny <- if(missing(y)) TRUE else is.null(y)
+
+ ##### plotting in grid
+ ..panelFirst <- .producePanelFirstS(
+ dots[["panel.first"]],IC1,eval(dots[["to.draw.arg"]]), FALSE,
+ x.ticks = eval(dots[["x.ticks"]]),
+ scaleX = eval(dots[["scaleX"]]),
+ scaleX.fct = dots[["scaleX.fct"]],
+ y.ticks = eval(dots[["y.ticks"]]),
+ scaleY = eval(dots[["scaleY"]]),
+ scaleY.fct = dots[["scaleY.fct"]])
+
+ ..panelLast <- dots[["panel.last"]]
###
+
+
+ ###
### 2. build up the argument list for the (powerful/fullfledged)
### graphics/diagnostics function;
##
@@ -512,8 +559,9 @@
,cex.lab = substitute(1.5)
,cex = substitute(1.5)
,bty = substitute("o")
- ,panel.first= substitute(grid())
,col = substitute("blue")
+ ,panel.first= ..panelFirst
+ ,panel.last= ..panelLast
), scaleList)
if(!is.null(IC3)) argsList$obj3 <- substitute(IC3)
@@ -555,3 +603,92 @@
}
+.getDimsTD <- function(L2Fam,to.draw.arg){
+ trafO <- trafo(L2Fam at param)
+ dims <- nrow(trafO)
+ dimnms <- c(rownames(trafO))
+ if(is.null(dimnms))
+ dimnms <- paste("dim",1:dims,sep="")
+ to.draw <- 1:dims
+ if(! is.null(to.draw.arg)){
+ if(is.character(to.draw.arg))
+ to.draw <- pmatch(to.draw.arg, dimnms)
+ else if(is.numeric(to.draw.arg))
+ to.draw <- to.draw.arg
+ }
+ return(length(to.draw))
+}
+
+
+.producePanelFirstS <- function(panelFirst,IC,to.draw.arg,isInfoPlot=FALSE,
+ x.ticks, scaleX, scaleX.fct,
+ y.ticks, scaleY, scaleY.fct){
+
+
+ L2Fam <- eval(IC at CallL2Fam)
+ if(is.null(scaleX.fct)) scaleX.fct <- p(L2Fam)
+ ndim <- .getDimsTD(L2Fam,to.draw.arg)
+ if(is.null(scaleY.fct)){
+ scaleY.fct <- .fillList(pnorm,ndim)
+ }else{
+ scaleY.fct <- .fillList(scaleY.fct,ndim)
+ }
+ ..y.ticks <- .fillList(y.ticks,ndim)
+ .xticksS <- substitute({
+ .x.ticks <- x.ticks0
+ if(is.null(.x.ticks))
+ .x.ticks <- axTicks(1, axp=par("xaxp"), usr=par("usr"))
+ scaleX00 <- FALSE
+ if(!is.null(scaleX0)) scaleX00 <- scaleX0
+ if(scaleX00) .x.ticks <- scaleX.fct0(.x.ticks)
+ },
+ list(x.ticks0 = x.ticks, scaleX0 = scaleX, scaleX.fct0 = scaleX.fct)
+ )
+
+ getYI <- if(isInfoPlot){
+ substitute({
+ i0 <- if(exists("i")) get("i") else 1
+ .y.ticks <- if(.absInd) NULL else .y.ticksL[[i0]]
+ })
+ }else{
+ substitute({
+ .y.ticks <- .y.ticksL[[i]]
+ })
+
+ }
+ assYI <- if(isInfoPlot){
+ substitute({
+ i0 <- if(exists("i")) get("i") else 1
+ if(.absInd) .y.ticks <- scaleY.fct0[[i0]](.y.ticks)
+ })
+ }else{
+ substitute({
+ .y.ticks <- scaleY.fct0[[i]](.y.ticks)
+ }, list(scaleY.fct0 = scaleY.fct))
+
+ }
+
+ .yticksS <- substitute({
+ .y.ticksL <- y.ticks0
+ getYI0
+ if(is.null(.y.ticks))
+ .y.ticks <- axTicks(2, axp=par("yaxp"), usr=par("usr"))
+ scaleY00 <- FALSE
+ if(!is.null(scaleY0)) scaleY00 <- scaleY0
+ if(scaleY00) assYI0
+ },
+ list(y.ticks0 = y.ticks, scaleY0 = scaleY, scaleY.fct0 = scaleY.fct,
+ getYI0 = getYI, assYI0 = assYI)
+ )
+
+ ..panelFirst <- substitute({
+ pF
+ .xticksS0
+ .yticksS0
+ abline(v=.x.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd"))
+ abline(h=.y.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd"))
+ },list(pF=if(is.null(panelFirst)) expression({}) else panelFirst,
+ .xticksS0 = .xticksS, .yticksS0 = .yticksS
+ ))
+ return(..panelFirst)
+}
\ No newline at end of file
Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 17:58:50 UTC (rev 781)
+++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 21:43:33 UTC (rev 782)
@@ -34,7 +34,8 @@
default use an equidistant grid on the rescaled x-Axis.
+ qqplot-method for c("ANY","InfRobModel") gains argument
'cex.pts.fun' to better control the scaling of points-sizes
-
++ new helper function cutoff.quant() to produce cutoff from model quantiles
+
GENERAL ENHANCEMENTS:
under the hood:
Modified: branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-10 17:58:50 UTC (rev 781)
+++ branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-10 21:43:33 UTC (rev 782)
@@ -131,7 +131,7 @@
neighbor = ContNeighborhood(radius = 0.4))
x <- r(Norm(15,sqrt(30)))(20)
qqplot(x, RobM)
-qqplot(x, RobM, alpha.CI=0.9)
+qqplot(x, RobM, alpha.CI=0.9, add.points.CI=FALSE)
## further examples for ANY,kStepEstimator-method
## in example to roptest() in package ROptEst
}
More information about the Robast-commits
mailing list