[Robast-commits] r529 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobAStBase/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jan 11 13:38:28 CET 2013


Author: ruckdeschel
Date: 2013-01-11 13:38:28 +0100 (Fri, 11 Jan 2013)
New Revision: 529

Modified:
   branches/robast-0.9/pkg/ROptEst/R/cniperCont.R
   branches/robast-0.9/pkg/ROptEst/R/makedots.R
   branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd
   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/R/selectorder.R
Log:
RobAStBase / ROptEst diagnostics: inserted comments to helper functions;
.rescalefct looses argument scaleY.inv (not needed).


Modified: branches/robast-0.9/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/cniperCont.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/ROptEst/R/cniperCont.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -113,7 +113,19 @@
     })
 
 if(PETER){
-.plotData <- function(data, dots, origCl, fun, L2Fam, IC){
+.rescalefct <- RobAStBase:::.rescalefct
+.makedotsP <- RobAStBase:::.makedotsP
+.SelectOrderData <- RobAStBase:::.SelectOrderData
+
+.plotData <- function(
+  ## helper function for cniper-type plots to plot in data
+   data, # data to be plot in
+   dots, # dots from the calling function
+   origCl, # call from the calling function
+   fun, # function to determine risk difference
+   L2Fam, # L2Family
+   IC # IC1 in cniperContPlot and eta in cniperPointPlot
+){
                dotsP <- .makedotsP(dots)
                dotsP$col <- rep(origCl$col.pts, length.out=n)
                dotsP$pch <- rep(origCl$pch.pts, length.out=n)
@@ -131,9 +143,9 @@
                x.d <- sel.C$data
                n <- length(i.d)
 
-               resc.dat <-.rescalefct(x.d, function(x) sapply(x,fun),
+               resc.dat <- .rescalefct(x.d, function(x) sapply(x,fun),
                               origCl$scaleX, origCl$scaleX.fct, origCl$scaleX.inv,
-                              origCl$scaleY, origCl$scaleY.fct, origCl$scaleY.inv,
+                              origCl$scaleY, origCl$scaleY.fct,
                               dots$xlim, dots$ylim, dots)
 
                dotsP$x <- resc.dat$X
@@ -209,10 +221,8 @@
             riskfct(R2,r*fct(normtype(risk))(y2))
         }
         x <-  q(L2Fam)(seq(lower,upper,length=n))
-        resc <- RobAStBase:::.rescalefct(x, function(u) sapply(u,fun),
-                              scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dots)
+        resc <- .rescalefct(x, function(u) sapply(u,fun), scaleX, scaleX.fct,
+                     scaleX.inv, scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
         x <- dots$x <- resc$X
         dots$y <- resc$Y
         dots$type <- "l"
@@ -252,9 +262,8 @@
         dots$h <- if(scaleY) scaleY.fct(0) else 0
         do.call(abline, dots)
 
-        RobAStBase:::.plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv,
-                          scaleY,scaleY.fct, scaleY.inv,
-                          dots$xlim, dots$ylim, x, ypts = 400)
+        .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct,
+                          scaleY.inv, dots$xlim, dots$ylim, x, ypts = 400)
         if(!is.null(data))
            return(.plotData(data, dots, mc, fun, L2Fam, IC1))
         invisible(NULL)
@@ -339,10 +348,8 @@
 
 
         x <- q(L2Fam)(seq(lower,upper,length=n))
-        resc <- RobAStBase:::.rescalefct(x, function(u) sapply(u,fun),
-                              scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dots)
+        resc <- .rescalefct(x, function(u) sapply(u,fun), scaleX, scaleX.fct,
+                     scaleX.inv, scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
         x <- dots$x <- resc$X
         dots$y <- resc$Y
 
@@ -381,10 +388,8 @@
 
         dots$h <- if(scaleY) scaleY.fct(0) else 0
         do.call(abline, dots)
-        RobAStBase:::.plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv,
-                          scaleY,scaleY.fct, scaleY.inv,
-                          dots$xlim, dots$ylim, x, ypts = 400)
-
+        .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct,
+                          scaleY.inv, dots$xlim, dots$ylim, x, ypts = 400)
         if(!is.null(data))
            return(.plotData(data, dots, mc, fun, L2Fam, eta))
         return(invisible(NULL))

Modified: branches/robast-0.9/pkg/ROptEst/R/makedots.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/makedots.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/ROptEst/R/makedots.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -1,3 +1,4 @@
+## dots modifications
 .makedotsLowLevel <- function(dots){
        dots$sub <- dots$xlab <- dots$ylab <- dots$main <- dots$type <- NULL
        dots$xlim <- dots$ylim <- dots$yaxt <- dots$axes <- dots$xaxt <- NULL

Modified: branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd	2013-01-11 12:38:28 UTC (rev 529)
@@ -17,27 +17,27 @@
   other procedure.
 }
 \usage{
-cniperContPlot(IC1, IC2, data = NULL, ...,
-               neighbor, risk, lower = getdistrOption("DistrResolution"),
-               upper = 1-getdistrOption("DistrResolution"), n = 101,
-               scaleX = FALSE, scaleX.fct, scaleX.inv,
-               scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
-               cex.pts = 1, col.pts = par("col"),
-               pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
-               lab.pts = NULL, lab.font = NULL,
-               which.lbs = NULL, which.Order  = NULL,
-               return.Order = FALSE)
+%cniperContPlot(IC1, IC2, data = NULL, ...,
+%               neighbor, risk, lower = getdistrOption("DistrResolution"),
+%               upper = 1-getdistrOption("DistrResolution"), n = 101,
+%               scaleX = FALSE, scaleX.fct, scaleX.inv,
+%               scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+%               cex.pts = 1, col.pts = par("col"),
+%               pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+%               lab.pts = NULL, lab.font = NULL,
+%               which.lbs = NULL, which.Order  = NULL,
+%               return.Order = FALSE)
 
-cniperPointPlot(L2Fam, data=NULL, ..., neighbor, risk= asMSE(),
-                lower=getdistrOption("DistrResolution"),
-                upper=1-getdistrOption("DistrResolution"), n = 101,
-                scaleX = FALSE, scaleX.fct, scaleX.inv,
-                scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
-                cex.pts = 1, col.pts = par("col"),
-                pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
-                lab.pts = NULL, lab.font = NULL,
-                which.lbs = NULL, which.Order  = NULL,
-                return.Order = FALSE)
+%cniperPointPlot(L2Fam, data=NULL, ..., neighbor, risk= asMSE(),
+%                lower=getdistrOption("DistrResolution"),
+%                upper=1-getdistrOption("DistrResolution"), n = 101,
+%                scaleX = FALSE, scaleX.fct, scaleX.inv,
+%                scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+%                cex.pts = 1, col.pts = par("col"),
+%                pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+%                lab.pts = NULL, lab.font = NULL,
+%                which.lbs = NULL, which.Order  = NULL,
+%                return.Order = FALSE)
 
 
 cniperCont(IC1, IC2, L2Fam, neighbor, risk, ...)
@@ -62,47 +62,47 @@
   \item{lower, upper}{ the lower and upper end points of the 
           contamination interval (in prob-scale). }
   \item{n}{ number of points between \code{lower} and \code{upper}}
-  \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of
-          the underlying distribution)?}
-  \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?}
-  \item{scaleX.fct}{an isotone, vectorized function mapping the domain of the IC(s)
-            to [0,1]; if \code{scaleX} is \code{TRUE} and \code{scaleX.fct} is
-            missing, the cdf of the underlying observation distribution.}
-  \item{scaleX.inv}{the inverse function to \code{scale.fct}, i.e., an isotone,
-            vectorized function mapping [0,1] to the domain of the IC(s)
-            such that for any \code{x} in the domain,
-            \code{scaleX.inv(scaleX.fct(x))==x}; if \code{scaleX} is \code{TRUE}
-            and \code{scaleX.inv} is
-            missing, the quantile function of the underlying observation distribution.}
-  \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the
-            range of the respective coordinate of the IC(s)
-            to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.}
-  \item{scaleY.inv}{an isotone, vectorized function mapping for each coordinate
-            the range [0,1] into the range of the respective coordinate of the IC(s);
-            defaulting to the quantile function of  \eqn{{\cal N}(0,1)}{N(0,1)}.}
-  \item{cex.pts}{size of the points of the second argument plotted}
-  \item{col.pts}{color of the points of the second argument plotted}
-  \item{pch.pts}{symbol of the points of the second argument plotted}
-  \item{with.lab}{logical; shall labels be plotted to the observations?}
-  \item{lab.pts}{character or NULL; labels to be plotted to the observations; if \code{NULL}
-                 observation indices;}
-  \item{lab.font}{font to be used for labels}
-  \item{jitter.fac}{jittering factor used in case of a \code{DiscreteDistribution}
-                    for plotting points of the second argument in a jittered fashion.}
-  \item{which.lbs}{either an integer vector with the indices of the observations
-          to be plotted into graph or \code{NULL} --- then no observation is excluded}
-  \item{which.Order}{we order the observations (descending) according to the norm given by
-           \code{normtype(object)}; then \code{which.Order}
-           either is an integer vector with the indices of the \emph{ordered}
-           observations (remaining after a possible reduction by argument \code{which.lbs})
-           to be plotted into graph or \code{NULL} --- then no (further) observation
-           is excluded.}
-  \item{return.Order}{logical; if \code{TRUE}, an order vector
-    is returned; more specifically, the order of the (remaining) observations
-    given by their original index is returned (remaining means: after a possible
-    reduction by argument \code{which.lbs}, and ordering is according to the norm given by
-           \code{normtype(object)});
-   otherwise we return \code{invisible()} as usual.}
+%  \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of
+%          the underlying distribution)?}
+%  \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?}
+%  \item{scaleX.fct}{an isotone, vectorized function mapping the domain of the IC(s)
+%            to [0,1]; if \code{scaleX} is \code{TRUE} and \code{scaleX.fct} is
+%            missing, the cdf of the underlying observation distribution.}
+%  \item{scaleX.inv}{the inverse function to \code{scale.fct}, i.e., an isotone,
+%            vectorized function mapping [0,1] to the domain of the IC(s)
+%            such that for any \code{x} in the domain,
+%            \code{scaleX.inv(scaleX.fct(x))==x}; if \code{scaleX} is \code{TRUE}
+%            and \code{scaleX.inv} is
+%            missing, the quantile function of the underlying observation distribution.}
+%  \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the
+%            range of the respective coordinate of the IC(s)
+%            to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.}
+% \item{scaleY.inv}{an isotone, vectorized function mapping for each coordinate
+%            the range [0,1] into the range of the respective coordinate of the IC(s);
+%            defaulting to the quantile function of  \eqn{{\cal N}(0,1)}{N(0,1)}.}
+%  \item{cex.pts}{size of the points of the second argument plotted}
+%  \item{col.pts}{color of the points of the second argument plotted}
+%  \item{pch.pts}{symbol of the points of the second argument plotted}
+%  \item{with.lab}{logical; shall labels be plotted to the observations?}
+%  \item{lab.pts}{character or NULL; labels to be plotted to the observations; if \code{NULL}
+%                 observation indices;}
+%  \item{lab.font}{font to be used for labels}
+%  \item{jitter.fac}{jittering factor used in case of a \code{DiscreteDistribution}
+%                    for plotting points of the second argument in a jittered fashion.}
+%  \item{which.lbs}{either an integer vector with the indices of the observations
+%          to be plotted into graph or \code{NULL} --- then no observation is excluded}
+%  \item{which.Order}{we order the observations (descending) according to the norm given by
+%           \code{normtype(object)}; then \code{which.Order}
+%           either is an integer vector with the indices of the \emph{ordered}
+%           observations (remaining after a possible reduction by argument \code{which.lbs})
+%           to be plotted into graph or \code{NULL} --- then no (further) observation
+%           is excluded.}
+%  \item{return.Order}{logical; if \code{TRUE}, an order vector
+%    is returned; more specifically, the order of the (remaining) observations
+%    given by their original index is returned (remaining means: after a possible
+%    reduction by argument \code{which.lbs}, and ordering is according to the norm given by
+%           \code{normtype(object)});
+%   otherwise we return \code{invisible()} as usual.}
 }
 \details{
   In case of \code{cniperCont} the difference between the risks of two ICs 

Modified: branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/RobAStBase/R/AllPlot.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -231,8 +231,8 @@
             indi <- to.draw[i]
             if(!is.null(ylim)) dots$ylim <- ylim[,i]       
             resc <-.rescalefct(x.vec, IC1 at Map[[indi]], scaleX, scaleX.fct,
-                              scaleX.inv, scaleY, scaleY.fct, scaleY.inv,
-                              xlim[,i], ylim[,i], dots)
+                              scaleX.inv, scaleY, scaleY.fct, xlim[,i],
+                              ylim[,i], dots)
             dots <- resc$dots
             x.vec1 <- resc$X
             y.vec1 <- resc$Y
@@ -345,8 +345,7 @@
         ICy <- sapply(y0s,ICMap0[[indi]])
         resc.dat <-.rescalefct(y0s, function(x) sapply(x,ICMap0[[indi]]),
                               scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dwo0$xlim, dwo0$ylim, dwo0)
+                              scaleY, scaleY.fct, dwo0$xlim, dwo0$ylim, dwo0)
         y1 <- resc.dat$X
         ICy <- resc.dat$Y
 

Modified: branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -296,12 +296,10 @@
 
                resc.dat <-.rescalefct(x.d, function(x) absInfoEval(x,absInfo.f),
                               scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dots)
+                              scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
                resc.datC <-.rescalefct(x.d, function(x) absInfoEval(x,absInfoClass.f),
                               scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dots)
+                              scaleY, scaleY.fct, dots$xlim, dots$ylim, dots)
 
                x.d <- resc.dat$X
                x.dC <- resc.datC$X
@@ -377,12 +375,10 @@
             if(1 %in% to.draw){
                resc <-.rescalefct(x.vec, function(x) absInfoEval(x,absInfo.f),
                               scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dotsP)
+                              scaleY, scaleY.fct, dots$xlim, dots$ylim, dotsP)
                resc.C <-.rescalefct(x.vec, function(x) absInfoEval(x,absInfoClass.f),
                               scaleX, scaleX.fct, scaleX.inv,
-                              scaleY, scaleY.fct, scaleY.inv,
-                              dots$xlim, dots$ylim, dotsP)
+                              scaleY, scaleY.fct, dots$xlim, dots$ylim, dotsP)
                dotsP1 <- dotsP <- resc$dots
                dotsP$yaxt <- dots$yaxt
                x.vec0 <- resc$x

Modified: branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/RobAStBase/R/plotRescaledAxis.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -1,6 +1,18 @@
-.rescalefct <- function(x, fct, scaleX = FALSE, scaleX.fct, scaleX.inv,
-         scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
+## helper functions for rescaling x and y axis in various diagnostic plots
+
+.rescalefct <- function(x, fct,
+         scaleX = FALSE, scaleX.fct, scaleX.inv,
+         scaleY = FALSE, scaleY.fct = pnorm,
          xlim, ylim, dots){
+
+# if scaleX rescales x, if scaleY rescales fct(x);
+# to this end uses trafos scaleX.fct with inverse scale.inv
+# resp. scaleY.fct; it respects xlim and  ylim (given in orig. scale)
+# thins out the scaled values if necessary and accordingly modifies
+# slots xaxt, yaxt, axes of dots to indicate the new axes have to be drawn
+#    paradigm small letters = orig. scale, capital letters = transformed scale
+# return value: list with (thinned out) x and y, X and Y and modified dots
+
          X <- x
          if(scaleX){
             if(!is.null(xlim)){
@@ -26,6 +38,10 @@
 .plotRescaledAxis <- function(scaleX,scaleX.fct, scaleX.inv,
                               scaleY,scaleY.fct, scaleY.inv,
                               xlim, ylim, X, ypts = 400){
+# 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)
+# return value: none
         if(scaleX){
                x <- pretty(scaleX.inv(X))
                if(!is.null(xlim)) x <- pmax(x, scaleY.fct(xlim[1]))
@@ -67,6 +83,8 @@
 }
 
 .legendCoord <- function(x, scX, scX.fct, scY, scY.fct){
+# rescaled legend coordinates axes acc. to logicals scaleX, scaleY
+# return value: transformed legend coordinates
                 if (is.character(x)) return(x)
                 x1 <- if(scX) scX.fct(x[1]) else x[1]
                 x2 <- if(scY) scY.fct(x[2]) else x[2]

Modified: branches/robast-0.9/pkg/RobAStBase/R/selectorder.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/selectorder.R	2013-01-11 01:30:50 UTC (rev 528)
+++ branches/robast-0.9/pkg/RobAStBase/R/selectorder.R	2013-01-11 12:38:28 UTC (rev 529)
@@ -1,5 +1,12 @@
 .SelectOrderData <- function(data, fct, which.lbs, which.Order){
-
+   ## for data to be plot in performs two selections:
+   ## on unordered (original) data (acc. to which.lbs)
+   ## on data ordered acc. to fct a selection acc. to which.Order is done
+   ## return value: list with elements
+   #      data, the selected/thinned out data,
+   #      y = fct(data)
+   #      ind the indices of the selected data in the original data
+   #      ind1 the indices of the data selected by which.lbs in the original data
      n <- if(is.null(dim(data))) nrow(data) else length(data)
      
      ind <- 1:n



More information about the Robast-commits mailing list