[Robast-commits] r783 - in branches/robast-1.0/pkg/RobAStBase: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 11 00:21:47 CEST 2014
Author: ruckdeschel
Date: 2014-08-11 00:21:47 +0200 (Mon, 11 Aug 2014)
New Revision: 783
Modified:
branches/robast-1.0/pkg/RobAStBase/NAMESPACE
branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R
branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R
branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R
branches/robast-1.0/pkg/RobAStBase/inst/NEWS
branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd
Log:
+ new helper function cutoff.quant() to produce cutoff from model quantiles
Modified: branches/robast-1.0/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/NAMESPACE 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/NAMESPACE 2014-08-10 22:21:47 UTC (rev 783)
@@ -72,7 +72,7 @@
export("InfluenceCurve", "IC", "ContIC", "TotalVarIC")
export(".eq", ".getDistr", "getBoundedIC")
export("RobAStBaseOptions", "getRobAStBaseOption")
-export("cutoff","cutoff.chisq","cutoff.sememp")
+export("cutoff","cutoff.chisq","cutoff.sememp", "cutoff.quant")
export("outlyingPlotIC", "RobAStBaseMASK")
export("OMSRRisk","MBRRisk","RMXRRisk")
export("getRiskFctBV")
Modified: branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-08-10 22:21:47 UTC (rev 783)
@@ -50,3 +50,25 @@
qchisq(df = dim, cutoff.quantile)^.5
}),
cutoff.quantile = 0.95)}
+
+cutoff.quant <- function(qfct){
+ if(missing(qfct)) qfct <- NULL
+ cutoff(name = "quantile",
+ body.fct0 = substitute({
+ if(is.null(qfctA)){
+ if(exists("..ICloc")){
+ L2m <- eval(CallL2Fam(get("..ICloc")))
+ qfct0 <- q(L2m)
+ }else{
+ qfct0 <- qnorm
+ }
+ }else{
+ qfct0 <- qfctA
+ }
+ q0 <- qfct0(cutoff.quantile)
+ if(exists("..trf")){
+ q0 <- get("..trf")(q0)
+ }
+ return(q0)
+ }, list(qfctA=qfct)),
+ cutoff.quantile = 0.95)}
Modified: branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-10 22:21:47 UTC (rev 783)
@@ -86,13 +86,17 @@
if(is.null(cutoff.x))
cutoff.x <- cutoff(norm = dist.x, cutoff.quantile = cutoff.quantile.x)
- else {assign("norm", dist.x, environment(fct(cutoff.x)))
- assign("cutoff.quantile", cutoff.quantile.x, environment(fct(cutoff.x)))}
+ else {assign("norm", dist.x, envir=environment(fct(cutoff.x)))
+ assign("cutoff.quantile", cutoff.quantile.x, envir=environment(fct(cutoff.x)))
+ assign("..trf", if(missing(transform.x)||is.null(transform.x)) function(x)x else transform.x,
+ envir=environment(fct(cutoff.x)))}
if(is.null(cutoff.y))
cutoff.y <- cutoff(norm = dist.y, cutoff.quantile = cutoff.quantile.y)
- else {assign("norm", dist.y, environment(fct(cutoff.y)))
- assign("cutoff.quantile", cutoff.quantile.y, environment(fct(cutoff.y)))}
+ else {assign("norm", dist.y, envir=environment(fct(cutoff.y)))
+ assign("cutoff.quantile", cutoff.quantile.y, envir=environment(fct(cutoff.y)))
+ assign("..trf", if(missing(transform.y)||is.null(transform.y)) function(x)x else transform.y,
+ envir=environment(fct(cutoff.y)))}
if(!is(dist.x, "NormType")) stop("Argument 'dist.x' of 'ddPlot' must be of class 'NormType'")
if(!is(dist.y, "NormType")) stop("Argument 'dist.y' of 'ddPlot' must be of class 'NormType'")
Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-10 22:21:47 UTC (rev 783)
@@ -124,11 +124,13 @@
tf.y <- function(x) apply(x,2,function(xx) evalIC(IC.y,xx))
}else{tf.y <- mc$tf.y}
- do.call(ddPlot,args=c(list(data=data),dots,
+ if(!missing(cutoff.x)) assign("..ICloc", IC.x, envir=environment(fct(cutoff.x)))
+ if(!missing(cutoff.y)) assign("..ICloc", IC.y, envir=environment(fct(cutoff.y)))
+ do.call(ddPlot,args=c(list(data=data),dots,
list(dist.x = mc$dist.x,
dist.y = mc$dist.y,
- cutoff.x = mc$cutoff.x,
- cutoff.y = mc$cutoff.y,
+ cutoff.x = cutoff.x,
+ cutoff.y = cutoff.y,
cutoff.quantile.x = mc$cutoff.quantile.x,
cutoff.quantile.y = mc$cutoff.quantile.y,
transform.x = tf.x,
Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 22:21:47 UTC (rev 783)
@@ -30,6 +30,8 @@
unevenly (i.e. on an equally spaced grid in the original scale, but then, after
rescaling non-equally... The grid has to be specified in original scale; i.e.;
when used with rescaling, should be chosen non-equally spaced...
++ wrapper functions ICPlot, InfoPlot, and ComparePlot use refined grids, i.e.,
+ the grids are plotted on user given coordinates (or rescaled coordinates)
+ comparePlot, infoPlot, and the plot-Method for ICs now if scaleX is TRUE by
default use an equidistant grid on the rescaled x-Axis.
+ qqplot-method for c("ANY","InfRobModel") gains argument
Modified: branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-08-10 21:43:33 UTC (rev 782)
+++ branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-08-10 22:21:47 UTC (rev 783)
@@ -2,6 +2,7 @@
\alias{cutoff}
\alias{cutoff.sememp}
\alias{cutoff.chisq}
+\alias{cutoff.quant}
\title{Generating function(s) for class 'cutoff'}
\description{
@@ -13,6 +14,7 @@
norm = NormType(), QF, nsim = 100000)
cutoff.sememp()
cutoff.chisq()
+cutoff.quant(qfct)
}
\arguments{
\item{name}{argument for name slot of \code{cutoff} object}
@@ -26,6 +28,7 @@
normal and \eqn{Q} a corresponding quadratic form}
\item{QF}{ a quadratic (positive semidefinite, symmetric) matrix used
as quadratic form }
+ \item{qfct}{ a (nominal) quantile function }
}
\details{
\code{cutoff} generates a valid object of class \code{"cutoff"}.
@@ -47,6 +50,13 @@
\code{cutoff.chisq()} is a helper function generating the theoretical (asymptotic)
quantile of (the square root of) a (self-standardized) quadratic form, assuming multivariate
normality; i.e.; a corresponding quantile of a Chi-Square distribution.
+
+\code{cutoff.quant()} is a helper function generating the theoretical quantile
+corresponding to the quantile function \code{qfct}; if \code{qfct} is missing,
+it searches the caller environment for an object \code{..ICloc}, and if this
+exists it uses the respective model quantile function; the fallback is
+\code{qnorm}. At any rate, if there is an object \code{..trf} in the scope of
+the function it is used to transfer the quantile (after its evaluation).
}
\value{Object of class \code{"cutoff"}.}
\author{
More information about the Robast-commits
mailing list