[Robast-commits] r786 - in branches/robast-1.0/pkg/RobAStBase: R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Aug 19 03:51:56 CEST 2014


Author: ruckdeschel
Date: 2014-08-19 03:51:56 +0200 (Tue, 19 Aug 2014)
New Revision: 786

Added:
   branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R
   branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd
Modified:
   branches/robast-1.0/pkg/RobAStBase/R/00internal.R
   branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R
   branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R
   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/comparePlot.Rd
   branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd
   branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd
Log:
[RobAStBase] + comparePlot, infoPlot, and the plot-Method for ICs gain an argument
  with.automatic.grid; if TRUE a corresponding grid oriented at tickmarks
  is produced; this also works for rescaled axes
+ arguments panel.first, panel.last for plot-methods can now be lists


Modified: branches/robast-1.0/pkg/RobAStBase/R/00internal.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/00internal.R	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/R/00internal.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -17,6 +17,7 @@
           {as.character(arg) %in% names(formals(fct))}
 
 .fillList <- function(list0, len = length(list0)){
+            if(is.null(list0)) return(vector("list",len))
             if(!is.list(list0)) list0 <- list(list0)
             if(len == length(list0))
                return(list0)
@@ -129,3 +130,18 @@
 }
 
 
+.panel.mingle <- function(dots, element){
+  pF <- dots[[element]]
+  if(is.list(pF)) return(pF)
+  pFr <- if(typeof(pF)=="symbol") eval(pF) else{
+     pFc <- as.call(pF)
+     if(as.list(pFc)[[1]] == "list"){
+        lis <- vector("list",length(as.list(pFc))-1)
+        for(i in 1:length(lis)){
+            lis[[i]] <- pFc[[i+1]]
+        }
+        lis
+     }else pF
+  }
+  return(pFr)
+}

Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -3,6 +3,7 @@
              main = FALSE, inner = TRUE, sub = FALSE, 
              col.inner = par("col.main"), cex.inner = 0.8, 
              bmar = par("mar")[1], tmar = par("mar")[3],
+             with.automatic.grid = TRUE,
              with.legend = FALSE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
@@ -59,6 +60,38 @@
         scaleY.fct <- .fillList(scaleY.fct, dims0)
         scaleY.inv <- .fillList(scaleY.inv, dims0)
 
+        pF <- expression({})
+        if(!is.null(dots[["panel.first"]])){
+            pF <- .panel.mingle(dots,"panel.first")
+        }
+        ..panelFirst <- .fillList(pF,dims0)
+        if(with.automatic.grid)
+            ..panelFirst <- .producePanelFirstS(
+                  ..panelFirst,x, to.draw.arg, FALSE,
+                  x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct,
+                  y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct)
+        gridS <- if(with.automatic.grid)
+                 substitute({grid <- function(...){}}) else expression({})
+        pF <- vector("list",dims0)
+        if(dims0>0)
+           for(i in 1:dims0){
+               pF[[i]] <- substitute({ gridS0
+                                        pF0},
+                          list(pF0=..panelFirst[[i]], gridS0=gridS))
+           }
+
+        pL <- expression({})
+        if(!is.null(dots[["panel.last"]])){
+            pL <- .panel.mingle(dots,"panel.last")
+        }
+        ..panelLast <- .fillList(pL,dims0)
+        pL <- vector("list",dims0)
+        if(dims0>0)
+           for(i in 1:dims0)
+               pL[[i]] <- if(is.null(..panelLast[[i]])) expression({}) else ..panelLast[[i]]
+
+        dots$panel.last <- dots$panel.first <- NULL
+
         MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T)
         MBRB <- MBRB * MBR.fac
 
@@ -271,8 +304,12 @@
                finiteEndpoints[3] <- is.finite(scaleY.inv[[i]](min(y.vec1, ylim[1,i])))
                finiteEndpoints[4] <- is.finite(scaleY.inv[[i]](max(y.vec1, ylim[2,i])))
             }
+
+
             do.call(plot, args=c(list(x=x.vec1, y=y.vec1, type = plty, lty = lty,
-                                      xlab = xlab, ylab = ylab), dots))
+                                      xlab = xlab, ylab = ylab,
+                                      panel.first = pF[[i]],
+                                      panel.last = pL[[i]]), dots))
             .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv,
                               scaleY,scaleY.fct[[i]], scaleY.inv[[i]],
                               xlim[,i], ylim[,i], x.vec1, ypts = 400, n = scaleN,
@@ -355,15 +392,22 @@
     dots.without <- dots
     dots.without$col <- dots.without$cex <- dots.without$pch <- NULL
 
+    dims0 <- .getDimsTD(L2Fam,dots[["to.draw.arg"]])
+
     pL <- expression({})
     if(!is.null(dots$panel.last))
-        pL <- dots$panel.last
+        pL <- .panel.mingle(dots,"panel.last")
+    pL <- .fillList(pL, dims0)
+    if(dims0) for(i in 1:dims0){
+       if(is.null(pL[[i]])) pL[[i]] <- expression({})
+    }
     dots$panel.last <- NULL
 
+
     pL <- substitute({
         y1 <- y0s
         ICy <- sapply(y0s,ICMap0[[indi]])
-        print(xlim[,i])
+        #print(xlim[,i])
         resc.dat <-.rescalefct(y0s, function(x) sapply(x,ICMap0[[indi]]),
                               scaleX, scaleX.fct, scaleX.inv,
                               scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i],

Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -6,6 +6,7 @@
              col = par("col"), lwd = par("lwd"), lty,
              col.inner = par("col.main"), cex.inner = 0.8,
              bmar = par("mar")[1], tmar = par("mar")[3],
+             with.automatic.grid = TRUE,
              with.legend = FALSE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
@@ -253,7 +254,31 @@
 
         dotsT$main <- dotsT$cex.main <- dotsT$col.main <- dotsT$line <- NULL
 
-        pL <- if(!is.null(dotsP$panel.last)) dotsP$panel.last else expression({})
+        pF <- expression({})
+        if(!is.null(dots[["panel.first"]])){
+            pF <- .panel.mingle(dots,"panel.first")
+        }
+        ..panelFirst <- .fillList(pF,dims0)
+        if(with.automatic.grid)
+           ..panelFirst <- .producePanelFirstS(
+                ..panelFirst,obj1 , to.draw.arg, FALSE,
+                x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct,
+                y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct)
+        gridS <- if(with.automatic.grid)
+              substitute({grid <- function(...){}}) else expression({})
+        pF <- vector("list",dims0)
+        if(dims0>0)
+           for(i in 1:dims0){
+               pF[[i]] <- substitute({ gridS0
+                                        pF0},
+                          list(pF0=..panelFirst[[i]], gridS0=gridS))
+           }
+        dots$panel.first <- NULL
+        pL <- expression({})
+        if(!is.null(dots[["panel.last"]])){
+            pL <- .panel.mingle(dots,"panel.last")
+        }
+        pL <- .fillList(pL, dims0)
         dotsP$panel.last <- NULL
 
         sel1 <- sel2 <- sel3 <- sel4 <- NULL
@@ -370,7 +395,7 @@
             do.call(plot, args=c(list(x = resc1$X, y = y0,
                  type = "n", xlab = xlab, ylab = ylab,
                  lty = lty[1], col = addAlphTrsp2col(col[1],0),
-                 lwd = lwd[1]), dotsP, list(panel.last = pL)))
+                 lwd = lwd[1]), dotsP, list(panel.last = pL[[i]], panel.first=pF[[i]])))
             if(plty=="p")
                do.call(matpoints, args = c(list( x = resc1$X, y = matp,
                     col = col), dots.points))

Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -6,6 +6,7 @@
              main = FALSE, inner = TRUE, sub = FALSE, 
              col.inner = par("col.main"), cex.inner = 0.8, 
              bmar = par("mar")[1], tmar = par("mar")[3], 
+             with.automatic.grid = TRUE,
              with.legend = TRUE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv,
@@ -309,17 +310,46 @@
             }
 
             
-            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))
+            pL <- expression({})
+            if(!is.null(dots[["panel.last"]])){
+                pL <- .panel.mingle(dots,"panel.last")
+            }
+            pL <- .fillList(pL, length(to.draw))
+            if(in1to.draw){
+               pL.rel <- pL[[1]]
+               pL.abs <- pL[-1]
+            }else{ pL.abs <- pL }
+            
 
+            pF <- expression({})
+            if(!is.null(dots[["panel.first"]])){
+               pF <- .panel.mingle(dots,"panel.first")
+            }
+            ..panelFirst <- .fillList(pF, length(to.draw))
+            if(with.automatic.grid)
+                ..panelFirst <- .producePanelFirstS(
+                    ..panelFirst,object, to.draw.arg, TRUE,
+                    x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct,
+                    y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct)
+            gridS <- if(with.automatic.grid)
+                  substitute({grid <- function(...){}}) else expression({})
+            if(in1to.draw){
+               pF.rel <- substitute({ gridS0
+                                      .absInd <- FALSE
+                                      pF0 <- pF
+                                      pF0[[1+i]] }, list(pF=..panelFirst, gridS0=gridS))
+               pF.abs <- substitute({ gridS0
+                                      .absInd <- TRUE
+                                      pF
+                                      }, list(pF=..panelFirst[[1]], gridS0=gridS))
+            }else{
+               pF.abs <- NULL
+               pF.rel <- substitute({ gridS0
+                                      .absInd <- FALSE
+                                      pF0 <- pF
+                                      pF0[[i]]
+                                      }, list(pF=..panelFirst, gridS0=gridS))
+            }
             dotsP$panel.last <- dotsP$panel.first <- NULL
             
             if(!is.null(data)){

Added: branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R	                        (rev 0)
+++ branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -0,0 +1,97 @@
+.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)
+      }, list(scaleY.fct0 = scaleY.fct))
+  }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  <- panelFirst
+  if(length(panelFirst)){
+     for(i in 1:length(panelFirst)){
+         ..panelFirst[[i]] <- substitute({
+             pFi
+             .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(pFi = if(is.null(panelFirst[[i]])) expression({}) else panelFirst[[i]],
+                 .xticksS0 = .xticksS, .yticksS0 = .yticksS)
+          )
+     }
+   }
+   return(..panelFirst)
+}

Modified: branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R	2014-08-19 01:51:56 UTC (rev 786)
@@ -106,18 +106,6 @@
   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"]]
   ###
   
   ###
@@ -143,6 +131,7 @@
                      ,cex.inner = substitute(0.8)
                      ,bmar = substitute(par("mar")[1])
                      ,tmar = substitute(par("mar")[3])
+                     ,with.automatic.grid = substitute(TRUE)
                      ,with.legend = substitute(TRUE)
                      ,legend = substitute(NULL)
                      ,legend.bg = substitute("white")
@@ -169,8 +158,8 @@
                      ,cex.lab = substitute(1.5)
                      ,cex = substitute(1.5)
                      ,bty = substitute("o")
-                     ,panel.first= ..panelFirst
-                     ,panel.last= ..panelLast
+                     ,panel.first= substitute(NULL)
+                     ,panel.last= substitute(NULL)
                      ,col = substitute("blue")
     ), scaleList)
 
@@ -288,21 +277,8 @@
   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;
   ##
@@ -319,6 +295,7 @@
                      ,cex.inner = substitute(0.8)
                      ,bmar = substitute(par("mar")[1])
                      ,tmar = substitute(par("mar")[3])
+                     ,with.automatic.grid = substitute(TRUE)
                      ,with.legend = substitute(FALSE)
                      ,legend = substitute(NULL)
                      ,legend.bg = substitute("white")
@@ -339,8 +316,8 @@
                      ,cex = substitute(1.5)
                      ,bty = substitute("o")
                      ,col = substitute("blue")
-                     ,panel.first= ..panelFirst
-                     ,panel.last= ..panelLast
+                     ,panel.first= substitute(NULL)
+                     ,panel.last= substitute(NULL)
     ), scaleList)
   if(!missing(y)){c(argsList, y = substitute(y)
                      ,cex.pts = substitute(0.3)
@@ -485,17 +462,6 @@
   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"]]
   ###
 
 
@@ -521,6 +487,7 @@
                      ,cex.inner = substitute(0.8)
                      ,bmar = substitute(par("mar")[1])
                      ,tmar = substitute(par("mar")[3])
+                     ,with.automatic.grid = substitute(TRUE)
                      ,with.legend = substitute(FALSE)
                      ,legend = substitute(NULL)
                      ,legend.bg = substitute("white")
@@ -560,8 +527,8 @@
                      ,cex = substitute(1.5)
                      ,bty = substitute("o")
                      ,col = substitute("blue")
-                     ,panel.first= ..panelFirst
-                     ,panel.last= ..panelLast
+                     ,panel.first= substitute(NULL)
+                     ,panel.last= substitute(NULL)
     ), scaleList)
     
     if(!is.null(IC3)) argsList$obj3 <- substitute(IC3)
@@ -603,92 +570,3 @@
 
 }
 
-.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-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS	2014-08-19 01:51:56 UTC (rev 786)
@@ -12,6 +12,10 @@
 #######################################
 
 user-visible CHANGES:
++ comparePlot, infoPlot, and the plot-Method for ICs gain an argument
+  with.automatic.grid; if TRUE a corresponding grid oriented at tickmarks
+  is produced; this also works for rescaled axes
++ arguments panel.first, panel.last for plot-methods can now be lists
 + infoPlot and comparePlot gain an argument cex.pts.fun to enable individual 
   scaling of the point sizes to be plotted onto each of the plotted curves
 + .ddPlot.MatNtNtCoCo, and also ddPlot, outlyingnessPlot gain an 

Modified: branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd	2014-08-19 01:51:56 UTC (rev 786)
@@ -17,6 +17,7 @@
              col = par("col"), lwd = par("lwd"), lty, 
              col.inner = par("col.main"), cex.inner = 0.8, 
              bmar = par("mar")[1], tmar = par("mar")[3],
+             with.automatic.grid = TRUE,
              with.legend = FALSE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
@@ -61,6 +62,9 @@
           to the current setting of \code{cex}; as in 
           \code{\link[graphics]{par}}}
   \item{col.inner}{character or integer code; color for the inner title}              
+  \item{with.automatic.grid}{logical; should a grid be plotted alongside
+      with the ticks of the axes, automatically? If \code{TRUE} a respective
+      call to \code{grid} in argument \code{panel.first} is ignored. }
   \item{with.legend}{logical; shall a legend be plotted?}
   \item{legend}{either \code{NULL} or a list of length (number of plotted panels)
                 of items which can be used as argument \code{legend} in
@@ -201,6 +205,13 @@
 length 2*(number of plotted dimensions); in the case of longer length, 
 these are the values for \code{ylim} for the plotted dimensions of the IC, 
 one pair for each dimension.
+
+In addition, argument \code{\dots} may contain arguments \code{panel.first},
+\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning
+and at the very end of each panel (within the then valid coordinates).
+To be able to use these hooks for each panel individually, they may also be
+lists of expressions (of the same length as the number of panels and
+run through in the same order as the panels).
 }
 
 %\value{}

Modified: branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd	2014-08-19 01:51:56 UTC (rev 786)
@@ -16,6 +16,7 @@
              main = FALSE, inner = TRUE, sub = FALSE, 
              col.inner = par("col.main"), cex.inner = 0.8, 
              bmar = par("mar")[1], tmar = par("mar")[3],
+             with.automatic.grid = TRUE,
              with.legend = TRUE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv,
@@ -62,6 +63,9 @@
           to the current setting of \code{cex}; as in 
           \code{\link[graphics]{par}}.}
   \item{col.inner}{character or integer code; color for the inner title}              
+  \item{with.automatic.grid}{logical; should a grid be plotted alongside
+      with the ticks of the axes, automatically? If \code{TRUE} a respective
+      call to \code{grid} in argument \code{panel.first} is ignored. }
   \item{with.legend}{logical; shall a legend be plotted?}
   \item{legend}{either \code{NULL} or a list of length (number of plotted panels)
                 of items which can be used as argument \code{legend} in
@@ -218,6 +222,13 @@
 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.
+
+In addition, argument \code{\dots} may contain arguments \code{panel.first},
+\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning
+and at the very end of each panel (within the then valid coordinates).
+To be able to use these hooks for each panel individually, they may also be
+lists of expressions (of the same length as the number of panels and
+run through in the same order as the panels).
 }
 %\value{}
 \references{

Added: branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd	                        (rev 0)
+++ branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd	2014-08-19 01:51:56 UTC (rev 786)
@@ -0,0 +1,59 @@
+\name{internal_helpers_for_producing_grids_in_plots_RobAStBase}
+\alias{internal_helpers_for_producing_grids_in_plots_RobAStBase}
+\alias{.getDimsTD}
+\alias{.producePanelFirstS}
+
+\title{Internal / Helper functions of package RobAStBase for grids in plot functions}
+
+\description{
+These functions are internally used helper functions for \code{\link{plot}},
+\code{\link{infoPlot}} \code{\link{comparePlot}} in package \pkg{RobAStBase}.}
+
+\usage{
+.getDimsTD(L2Fam,to.draw.arg)
+.producePanelFirstS(panelFirst,IC,to.draw.arg, isInfoPlot=FALSE,
+                    x.ticks, scaleX, scaleX.fct,
+                    y.ticks, scaleY, scaleY.fct)
+}
+\arguments{
+  \item{L2Fam}{the model at which the plot is produced (of class \code{L2ParamFamily}).}
+  \item{to.draw.arg}{Either \code{NULL} (default;
+                          everything is plotted) or a vector of either integers
+                         (the indices of the subplots to be drawn) or characters
+                         --- the names of the subplots to be drawn: these
+                         names are to be chosen either among the row names of
+                         the trafo matrix
+                         \code{rownames(trafo(eval(x at CallL2Fam)@param))}
+                         or if the last expression is \code{NULL} a
+                         vector \code{"dim<dimnr>"}, \code{dimnr} running through
+                         the number of rows of the trafo matrix.
+                         }
+  \item{panelFirst}{argument \code{panel.first} to be mingled for grid plotting.}
+  \item{IC}{object of class \code{"InfluenceCurve"} }
+  \item{isInfoPlot}{logical; is this function to be used in \code{infoPlot} or
+                    (\code{TRUE}) in another plot (\code{FALSE})? }
+  \item{x.ticks}{numeric: coordinates in original scale of user-given ticks on x-axis.}
+  \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of
+          the underlying distribution)?}
+  \item{scaleX.fct}{an isotone, vectorized function mapping the domain of the IC
+            to [0,1]; if \code{scaleX} is \code{TRUE} and \code{scaleX.fct} is
+            missing, the cdf of the underlying observation distribution.}
+  \item{y.ticks}{numeric: coordinates in original scale of user-given ticks on y-axis.}
+  \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?}
+  \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the
+            range of the respective coordinate of the IC
+            to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.}
+}
+\details{
+\code{.getDimsTD} computes the number of panels to be plotted.
+\code{.producePanelFirstS} produces an unevaluated expression to be
+used as argument \code{panel.first} in the diagnostic plots; i.e.;
+knowing the actual tickmarks of the axis at the time of evaluation,
+code is inserted to plot horizontal and vertical grid lines through
+these tickmarks.
+}
+
+
+\keyword{internal}
+\concept{utilities}
+\keyword{hplot}

Modified: branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd	2014-08-11 01:51:25 UTC (rev 785)
+++ branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd	2014-08-19 01:51:56 UTC (rev 786)
@@ -11,6 +11,7 @@
              main = FALSE, inner = TRUE, sub = FALSE,
              col.inner = par("col.main"), cex.inner = 0.8,
              bmar = par("mar")[1], tmar = par("mar")[3],
+             with.automatic.grid = TRUE,
              with.legend = FALSE, legend = NULL, legend.bg = "white",
              legend.location = "bottomright", legend.cex = 0.8,
              withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
@@ -46,6 +47,9 @@
           to the current setting of \code{cex}; as in
           \code{\link[graphics]{par}}}
   \item{col.inner}{character or integer code; color for the inner title}
+  \item{with.automatic.grid}{logical; should a grid be plotted alongside
+      with the ticks of the axes, automatically? If \code{TRUE} a respective
+      call to \code{grid} in argument \code{panel.first} is ignored. }
   \item{with.legend}{logical; shall a legend be plotted?}
   \item{legend}{either \code{NULL} or a list of length (number of plotted panels)
                 of items which can be used as argument \code{legend} in
@@ -184,6 +188,12 @@
 The \code{IC,numeric}-method calls the \code{IC,missing}-method but in
 addition plots the values of a dataset into the IC.
 
+In addition, argument \code{\dots} may contain arguments \code{panel.first},
+\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning
+and at the very end of each panel (within the then valid coordinates).
+To be able to use these hooks for each panel individually, they may also be
+lists of expressions (of the same length as the number of panels and
+run through in the same order as the panels).
 }
 \examples{
 IC1 <- new("IC")



More information about the Robast-commits mailing list