[Robast-commits] r1014 - in branches/robast-1.1/pkg/RobAStBase: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jul 22 13:07:14 CEST 2018


Author: ruckdeschel
Date: 2018-07-22 13:07:13 +0200 (Sun, 22 Jul 2018)
New Revision: 1014

Added:
   branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R
   branches/robast-1.1/pkg/RobAStBase/man/returnlevelplot.Rd
Modified:
   branches/robast-1.1/pkg/RobAStBase/NAMESPACE
   branches/robast-1.1/pkg/RobAStBase/R/IC.R
   branches/robast-1.1/pkg/RobAStBase/R/qqplot.R
Log:
[RobAStBase] branch 1.1 new methods for returnlevelplot for RobModel, InfRobModel, kStepEstimate (as qqplot) 
             unified return values for qqplot
             bug: slot modifyIC was set to a wrong value in makeIC / former (potential) move was overridden 


Modified: branches/robast-1.1/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/NAMESPACE	2018-07-20 18:50:51 UTC (rev 1013)
+++ branches/robast-1.1/pkg/RobAStBase/NAMESPACE	2018-07-22 11:07:13 UTC (rev 1014)
@@ -69,7 +69,7 @@
 exportMethods("moveL2Fam2RefParam",
 			  "moveICBackFromRefParam",
 			  "rescaleFunction")			  
-exportMethods("ddPlot", "qqplot")
+exportMethods("ddPlot", "qqplot", "returnlevelplot")
 exportMethods("cutoff.quantile", "cutoff.quantile<-")
 exportMethods("samplesize<-", "samplesize")
 exportMethods("getRiskFctBV", "getFiRisk")

Modified: branches/robast-1.1/pkg/RobAStBase/R/IC.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/IC.R	2018-07-20 18:50:51 UTC (rev 1013)
+++ branches/robast-1.1/pkg/RobAStBase/R/IC.R	2018-07-22 11:07:13 UTC (rev 1014)
@@ -124,6 +124,11 @@
 ## make some L2function a pIC at a model
 setMethod("makeIC", signature(IC = "IC", L2Fam = "L2ParamFamily"), 
     function(IC, L2Fam){ 
+
+        dims <- length(L2Fam at param)
+        if(dimension(IC at Curve) != dims)
+           stop("Dimension of IC and parameter must be equal")
+
         D1 <- L2Fam at distribution
         if(dimension(Domain(IC at Curve[[1]])) != dimension(img(D1)))
             stop("dimension of 'Domain' of 'Curve' != dimension of 'img' of 'distribution' of 'L2Fam'")
@@ -133,19 +138,32 @@
         cent <- E(D1, IC1)
         IC1 <- IC1 - cent
 
-        dims <- length(L2Fam at param)
-        if(dimension(IC at Curve) != dims)
-           stop("Dimension of IC and parameter must be equal")
-
         L2deriv <- as(diag(dims) %*% L2Fam at L2deriv, "EuclRandVariable")
 
-        E1 <- matrix(E(L2Fam, IC1 %*% t(L2deriv)), dims, dims)
+        E10 <- E(L2Fam, IC1 %*% t(L2deriv))
+        E1 <- matrix(E10, dims, dims)
         stand <- trafo %*% solve(E1) 
         Y <- as(stand %*% IC1, "EuclRandVariable")
         #ICfct <- vector(mode = "list", length = dims)
         #ICfct[[1]] <- function(x){Y(x)}
+        ..modifnew <- function(L2Fam, IC) return(makeIC(IC,L2Fam))
 
-        modifyIC <- function(L2Fam, IC){ makeIC(IC, L2Fam) }
+        if(! ("modifyIC" %in% names(getSlots(class(IC))))){
+           modifyIC <- ..modifnew
+        }else{
+           if(!is.function(IC at modifyIC)){
+              modifyIC <- ..modifnew
+           }else{
+              .modifyIC <- IC at modifyIC
+              if(!is.null(attr(IC at modifyIC,"hasMakeICin.modifyIC"))){
+                  modifyIC <- .modifyIC
+              }else{
+                  modifyIC <- function(L2Fam, IC){ IC. <- .modifyIC(L2Fam, IC)
+                                         return(makeIC(IC., L2Fam)) }
+              }
+           }
+        }
+        attr(modifyIC,"hasMakeICin.modifyIC") <- TRUE
 
         CallL2Fam <- L2Fam at fam.call
 

Modified: branches/robast-1.1/pkg/RobAStBase/R/qqplot.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/qqplot.R	2018-07-20 18:50:51 UTC (rev 1013)
+++ branches/robast-1.1/pkg/RobAStBase/R/qqplot.R	2018-07-22 11:07:13 UTC (rev 1014)
@@ -23,6 +23,17 @@
     n.adj = TRUE){
 
     mc <- match.call(call = sys.call(sys.parent(1)))
+    dots <- match.call(call = sys.call(sys.parent(1)),
+                       expand.dots = FALSE)$"..."
+    args0 <- list(x = x, y = y,
+                  n = if(!missing(n)) n else length(x),
+                  withIdLine = withIdLine, withConf = withConf,
+    withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+    withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+                  plot.it = plot.it, xlab = xlab, ylab = ylab, distance=distance, n.adj=n.adj)
+
+    plotInfo <- list(call=mc, dots=dots, args=args0)
+
     xcc <- as.character(deparse(mc$x))
     if(missing(xlab)) mc$xlab <- xcc
     if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
@@ -49,8 +60,12 @@
     x.cex <- 3/(1+log(1+xD))
     mcl$cex.pch <- x.cex
 
-    return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
-            args=mcl)))
+    retv <- do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("qqplotInfo","DiagnInfo")
+    return(invisible(plotInfo))
     })
 
 
@@ -62,6 +77,17 @@
                ylab = deparse(substitute(y)), ..., cex.pts.fun = NULL, n.adj = TRUE){
 
     mc <- match.call(call = sys.call(sys.parent(1)))
+    dots <- match.call(call = sys.call(sys.parent(1)),
+                       expand.dots = FALSE)$"..."
+    args0 <- list(x = x, y = y,
+                  n = if(!missing(n)) n else length(x),
+                  withIdLine = withIdLine, withConf = withConf,
+    withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+    withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+                  plot.it = plot.it, xlab = xlab, ylab = ylab, cex.pts.fun=cex.pts.fun,
+                  n.adj = n.adj)
+
+    plotInfo <- list(call=mc, dots=dots, args=args0)
     if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
     if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
     mcl <- as.list(mc)[-1]
@@ -102,8 +128,12 @@
 
     mcl$cex.pch <- x.cex
 
-    return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
-            args=mcl)))
+    retv <- do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("qqplotInfo","DiagnInfo")
+    return(invisible(plotInfo))
     })
 
 ## into RobAStBase
@@ -120,7 +150,18 @@
     bg = "white"
     ){
 
+    args0 <- list(x=x,y=y,n=n,withIdLine=withIdLine, withConf=withConf,
+        withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+        withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+        plot.it = plot.it, xlab = xlab, ylab = ylab, exp.cex2.lbl=exp.cex2.lbl,
+        exp.cex2.pch=exp.cex2.pch, exp.fadcol.lbl=exp.fadcol.lbl,
+        exp.fadcol.pch=exp.fadcol.pch, bg=bg)
+
     mc <- match.call(call = sys.call(sys.parent(1)))
+    mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+    dots <- mc1$"..."
+    plotInfo <- list(call=mc, dots=dots, args=args0)
+
     if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
     if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
     mcl <- as.list(mc)[-1]
@@ -157,6 +198,10 @@
       mcl$col.pch <- .fadeColor(col.pch,wx^exp.fadcol.pch, bg = bg)
     }
 
-    return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
-            args=mcl)))
+    retv <- do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("qqplotInfo","DiagnInfo")
+    return(invisible(plotInfo))
     })

Added: branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R	                        (rev 0)
+++ branches/robast-1.1/pkg/RobAStBase/R/returnlevelplot.R	2018-07-22 11:07:13 UTC (rev 1014)
@@ -0,0 +1,192 @@
+################################################################
+# Returnlevel - Plot functions in package RobAStBase
+################################################################
+
+
+## into RobAStBase
+setMethod("returnlevelplot", signature(x = "ANY",
+                              y = "RobModel"), function(x, y,
+                              n = length(x), withIdLine = TRUE, withConf = TRUE,
+    withConf.pw  = withConf,  withConf.sim = withConf,
+    plot.it = TRUE, xlab = deparse(substitute(x)),
+    ylab = deparse(substitute(y)), ..., distance = NormType(),
+    n.adj = TRUE){
+
+    args0 <- list(x=x,y=y,n=n,withIdLine=withIdLine, withConf=withConf,
+        withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+        withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+        plot.it = plot.it, xlab = xlab, ylab = ylab, distance = distance, n.adj = n.adj)
+
+    mc <- match.call(call = sys.call(sys.parent(1)))
+    mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+    dots <- mc1$"..."
+    plotInfo <- list(call=mc, dots=dots, args=args0)
+
+    xcc <- as.character(deparse(mc$x))
+    if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
+    if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+    mcl <- as.list(mc)[-1]
+
+    if(is.null(mcl$n.CI)) mcl$n.CI <- n
+    if(n.adj){
+       r <- radius(neighbor(y))
+       n <- floor((1-r)*n)
+    }
+    if(is.null(mcl$alpha.CI))
+       mcl$alpha.CI <- .95
+    cor <- radius(neighbor(y))
+    mcl$legend.alpha <- eval(mcl$alpha.CI)
+    mcl$alpha.CI <- min(eval(mcl$alpha.CI)+cor,1)
+
+
+    mcl$n <- n
+    mcl$y <- y at center
+    mcl$legend.pref <- paste(mcl$legend.pref,"outlier-adjusted",sep="")
+
+
+    xD <- fct(distance)(x)
+    x.cex <- 3/(1+log(1+xD))
+    mcl$cex.pch <- x.cex
+
+    retv <- do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("plotInfo","DiagnInfo")
+    return(invisible(plotInfo))
+    })
+
+
+## into RobAStBase
+setMethod("returnlevelplot", signature(x = "ANY", y = "InfRobModel"),
+      function(x, y, n = length(x), withIdLine = TRUE, withConf = TRUE,
+               withConf.pw  = withConf,  withConf.sim = withConf,
+               plot.it = TRUE, xlab = deparse(substitute(x)),
+               ylab = deparse(substitute(y)), ..., cex.pts.fun = NULL, n.adj = TRUE){
+
+    args0 <- list(x=x,y=y,n=n,withIdLine=withIdLine, withConf=withConf,
+        withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+        withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+        plot.it = plot.it, xlab = xlab, ylab = ylab, cex.pts.fun=cex.pts.fun, n.adj = n.adj)
+
+    mc <- match.call(call = sys.call(sys.parent(1)))
+    mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+    dots <- mc1$"..."
+    plotInfo <- list(call=mc, dots=dots, args=args0)
+
+    if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
+    if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+    mcl <- as.list(mc)[-1]
+    if(is.null(mcl$distance)) distance <- NormType()
+
+    if(is.null(mcl$alpha.CI))
+       mcl$alpha.CI <- .95
+    cor <- radius(neighbor(y))/sqrt(n)
+    mcl$legend.alpha <- eval(mcl$alpha.CI)
+    mcl$alpha.CI <- min(eval(mcl$alpha.CI)+cor,1)
+
+
+
+    if(is.null(mcl$n.CI)) mcl$n.CI <- n
+    if(n.adj){
+       r <- radius(neighbor(y))
+       n <- floor((1-r/sqrt(n))*n)
+    }
+    mcl$n <- n
+    mcl$y <- y at center
+    mcl$legend.pref <- paste(mcl$legend.pref,"outlier-adjusted",sep="")
+    
+    FI <- PosSemDefSymmMatrix(FisherInfo(y at center))
+    L2D <- as(diag(nrow(FI)) %*% L2deriv(y at center), "EuclRandVariable")
+    L2Dx <- evalRandVar(L2D,matrix(x))[,,1]
+    scx <-  solve(sqrt(FI),L2Dx)
+    xD <- fct(distance)(scx)
+    cex.pts <- if(is.null(mcl[["cex.pts"]])){
+                  if(is.null(mcl[["cex"]])){
+                     par("cex")
+                  }else{
+                     eval(mcl$cex)}
+               }else{
+                  eval(mcl$cex.pts)
+               }
+
+    x.cex <- 3/(1+.cexscale(xD,xD,cex=cex.pts, fun = cex.pts.fun))
+
+    mcl$cex.pch <- x.cex
+
+    retv <- do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("plotInfo","DiagnInfo")
+    return(invisible(plotInfo))
+    })
+
+## into RobAStBase
+setMethod("returnlevelplot", signature(x = "ANY",
+                              y = "kStepEstimate"), function(x, y,
+                              n = length(x), withIdLine = TRUE, withConf = TRUE,
+    withConf.pw  = withConf,  withConf.sim = withConf,
+    plot.it = TRUE, xlab = deparse(substitute(x)),
+    ylab = deparse(substitute(y)), ...,
+    exp.cex2.lbl = -.15,
+    exp.cex2.pch = -.35,
+    exp.fadcol.lbl = 1.85,
+    exp.fadcol.pch = 1.85,
+    bg = "white"
+    ){
+    args0 <- list(x=x,y=y,n=n,withIdLine=withIdLine, withConf=withConf,
+        withConf.pw  = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
+        withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
+        plot.it = plot.it, xlab = xlab, ylab = ylab, exp.cex2.lbl=exp.cex2.lbl,
+        exp.cex2.pch=exp.cex2.pch, exp.fadcol.lbl=exp.fadcol.lbl,
+        exp.fadcol.pch=exp.fadcol.pch, bg=bg)
+
+    mc <- match.call(call = sys.call(sys.parent(1)))
+    mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+    dots <- mc1$"..."
+    plotInfo <- list(call=mc, dots=dots, args=args0)
+
+    if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
+    if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+    mcl <- as.list(mc)[-1]
+
+    IC <- pIC(y)
+    if(!is(IC,"IC"))
+       stop("IC of the kStepEstimator needs to be of class 'IC'")
+
+    L2Fam <- eval(IC at CallL2Fam)
+    param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y),
+                               fixed=fixed(y))
+    L2Fam0 <- modifyModel(L2Fam,param)
+    mcl$y <- L2Fam0
+
+    if(is(IC,"HampIC")){
+      dim0 <- nrow(FisherInfo(L2Fam))
+      L <- as(diag(dim0)%*%L2Fam at L2deriv, "EuclRandVariable")
+      L.fct <- function(x) evalRandVar(L,x)
+
+      w.fct <- function(x)
+               weight(weight(IC))(L.fct(matrix(x))[,,1])
+
+      wx <- w.fct(x)
+      mcl$order.traf <- function(x) 1/w.fct(x)
+
+      cex.lbl <- if(is.null(mcl$cex.lbl))  par("cex")  else eval(mcl$cex.lbl)
+      cex.pch <- if(is.null(mcl$cex.pch))  par("cex")  else eval(mcl$cex.pch)
+      mcl$cex.lbl <- cex.lbl*wx^exp.cex2.lbl
+      mcl$cex.pch <- cex.pch*wx^exp.cex2.pch
+
+      col.lbl <- if(is.null(mcl$col.lbl))  par("col")  else eval(mcl$col.lbl)
+      col.pch <- if(is.null(mcl$col.pch))  par("col")  else eval(mcl$col.pch)
+      mcl$col.lbl <- .fadeColor(col.lbl,wx^exp.fadcol.lbl, bg = bg)
+      mcl$col.pch <- .fadeColor(col.pch,wx^exp.fadcol.pch, bg = bg)
+    }
+
+    retv <- do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)
+    retv$call <- retv$dots <- retv$args <- NULL
+    plotInfo <- c(plotInfo,retv)
+    class(plotInfo) <- c("plotInfo","DiagnInfo")
+    return(invisible(plotInfo))
+    })

Added: branches/robast-1.1/pkg/RobAStBase/man/returnlevelplot.Rd
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/man/returnlevelplot.Rd	                        (rev 0)
+++ branches/robast-1.1/pkg/RobAStBase/man/returnlevelplot.Rd	2018-07-22 11:07:13 UTC (rev 1014)
@@ -0,0 +1,149 @@
+\name{returnlevelplot}
+\docType{methods}
+\title{Methods for Function returnlevelplot in Package `RobAStBase'}
+\usage{
+returnlevelplot(x, y, ...)
+\S4method{returnlevelplot}{ANY,RobModel}(x, y,
+   n = length(x), withIdLine = TRUE, withConf = TRUE,
+   withConf.pw  = withConf,  withConf.sim = withConf,
+    plot.it = TRUE, xlab = deparse(substitute(x)),
+    ylab = deparse(substitute(y)), ..., distance = NormType(),
+    n.adj = TRUE)
+\S4method{returnlevelplot}{ANY,InfRobModel}(x, y, n = length(x), withIdLine = TRUE,
+withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf,
+  plot.it = TRUE, xlab = deparse(substitute(x)), ylab =
+  deparse(substitute(y)), ..., cex.pts.fun = NULL, n.adj = TRUE)
+\S4method{returnlevelplot}{ANY,kStepEstimate}(x, y,
+   n = length(x), withIdLine = TRUE, withConf = TRUE,
+   withConf.pw  = withConf,  withConf.sim = withConf,
+    plot.it = TRUE, xlab = deparse(substitute(x)),
+    ylab = deparse(substitute(y)), ...,
+    exp.cex2.lbl = -.15,
+    exp.cex2.pch = -.35,
+    exp.fadcol.lbl = 1.85,
+    exp.fadcol.pch = 1.85,
+    bg = "white")
+   }
+\alias{returnlevelplot}
+\alias{returnlevelplot-methods}
+\alias{returnlevelplot,ANY,RobModel-method}
+\alias{returnlevelplot,ANY,InfRobModel-method}
+\alias{returnlevelplot,ANY,kStepEstimate-method}
+
+\arguments{
+\item{x}{data to be checked for compatibility with distribution/model \code{y}.}
+\item{y}{object of class \code{"RobModel"}, of class \code{"InfRobModel"} or of
+class \code{"kStepEstimate"}.}
+\item{n}{numeric; number of quantiles at which to do the comparison.}
+\item{withIdLine}{logical; shall line \code{y = x} be plotted in?}
+\item{withConf}{logical; shall confidence lines be plotted?}
+\item{withConf.pw}{logical; shall pointwise confidence lines be plotted?}
+\item{withConf.sim}{logical; shall simultaneous confidence lines be plotted?}
+\item{plot.it}{logical; shall be plotted at all (inherited from
+\code{\link[distrMod:returnlevelplot]{returnlevelplot}})?}
+\item{xlab}{x-label}
+\item{ylab}{y-label}
+\item{\dots}{further parameters for method \code{returnlevelplot} with signature
+\code{ANY,ProbFamily} (see \code{\link[distrMod]{returnlevelplot}}) or with function
+ \code{plot}}
+\item{cex.pts.fun}{rescaling function for the size of the points to be plotted;
+        either \code{NULL} (default), then \code{log(1+abs(x))} is used,
+        or a function which is then used. }
+\item{n.adj}{logical; shall sample size be adjusted for possible outliers according
+to radius of the corresponding neighborhood?}
+\item{distance}{a function mapping observations \code{x} to the positive reals;
+used to determine the size of the plotted points (the larger \code{distance(x)},
+the smaller the points are plotted.}
+\item{exp.cex2.lbl}{for objects \code{kStepEstimate} based on a [p]IC of class \code{HampIC}:
+exponent for the weights of this [p]IC used to magnify the labels.}
+\item{exp.cex2.pch}{for objects \code{kStepEstimate} based on a [p]IC of class \code{HampIC}:
+exponent for the weights of this [p]IC used to magnify the symbols.}
+\item{exp.fadcol.lbl}{for objects \code{kStepEstimate} based on a [p]IC of class \code{HampIC}:
+exponent for the weights of this [p]IC used to find out-fading colors.}
+\item{exp.fadcol.pch}{for objects \code{kStepEstimate} based on a [p]IC of class \code{HampIC}:
+exponent for the weights of this [p]IC used to find out-fading colors.}
+\item{bg}{background color to fade against}
+}
+\description{
+  We generalize function \code{\link[distrMod]{returnlevelplot}} from package \pkg{distrMod} to
+  be applicable to distribution and probability model objects. In this context,
+  \code{returnlevelplot} produces a rescaled QQ plot of data (argument \code{x})
+  against a (model) distribution. For arguments \code{y} of class \code{RobModel},
+   points at a high \dQuote{distance} to the model
+   are plotted smaller. For arguments \code{y} of class \code{kStepEstimate},
+   points at with low weight in the [p]IC are plotted bigger and their
+   color gets faded out slowly. This parallels the behaviour of the respective
+   \code{qqplot} methods.
+   Graphical parameters may be given as arguments to \code{returnlevelplot}.
+}
+\value{
+    As for function \code{\link[distrMod:returnlevelplot]{returnlevelplot}} from package \pkg{stats}.
+}
+\note{
+The confidence bands given in our version of the return level plot differ
+ from the ones given in package \pkg{ismev}. We use non-parametric bands,
+ hence also allow for non-parametric deviances from the model, whereas in
+ in package \pkg{ismev} they are based on profiling, hence only check for
+ variability within the parametric class.
+}
+\references{
+  ismev: An   Introduction to Statistical Modeling of Extreme Values. R package
+  version 1.39. https://CRAN.R-project.org/package=ismev; original S functions
+  written by Janet E. Heffernan with R port and R documentation provided by
+  Alec G. Stephenson. (2012).
+
+  Coles, S. (2001). \emph{An introduction
+  to statistical modeling of extreme values.} London: Springer.
+}
+\author{
+  Peter Ruckdeschel \email{peter.ruckdeschel at uni-oldenburg.de}
+}
+\seealso{
+  \code{\link[stats:qqnorm]{qqplot}} from package \pkg{stats} -- the standard QQ plot
+  function,  \code{\link[distrMod]{returnlevelplot}} from package \pkg{distrMod} (which
+  is called intermediately by this method), as well as
+  \code{\link{qqbounds}}, used by \code{returnlevelplot} to produce confidence
+   intervals.
+}
+\details{
+\describe{
+\item{returnlevelplot}{\code{signature(x = "ANY", y = "RobModel")}:
+produces a QQ plot of a dataset \code{x} against the theoretical
+quantiles of distribution of robust model \code{y}.}
+\item{returnlevelplot}{\code{signature(x = "ANY", y = "InfRobModel")}:
+produces a QQ plot of a dataset \code{x} against the theoretical
+quantiles of distribution of infinitesimally robust model \code{y}.}
+\item{returnlevelplot}{\code{signature(x = "ANY", y = "kStepEstimate")}:
+produces a QQ plot of a dataset \code{x} against the theoretical
+quantiles of the model distribution of model at which
+the corresponding \code{kStepEstimate} \code{y} had been calibrated at.
+By default, if the [p]IC of the \code{kStepEstimate} is of class
+\code{HampIC}, i.e.; has a corresponding weight function,
+points (and, if \code{withLab==TRUE}, labels) are
+scaled and faded according to this weight function. Corresponding
+arguments \code{exp.cex2.pch} and \code{exp.fadcol.pch} control this
+scaling and fading, respectively
+(and analogously \code{exp.cex2.lbl} and \code{exp.fadcol.lbl} for the labels).
+The choice of these arguments has to be done on a case-by-case basis.
+Positive exponents induce fading, magnification with increasing weight,
+for negative exponents the same is true for decreasing weight; higher
+(absolute) values increase the speed of fading / magnification.
+}
+}
+}
+
+\examples{
+returnlevelplot(rnorm(40, mean = 15, sd = sqrt(30)), Chisq(df=15))
+RobM <- InfRobModel(center = NormLocationFamily(mean=13,sd=sqrt(28)),
+                    neighbor = ContNeighborhood(radius = 0.4))
+\donttest{
+## \donttest to reduce check time
+x <- rnorm(20, mean = 15, sd = sqrt(30))
+returnlevelplot(x, RobM)
+returnlevelplot(x, RobM, alpha.CI=0.9, add.points.CI=FALSE)
+}
+## further examples for ANY,kStepEstimator-method
+## in example to roptest() in package ROptEst
+}
+\keyword{hplot}
+\keyword{distribution}



More information about the Robast-commits mailing list