[Robast-commits] r1101 - in branches/robast-1.2/pkg/RobAStBase: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 6 08:35:45 CEST 2018
Author: ruckdeschel
Date: 2018-08-06 08:35:44 +0200 (Mon, 06 Aug 2018)
New Revision: 1101
Added:
branches/robast-1.2/pkg/RobAStBase/R/getPIC.R
Modified:
branches/robast-1.2/pkg/RobAStBase/DESCRIPTION
branches/robast-1.2/pkg/RobAStBase/NAMESPACE
branches/robast-1.2/pkg/RobAStBase/R/AllClass.R
branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R
branches/robast-1.2/pkg/RobAStBase/R/bALEstimate.R
branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-1.2/pkg/RobAStBase/inst/NEWS
branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd
branches/robast-1.2/pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd
Log:
[RobAStBase] branch 1.2:
+ new S4 (estimator) class "MCALEstimate" containing both
"MCEstimate" and "ALEstimate" to make accessible pIC-methods
to CvMMDEstimators...
+ new .checkEstClassForParamFamily method to force (expost)
casting to MCALEstimate (with pIC)
+ to speed up things slot pIC is filled with a promise only
which is only forced when called through accessor pIC
(and then the slot is filled with the actual pIC)
+ technically this is realized by a slot pIC of
class OptionalInfluenceCurveOrCall
+ internal function .getPIC is the workhorse: it takes the
estimator evaluates its argument ParamFamily from slot estimate.call
and moves it to the parameter value which was estimated;
at this parameter value, the IC is constructed
+ new internal helper method getPIC to get hand on the pIC
--> for MLE it computes it by optIC
--> for CvMMDEstimators -- it uses the name of the estimator;
more specifically it relies on tag
* "( mu = emp. cdf )" => this uses .CvMMDCovarianceWithMux
* "( mu = model distr. )" => this uses .CvMMDCovariance with no argument mu
* "( mu = <muname> )" => this uses .CvMMDCovariance with argument mu
to get the pIC
Modified: branches/robast-1.2/pkg/RobAStBase/DESCRIPTION
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/DESCRIPTION 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/DESCRIPTION 2018-08-06 06:35:44 UTC (rev 1101)
@@ -3,8 +3,8 @@
Date: 2018-08-03
Title: Robust Asymptotic Statistics
Description: Base S4-classes and functions for robust asymptotic statistics.
-Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2),
- RandVar(>= 0.9.2)
+Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.8.0), distrMod(>= 2.8.0),
+ RandVar(>= 1.1.0)
Suggests: ROptEst(>= 1.1.0), RUnit(>= 0.4.26)
Imports: startupmsg, graphics, grDevices, stats
Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"),
Modified: branches/robast-1.2/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/NAMESPACE 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/NAMESPACE 2018-08-06 06:35:44 UTC (rev 1101)
@@ -25,10 +25,11 @@
"TotalVarIC")
exportClasses("RobAStControl", "RobWeight", "BoundedWeight",
"BdStWeight", "HampelWeight")
-exportClasses("ALEstimate", "kStepEstimate", "MEstimate")
+exportClasses("ALEstimate", "MCALEstimate", "kStepEstimate", "MEstimate")
exportClasses("cutoff")
exportClasses("interpolRisk", "OMSRRisk","MBRRisk","RMXRRisk")
-exportClasses("StartClass", "pICList", "OptionalpICList", "OptionalCall")
+exportClasses("StartClass", "pICList", "OptionalpICList", "OptionalCall",
+ "OptionalInfluenceCurveOrCall")
exportMethods("show",
"plot")
exportMethods("type", "radius", "radius<-")
@@ -73,7 +74,7 @@
exportMethods("ddPlot", "qqplot", "returnlevelplot")
exportMethods("cutoff.quantile", "cutoff.quantile<-")
exportMethods("samplesize<-", "samplesize")
-exportMethods("getRiskFctBV", "getFiRisk")
+exportMethods("getRiskFctBV", "getFiRisk", "getPIC")
export("oneStepEstimator", "kStepEstimator")
export("ContNeighborhood", "TotalVarNeighborhood")
export("FixRobModel", "InfRobModel")
Modified: branches/robast-1.2/pkg/RobAStBase/R/AllClass.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/AllClass.R 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/R/AllClass.R 2018-08-06 06:35:44 UTC (rev 1101)
@@ -216,6 +216,7 @@
## ALEstimate
setClassUnion("OptionalCall", c("call","NULL"))
setClassUnion("OptionalInfluenceCurve", c("InfluenceCurve", "NULL"))
+setClassUnion("OptionalInfluenceCurveOrCall", c("InfluenceCurve", "NULL", "call"))
setClassUnion("StartClass", c("numeric", "matrix", "function", "Estimate"))
setClass("pICList",
prototype = prototype(list()),
@@ -231,7 +232,7 @@
})
setClassUnion("OptionalpICList", c("pICList", "NULL"))
setClass("ALEstimate",
- representation(pIC = "OptionalInfluenceCurve",
+ representation(pIC = "OptionalInfluenceCurveOrCall", #"OptionalInfluenceCurve",
asbias = "OptionalNumeric"),
prototype(name = "Asymptotically linear estimate",
estimate = numeric(0),
@@ -250,6 +251,16 @@
untransformed.estimate = NULL,
untransformed.asvar = NULL),
contains = "Estimate")
+
+setClass("MCALEstimate",
+ representation(pIC = "OptionalInfluenceCurveOrCall",
+ asbias = "OptionalNumeric"),
+ prototype(name = "Minimum criterion estimate (which is asy. linear)",
+ asbias = NULL,
+ pIC = NULL),
+ contains = c("ALEstimate","MCEstimate")
+)
+
setClass("kStepEstimate",
representation(steps = "integer",
pICList = "OptionalpICList",
Modified: branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R 2018-08-06 06:35:44 UTC (rev 1101)
@@ -247,3 +247,6 @@
setGeneric("getFiRisk",
function(risk, Distr, neighbor, ...) standardGeneric("getFiRisk"))
}
+if(!isGeneric("getPIC")){
+ setGeneric("getPIC", function(estimator) standardGeneric("getPIC"))
+}
Modified: branches/robast-1.2/pkg/RobAStBase/R/bALEstimate.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/bALEstimate.R 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/R/bALEstimate.R 2018-08-06 06:35:44 UTC (rev 1101)
@@ -2,7 +2,24 @@
## Functions and methods for "ALEstimate" classes and subclasses
###############################################################################
-setMethod("pIC", "ALEstimate", function(object) object at pIC)
+
+setMethod("pIC", "ALEstimate", function(object){
+ pIC0 <- .getPIC(object)
+ eval.parent(substitute(object at pIC <- pIC0))
+ return(pIC0)
+})
+
+setMethod("pIC", "MCEstimate", function(object){
+ if("pIC" %in% slotNames(class(object))){
+ pIC0 <- .getPIC(object)
+ eval.parent(substitute(object at pIC <- pIC0))
+ return(pIC0)
+ }else{
+ return(getPIC(object))
+ }})
+
+setMethod("pIC", "MCALEstimate", getMethod("pIC", "ALEstimate"))
+
setMethod("asbias", "ALEstimate", function(object) object at asbias)
setMethod("steps", "kStepEstimate", function(object) object at steps)
setMethod("Mroot", "MEstimate", function(object) object at Mroot)
@@ -161,3 +178,11 @@
fixed.estimate = fixed(object),
confint = ci)
})
+
+
+#setAs("MCEstimate", "MCALEstimate", def = function(from){
+# fromSlotNames <- slotNames(class(from))
+# to <- new("MCALEstimate")
+# for(item in fromSlotNames) slot(to, item) <- slot(from,item)
+# to at pIC <- .getPIC(from)
+# to})
Added: branches/robast-1.2/pkg/RobAStBase/R/getPIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getPIC.R (rev 0)
+++ branches/robast-1.2/pkg/RobAStBase/R/getPIC.R 2018-08-06 06:35:44 UTC (rev 1101)
@@ -0,0 +1,77 @@
+setMethod(".checkEstClassForParamFamily",
+ signature=signature(PFam="ANY",estimator="MCEstimate"),
+ function(PFam, estimator)estimator)
+
+
+setMethod(".checkEstClassForParamFamily",
+ signature=signature(PFam="ANY",estimator="MCEstimate"),
+ function(PFam, estimator){
+ fromSlotNames <- slotNames(class(estimator))
+ to <- new("MCALEstimate")
+ for(item in fromSlotNames) slot(to, item) <- slot(estimator,item)
+ to at pIC <- substitute(getPIC(estimator0), list(estimator0=estimator))
+ to
+ } )
+
+.getPIC <- function(object){
+ if(is.null(object at pIC)) return(NULL)
+ pIC0 <- object at pIC
+ if(is(pIC0, "InfluenceCurve")) return(pIC0)
+ if(is.call(pIC0)) pIC0 <- eval(pIC0)
+ return(pIC0)
+}
+
+.getL2Fam <- function(estimator){
+ ecl <- as.list(estimator at estimate.call)[-1]
+ L2Fam0 <- eval(ecl[["ParamFamily"]])
+ param.0 <- param(L2Fam0)
+ theta <- untransformed.estimate(estimator)
+ idx <- idx.m <- seq(length(theta))
+ if(!is.null(nuisance(param.0))){
+ lnx <- length(nuisance(param.0))
+ idx.n <- rev(rev(idx)[1:lnx])
+ idx.m <- idx[-idx.n]
+ param.0 at nuisance <- theta[idx.m]
+ }
+ param.0 at main <- theta[idx.m]
+ param.0 at trafo <- trafo(estimator)$mat
+ L2Fam <- modifyModel(L2Fam0, param.0)
+ return(L2Fam)
+}
+
+
+setMethod("getPIC","ANY", function(estimator)NULL)
+
+setMethod("getPIC","MLEstimate", function(estimator){
+ L2Fam <- .getL2Fam(estimator)
+ pIC <- optIC(L2Fam, risk=asCov())
+ return(pIC)
+ })
+
+setMethod("getPIC","CvMMDEstimate", function(estimator){
+ L2Fam <- .getL2Fam(estimator)
+ param.0 <- param(L2Fam)
+ ecl <- as.list(estimator at estimate.call)[-1]
+ print(system.time({
+ if(grepl("mu = model distr",name(estimator))){
+ res <- .CvMMDCovariance(L2Fam=L2Fam, param=param.0,withpreIC=TRUE, N = 2000)
+ }else{
+ if(grepl("mu = emp\\. cdf",name(estimator))){
+ x <- eval(ecl$x)
+ res <- .CvMMDCovarianceWithMux(L2Fam = L2Fam, param=param.0,x=x,withpreIC=TRUE, N = 2000)
+ }else{
+ mu <- eval(ecl$mu)
+ res <- .CvMMDCovariance(L2Fam=L2Fam, param=param.0,x=x,withpreIC=TRUE, mu=mu, N = 2000)
+ }
+ }
+ }))
+ ICCurve <- res$preIC
+ ICname <- "IC of CvM MDE"
+ ICCallL2Fam <- L2Fam at fam.call
+ ICRisks <- list(asCov = estimator at asvar)
+ ICInfos = matrix(c("pIC-CvM-MDE","computed by .CvMMDCovariance[WithMux]"), ncol=2,
+ dimnames=list(character(0), c("method", "message")))
+ pIC <- IC(name = ICname, Curve = ICCurve, Risks=ICRisks,
+ Infos = ICInfos, CallL2Fam = ICCallL2Fam, modifyIC = NULL)
+ return(pIC)
+ })
Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-06 06:35:44 UTC (rev 1101)
@@ -177,10 +177,15 @@
as(projker %*% IC.UpdateInKer at Curve,
"EuclRandVariable")
IC.tot.0 <- IC.tot1 + IC.tot2
- }else{
- IC.tot.0 <- if(!is.null(IC.UpdateInKer.0))
- IC.tot1 + as(projker %*% IC.UpdateInKer.0 at Curve,
- "EuclRandVariable") else NULL
+ }else{ if(!is.null(IC.UpdateInKer.0)){
+ IC.tot.0 <- NULL
+ }else{
+ if(is.call(IC.UpdateInKer.0))
+ IC.UpdateInKer.0 <- eval(IC.UpdateInKer.0)
+ IC.tot.0 <- IC.tot1 + as(projker %*%
+ IC.UpdateInKer.0 at Curve,
+ "EuclRandVariable")
+ }
}
IC.tot <- IC.tot1 + IC.tot2
correct <- rowMeans(evalRandVar(IC.tot, x0), na.rm = na.rm)
Modified: branches/robast-1.2/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/inst/NEWS 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/inst/NEWS 2018-08-06 06:35:44 UTC (rev 1101)
@@ -8,6 +8,36 @@
information)
#######################################
+version 1.2
+#######################################
+
+
+
+under the hood
++ new S4 (estimator) class "MCALEstimate" containing both
+ "MCEstimate" and "ALEstimate" to make accessible pIC-methods
+ to CvMMDEstimators...
++ new .checkEstClassForParamFamily method to force (expost)
+ casting to MCALEstimate (with pIC)
++ to speed up things slot pIC is filled with a promise only
+ which is only forced when called through accessor pIC
+ (and then the slot is filled with the actual pIC)
++ technically this is realized by a slot pIC of
+ class OptionalInfluenceCurveOrCall
++ internal function .getPIC is the workhorse: it takes the
+ estimator evaluates its argument ParamFamily from slot estimate.call
+ and moves it to the parameter value which was estimated;
+ at this parameter value, the IC is constructed
++ new internal helper method getPIC to get hand on the pIC
+ --> for MLE it computes it by optIC
+ --> for CvMMDEstimators -- it uses the name of the estimator;
+ more specifically it relies on tag
+ * "( mu = emp. cdf )" => this uses .CvMMDCovarianceWithMux
+ * "( mu = model distr. )" => this uses .CvMMDCovariance with no argument mu
+ * "( mu = <muname> )" => this uses .CvMMDCovariance with argument mu
+ to get the pIC
+
+#######################################
version 1.1
#######################################
Modified: branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd 2018-08-06 06:35:44 UTC (rev 1101)
@@ -1,8 +1,11 @@
\name{ALEstimate-class}
\docType{class}
\alias{ALEstimate-class}
+\alias{MCALEstimate-class}
\alias{pIC}
\alias{pIC,ALEstimate-method}
+\alias{pIC,MCEstimate-method}
+\alias{pIC,MCALEstimate-method}
\alias{asbias}
\alias{asbias,ALEstimate-method}
\alias{show,ALEstimate-method}
@@ -10,6 +13,11 @@
\alias{confint,ALEstimate,symmetricBias-method}
\alias{confint,ALEstimate,onesidedBias-method}
\alias{confint,ALEstimate,asymmetricBias-method}
+\alias{.checkEstClassForParamFamily,ANY,MCEstimate-method}
+\alias{getPIC}
+\alias{getPIC,ANY-method}
+\alias{getPIC,MLEstimate-method}
+\alias{getPIC,CvMMDEstimate-method}
\title{ALEstimate-class.}
\description{Class of asymptotically linear estimates.}
@@ -52,7 +60,9 @@
}
}
\section{Extends}{
-Class \code{"Estimate"}, directly.
+Class \code{ALEstimate} extends class \code{"Estimate"}, directly.
+Class \code{MCALEstimate} extends classes
+\code{"ALEstimate"}, and \code{"MCEstimate"} directly.
}
\section{Methods}{
\describe{
@@ -77,13 +87,68 @@
asymmetrically. }
}
}
+\details{The (return value) class of an estimator is of class \code{ALEstimate}
+ if it is asymptotically linear; then it has an influence function
+ (implemented in slot \code{pIC}) and so all the diagnostics for influence
+ functions are available; in addition it is asymptotically normal, so
+ we can (easily) deduce asymptotic covariances, hence may use these
+ in confidence intervals; in particular, the return values of \code{kStepEstimator}
+ \code{oneStepEstimator} (and \code{roptest}, \code{robest}, \code{RMXEstimator},
+ \code{MBREstimator}, \code{OBREstimator}, \code{OMSEstimator} in package
+ 'ROptEst') are objects of (subclasses of) this class.
+
+ As the return value of \code{CvMMDEEstimator} (or \code{MDEstimator} with
+ \code{CvMDist} or \code{CvMDist2} as distance) is asymptotically linear,
+ there is class \code{MCALEstimate} extending \code{MCEstimate} by
+ extra slots \code{pIC} and \code{asbias} (only filled optionally with
+ non-\code{NULL} values). Again all the diagnostics for influence
+ functions are then available.
+
+ Helper method \code{getPIC} by means of the estimator class, and, in
+ case of estimators of class \code{CvMMDEstimate}, also the name
+ (in slot \code{name}) produces the (partial) influence function:
+
+ calling
+ \code{.CvMMDCovariance} -- either directly or through wrapper
+ \code{.CvMMDCovarianceWithMux}. This is used in the corresponding
+ \code{coerce} / \code{setAs} method, which by
+ \code{setAs(object, "MCALEstimate")} coerces \code{object} from
+ class \code{"MCEstimate"} to \code{"MCALEstimate"}.
+ }
+
%\references{}
-\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de} and
+Peter Ruckdeschel \email{Peter.Ruckdeschel at uni-oldenburg.de}}
%\note{}
\seealso{\code{\link[distrMod]{Estimate-class}}}
\examples{
## prototype
new("ALEstimate")
+
+## data example
+set.seed(123)
+x <- rgamma(50, scale = 0.5, shape = 3)
+
+## parametric family of probability measures
+G <- GammaFamily(scale = 1, shape = 2)
+
+mle <- MLEstimator(x,G)
+(picM <- pIC(mle))
+
+## Kolmogorov(-Smirnov) minimum distance estimator
+ke <- KolmogorovMDEstimator(x = x, ParamFamily = G)
+pIC(ke) ## gives NULL
+
+## von Mises minimum distance estimator with default mu
+
+\donttest{ ## to save time for CRAN
+system.time(me <- CvMMDEstimator(x = x, ParamFamily = G))
+str(me at pIC) ## a call
+system.time(pIC0 <- pIC(me))
+str(me at pIC) ## now filled
}
+
+
+}
\concept{estimate}
\keyword{classes}
Modified: branches/robast-1.2/pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd 2018-08-04 09:56:01 UTC (rev 1100)
+++ branches/robast-1.2/pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd 2018-08-06 06:35:44 UTC (rev 1101)
@@ -1,6 +1,7 @@
\name{OptionalInfluenceCurve-class}
\docType{class}
\alias{OptionalInfluenceCurve-class}
+\alias{OptionalInfluenceCurveOrCall-class}
\alias{OptionalpICList-class}
\alias{StartClass-class}
\alias{pICList-class}
@@ -13,7 +14,9 @@
\code{StartClass}, \code{pICList}}
\section{Class Unions}{
\code{OptionalInfluenceCurve} is a class union of classes
- \code{InfluenceCurve} and \code{NULL} --- it is the slot
+ \code{InfluenceCurve} and \code{NULL};
+ \code{OptionalInfluenceCurveOrCall} is a class union of classes
+ \code{InfluenceCurve}, \code{call}, and \code{NULL} --- it is the slot
class of slot \code{pIC} in \code{ALEstimate};
\code{OptionalpICList} is a class union of classes
\code{pICList} and \code{NULL} --- it is the slot
More information about the Robast-commits
mailing list