[Robast-commits] r159 - in pkg: ROptEst ROptEst/R ROptEst/chm ROptEst/inst/scripts ROptEst/man RandVar/chm RandVar/inst/doc RobAStBase RobAStBase/R RobAStBase/chm RobAStBase/man RobLox RobLox/R RobLox/chm RobLox/inst/tests RobLox/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 10 18:49:25 CEST 2008
Author: stamats
Date: 2008-08-10 18:49:24 +0200 (Sun, 10 Aug 2008)
New Revision: 159
Added:
pkg/ROptEst/R/getModifyIC.R
pkg/ROptEst/R/roptest.R
pkg/ROptEst/man/getModifyIC.Rd
pkg/ROptEst/man/roptest.Rd
pkg/RobAStBase/R/RobAStBaseOptions.R
pkg/RobAStBase/R/kStepEstimator.R
pkg/RobAStBase/man/RobAStBaseOptions.Rd
pkg/RobAStBase/man/kStepEstimator.Rd
Modified:
pkg/ROptEst/DESCRIPTION
pkg/ROptEst/NAMESPACE
pkg/ROptEst/R/AllGeneric.R
pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
pkg/ROptEst/R/getIneffDiff.R
pkg/ROptEst/R/getInfRobIC_asBias.R
pkg/ROptEst/R/getInfRobIC_asCov.R
pkg/ROptEst/R/getInfRobIC_asGRisk.R
pkg/ROptEst/R/getInfRobIC_asHampel.R
pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
pkg/ROptEst/R/leastFavorableRadius.R
pkg/ROptEst/R/optIC.R
pkg/ROptEst/R/radiusMinimaxIC.R
pkg/ROptEst/chm/00Index.html
pkg/ROptEst/chm/ROptEst.chm
pkg/ROptEst/chm/ROptEst.hhp
pkg/ROptEst/chm/ROptEst.toc
pkg/ROptEst/chm/getAsRisk.html
pkg/ROptEst/chm/getBiasIC.html
pkg/ROptEst/inst/scripts/BinomialModel.R
pkg/ROptEst/inst/scripts/ExponentialScaleModel.R
pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
pkg/ROptEst/inst/scripts/PoissonModel.R
pkg/ROptEst/man/getAsRisk.Rd
pkg/ROptEst/man/getBiasIC.Rd
pkg/ROptEst/man/getFiRisk.Rd
pkg/ROptEst/man/getFixClip.Rd
pkg/ROptEst/man/getFixRobIC.Rd
pkg/ROptEst/man/getIneffDiff.Rd
pkg/ROptEst/man/getInfCent.Rd
pkg/ROptEst/man/getInfClip.Rd
pkg/ROptEst/man/getInfGamma.Rd
pkg/ROptEst/man/getInfRobIC.Rd
pkg/ROptEst/man/getInfStand.Rd
pkg/ROptEst/man/getInfV.Rd
pkg/ROptEst/man/getL1normL2deriv.Rd
pkg/ROptEst/man/getL2normL2deriv.Rd
pkg/ROptEst/man/getRiskIC.Rd
pkg/ROptEst/man/leastFavorableRadius.Rd
pkg/ROptEst/man/lowerCaseRadius.Rd
pkg/ROptEst/man/minmaxBias.Rd
pkg/ROptEst/man/optIC.Rd
pkg/ROptEst/man/optRisk.Rd
pkg/ROptEst/man/radiusMinimaxIC.Rd
pkg/RandVar/chm/RandVar.chm
pkg/RandVar/inst/doc/RandVar.pdf
pkg/RobAStBase/DESCRIPTION
pkg/RobAStBase/NAMESPACE
pkg/RobAStBase/R/AllClass.R
pkg/RobAStBase/R/AllGeneric.R
pkg/RobAStBase/R/AllShow.R
pkg/RobAStBase/R/ContIC.R
pkg/RobAStBase/R/IC.R
pkg/RobAStBase/R/TotalVarIC.R
pkg/RobAStBase/R/bALEstimate.R
pkg/RobAStBase/R/getBiasIC.R
pkg/RobAStBase/R/getRiskIC.R
pkg/RobAStBase/R/locMEstimator.R
pkg/RobAStBase/R/oneStepEstimator.R
pkg/RobAStBase/R/optIC.R
pkg/RobAStBase/chm/00Index.html
pkg/RobAStBase/chm/BdStWeight-class.html
pkg/RobAStBase/chm/BoundedWeight-class.html
pkg/RobAStBase/chm/ContIC-class.html
pkg/RobAStBase/chm/ContIC.html
pkg/RobAStBase/chm/HampIC-class.html
pkg/RobAStBase/chm/HampelWeight-class.html
pkg/RobAStBase/chm/IC-class.html
pkg/RobAStBase/chm/IC.html
pkg/RobAStBase/chm/RobAStBase.chm
pkg/RobAStBase/chm/RobAStBase.hhp
pkg/RobAStBase/chm/RobAStBase.toc
pkg/RobAStBase/chm/RobAStControl-class.html
pkg/RobAStBase/chm/RobWeight-class.html
pkg/RobAStBase/chm/TotalVarIC-class.html
pkg/RobAStBase/chm/TotalVarIC.html
pkg/RobAStBase/chm/locMEstimator.html
pkg/RobAStBase/chm/makeIC-methods.html
pkg/RobAStBase/chm/oneStepEstimator.html
pkg/RobAStBase/man/ALEstimate-class.Rd
pkg/RobAStBase/man/BdStWeight-class.Rd
pkg/RobAStBase/man/BoundedWeight-class.Rd
pkg/RobAStBase/man/ContIC-class.Rd
pkg/RobAStBase/man/ContIC.Rd
pkg/RobAStBase/man/HampIC-class.Rd
pkg/RobAStBase/man/HampelWeight-class.Rd
pkg/RobAStBase/man/IC-class.Rd
pkg/RobAStBase/man/IC.Rd
pkg/RobAStBase/man/InfluenceCurve-class.Rd
pkg/RobAStBase/man/InfluenceCurve.Rd
pkg/RobAStBase/man/MEstimate-class.Rd
pkg/RobAStBase/man/RobAStControl-class.Rd
pkg/RobAStBase/man/RobWeight-class.Rd
pkg/RobAStBase/man/TotalVarIC-class.Rd
pkg/RobAStBase/man/TotalVarIC.Rd
pkg/RobAStBase/man/checkIC.Rd
pkg/RobAStBase/man/comparePlot.Rd
pkg/RobAStBase/man/evalIC.Rd
pkg/RobAStBase/man/generateIC.Rd
pkg/RobAStBase/man/generateICfct.Rd
pkg/RobAStBase/man/getBiasIC.Rd
pkg/RobAStBase/man/getRiskIC.Rd
pkg/RobAStBase/man/getweight.Rd
pkg/RobAStBase/man/infoPlot.Rd
pkg/RobAStBase/man/kStepEstimate-class.Rd
pkg/RobAStBase/man/locMEstimator.Rd
pkg/RobAStBase/man/makeIC-methods.Rd
pkg/RobAStBase/man/oneStepEstimator.Rd
pkg/RobAStBase/man/optIC.Rd
pkg/RobLox/DESCRIPTION
pkg/RobLox/R/colRoblox.R
pkg/RobLox/R/rlOptIC.R
pkg/RobLox/R/rlsOptIC_AL.R
pkg/RobLox/R/roblox.R
pkg/RobLox/R/rowRoblox.R
pkg/RobLox/R/rsOptIC.R
pkg/RobLox/chm/00Index.html
pkg/RobLox/chm/RobLox.chm
pkg/RobLox/chm/RobLox.toc
pkg/RobLox/chm/rlOptIC.html
pkg/RobLox/chm/rlsOptIC.AL.html
pkg/RobLox/chm/rlsOptIC.An1.html
pkg/RobLox/chm/rlsOptIC.An2.html
pkg/RobLox/chm/rlsOptIC.AnMad.html
pkg/RobLox/chm/rlsOptIC.BM.html
pkg/RobLox/chm/rlsOptIC.Ha3.html
pkg/RobLox/chm/rlsOptIC.Ha4.html
pkg/RobLox/chm/rlsOptIC.HaMad.html
pkg/RobLox/chm/rlsOptIC.Hu1.html
pkg/RobLox/chm/rlsOptIC.Hu2.html
pkg/RobLox/chm/rlsOptIC.Hu2a.html
pkg/RobLox/chm/rlsOptIC.Hu3.html
pkg/RobLox/chm/rlsOptIC.HuMad.html
pkg/RobLox/chm/rlsOptIC.M.html
pkg/RobLox/chm/rlsOptIC.MM2.html
pkg/RobLox/chm/rlsOptIC.Tu1.html
pkg/RobLox/chm/rlsOptIC.Tu2.html
pkg/RobLox/chm/rlsOptIC.TuMad.html
pkg/RobLox/chm/roblox.html
pkg/RobLox/chm/rowRoblox.html
pkg/RobLox/chm/rsOptIC.html
pkg/RobLox/inst/tests/tests.R
pkg/RobLox/man/rlOptIC.Rd
pkg/RobLox/man/rlsOptIC.AL.Rd
pkg/RobLox/man/roblox.Rd
pkg/RobLox/man/rsOptIC.Rd
Log:
merged branch into trunk
Modified: pkg/ROptEst/DESCRIPTION
===================================================================
--- pkg/ROptEst/DESCRIPTION 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/DESCRIPTION 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,6 +1,6 @@
Package: ROptEst
Version: 0.6.0
-Date: 2008-07-21
+Date: 2008-08-07
Title: Optimally robust estimation
Description: Optimally robust estimation using S4 classes and methods
Depends: R(>= 2.4.0), methods, distr(>= 2.0), distrEx(>= 2.0), distrMod(>= 2.0), RandVar(>= 0.6.2), RobAStBase
@@ -9,4 +9,3 @@
LazyLoad: yes
License: GPL version 2 or later
URL: http://robast.r-forge.r-project.org/
-Packaged: Thu Jan 3 20:00:08 2008; btm722
Modified: pkg/ROptEst/NAMESPACE
===================================================================
--- pkg/ROptEst/NAMESPACE 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/NAMESPACE 2008-08-10 16:49:24 UTC (rev 159)
@@ -22,6 +22,8 @@
"leastFavorableRadius",
"lowerCaseRadius",
"minmaxBias", "getBiasIC",
- "getL1normL2deriv")
+ "getL1normL2deriv",
+ "getModifyIC")
exportMethods("updateNorm")
export("getL2normL2deriv")
+export("roptest")
Modified: pkg/ROptEst/R/AllGeneric.R
===================================================================
--- pkg/ROptEst/R/AllGeneric.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/AllGeneric.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -71,3 +71,6 @@
if(!isGeneric("updateNorm")){
setGeneric("updateNorm", function(normtype, ...) standardGeneric("updateNorm"))
}
+if(!isGeneric("getModifyIC")){
+ setGeneric("getModifyIC", function(L2FamIC, neighbor, risk) standardGeneric("getModifyIC"))
+}
Modified: pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
===================================================================
--- pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -4,8 +4,7 @@
setMethod("getFixRobIC", signature(Distr = "Norm",
risk = "fiUnOvShoot",
neighbor = "UncondNeighborhood"),
- function(Distr, risk, neighbor,
- sampleSize, upper, maxiter, tol, warn,
+ function(Distr, risk, neighbor, sampleSize, upper, maxiter, tol, warn,
Algo, cont){
radius <- neighbor at radius
if(identical(all.equal(radius, 0), TRUE)){
Modified: pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- pkg/ROptEst/R/getIneffDiff.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getIneffDiff.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -7,14 +7,15 @@
risk = "asMSE"),
function(radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk,
z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
- loNorm = NULL, upNorm = NULL){
+ loNorm = NULL, upNorm = NULL, verbose = FALSE){
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
if(L2derivDim == 1){
neighbor at radius <- radius
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps, warn = warn)
+ trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ warn = warn, verbose = verbose)
trafo <- as.vector(L2Fam at param@trafo)
ineffLo <- (as.vector(res$A)*trafo - res$b^2*(radius^2-loRad^2))/loRisk
if(upRad == Inf)
@@ -52,9 +53,9 @@
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = MaxIter,
- tol = eps, warn = warn)
+ tol = eps, warn = warn, verbose = verbose)
normtype(risk) <- res$normtype
- std <- if(is(normtype(risk),"QFNorm")) QuadForm(normtype(risk)) else diag(p)
+ std <- if(is(normtype(risk),"QFNorm")) QuadForm(normtype(risk)) else diag(p)
biasLo <- biasUp <- res$b
@@ -74,15 +75,16 @@
ineffUp <- if(upRad == Inf) biasUp^2/upRisk else
(p+biasUp^2*upRad^2)/upRisk
}else{
- ineffLo <- (sum(diag(std%*%res$A%*%t(trafo))) -
- biasLo^2*(radius^2-loRad^2))/loRisk
+ ineffLo <- (sum(diag(std%*%res$A%*%t(trafo))) -
+ biasLo^2*(radius^2-loRad^2))/loRisk
if(upRad == Inf)
ineffUp <- biasUp^2/upRisk
else
ineffUp <- (sum(diag(std%*%res$A%*%t(trafo))) -
biasUp^2*(radius^2-upRad^2))/upRisk}
assign("ineff", ineffUp, envir = sys.frame(which = -4))
- cat("current radius:\t", radius, "\tMSE-inefficiency difference:\t", ineffUp - ineffLo, "\n")
+ if(verbose)
+ cat("current radius:\t", radius, "\tMSE-inefficiency difference:\t", ineffUp - ineffLo, "\n")
return(ineffUp - ineffLo)
}else{
Modified: pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asBias.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getInfRobIC_asBias.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,7 +5,7 @@
risk = "asBias",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, trafo, maxiter,
- tol, warn, Finfo, ...){
+ tol, warn, Finfo, verbose = FALSE, ...){
erg <- minmaxBias(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype(risk), symm = symm,
trafo = trafo, maxiter = maxiter,
@@ -18,14 +18,14 @@
asMSE = list(value = asCov + r^2*b^2,
r = r,
at = neighbor)))
- return(erg)
+ return(erg)
})
setMethod("getInfRobIC", signature(L2deriv = "RealRandVariable",
risk = "asBias",
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, z.start,
- A.start, Finfo, trafo, maxiter, tol, warn, ...){
+ A.start, Finfo, trafo, maxiter, tol, warn, verbose = FALSE, ...){
normtype <- normtype(risk)
if(is(normtype,"SelfNorm")){
@@ -45,7 +45,7 @@
L2derivDistrSymm = L2derivDistrSymm, Finfo = Finfo,
trafo = trafo, onesetLM = FALSE, z.start = z.start,
A.start = A.start, upper = 1e4, maxiter = maxiter,
- tol = tol, warn = warn)
+ tol = tol, warn = warn, verbose = verbose)
res$risk$asBias <- list(value = sqrt(nrow(trafo)),
biastype = symmetricBias(),
normtype = normtype,
@@ -53,7 +53,7 @@
remark = gettext("value is only a bound"))
return(res)
}
-
+
FI <- solve(trafo%*%solve(Finfo)%*%t(trafo))
if(is(normtype,"InfoNorm"))
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
@@ -61,7 +61,7 @@
comp <- .getComp(L2deriv, DistrSymm, L2derivSymm,
L2derivDistrSymm)
-
+
z.comp <- comp$"z.comp"
A.comp <- comp$"A.comp"
@@ -111,7 +111,7 @@
normW = NormType())
return(list(A = A, a = zi*z, b = b, d = d, risk = Risk, info = info,
- w = w, biastype = biastype, normtype = NormType()))
+ w = w, biastype = biastype, normtype = NormType()))
})
setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution",
@@ -132,7 +132,7 @@
a <- -b*(1-p0)/(1-ws0)
else
a <- -b*(p0-ws0)/(1-ws0)
-
+
info <- c("minimum asymptotic bias (lower case) solution")
asCov <- a^2*(p0-ws0) + (zi*a+b)^2*(1-p0)
Risk <- list(asBias = list(value = b, biastype = biastype,
@@ -153,7 +153,7 @@
neighbor = "ContNeighborhood",
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, normtype, Distr,
- z.start, A.start, z.comp, A.comp, trafo, maxiter, tol){
+ z.start, A.start, z.comp, A.comp, trafo, maxiter, tol){
eerg <- .LowerCaseMultivariate(L2deriv, neighbor, biastype,
normtype, Distr, trafo, z.start,
@@ -197,7 +197,7 @@
trAsCov = list(value = trAsCov, normtype = normtype),
asMSE = list(value = r^2 * b^2 + trAsCov,
r = r,
- at = neighbor))
+ at = neighbor))
return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info,
w = w, biastype = biastype, normtype = normtype))
})
@@ -206,7 +206,7 @@
neighbor = "ContNeighborhood",
biastype = "asymmetricBias"),
function(L2deriv, neighbor, biastype, symm,
- trafo, maxiter, tol, warn, Finfo){
+ trafo, maxiter, tol, warn, Finfo){
nu1 <- nu(biastype)[1]
nu2 <- nu(biastype)[2]
zi <- sign(as.vector(trafo))
@@ -250,7 +250,7 @@
neighbor = "ContNeighborhood",
biastype = "onesidedBias"),
function(L2deriv, neighbor, biastype, symm,
- trafo, maxiter, tol, warn, Finfo){
+ trafo, maxiter, tol, warn, Finfo){
infotxt <- c("minimum asymptotic bias (lower case) solution")
noIC <- function(){
warntxt <- paste(gettext(
@@ -267,8 +267,9 @@
res <- getInfRobIC(L2deriv = L2deriv,
risk = asHampel(bound = bd, biastype = biastype),
neighbor = neighbor, Finfo = Finfo, trafo = trafo, tol = tol,
- warn = warn, noLow = TRUE, symm = symm, maxiter = maxiter),
- silent = TRUE))) bd <- bd * 1.5
+ warn = warn, noLow = TRUE, symm = symm, maxiter = maxiter,
+ verbose = verbose),
+ silent = TRUE))) bd <- bd * 1.5
return(res)}
if(is(L2deriv, "DiscreteDistribution"))
{ if(is.finite(lowerCaseRadius(L2deriv, neighbor, risk = asMSE(), biastype)))
@@ -300,19 +301,17 @@
neighbortype = class(neighbor)),
asCov = asCov)
A0 <- matrix(A0,1,1)
-
+
w <- new("HampelWeight")
cent(w) <- z0
stand(w) <- A0
clip(w) <- b0
weight(w) <- minbiasweight(w, neighbor = neighbor,
biastype = biastype)
-
+
}else{return(noIC())}
}else{return(noIC())}
return(list(A = A0, a = a0, b = b0, d = d0, risk = Risk0,
info = infotxt, w = w, biastype = biastype,
normtype = NormType()))
})
-
-
\ No newline at end of file
Modified: pkg/ROptEst/R/getInfRobIC_asCov.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asCov.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getInfRobIC_asCov.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -4,7 +4,7 @@
setMethod("getInfRobIC", signature(L2deriv = "UnivariateDistribution",
risk = "asCov",
neighbor = "ContNeighborhood"),
- function(L2deriv, risk, neighbor, Finfo, trafo){
+ function(L2deriv, risk, neighbor, Finfo, trafo, verbose = FALSE){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
@@ -26,8 +26,7 @@
setMethod("getInfRobIC", signature(L2deriv = "UnivariateDistribution",
risk = "asCov",
neighbor = "TotalVarNeighborhood"),
- function(L2deriv, risk, neighbor,
- Finfo, trafo){
+ function(L2deriv, risk, neighbor, Finfo, trafo, verbose = FALSE){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
b <- abs(as.vector(A))*(q(L2deriv)(1)-q(L2deriv)(0))
@@ -47,8 +46,8 @@
setMethod("getInfRobIC", signature(L2deriv = "RealRandVariable",
risk = "asCov",
neighbor = "ContNeighborhood"),
- function(L2deriv, risk, neighbor,
- Distr, Finfo, trafo, QuadForm = diag(nrow(trafo))){
+ function(L2deriv, risk, neighbor, Distr, Finfo, trafo,
+ QuadForm = diag(nrow(trafo)), verbose = FALSE){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
IC <- A %*% L2deriv
Modified: pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,14 +5,15 @@
risk = "asGRisk",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper, maxiter, tol,
- warn, noLow = FALSE){
+ warn, noLow = FALSE, verbose = FALSE){
biastype <- biastype(risk)
radius <- neighbor at radius
if(identical(all.equal(radius, 0), TRUE)){
if(warn) cat("'radius == 0' => (classical) optimal IC\n",
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
- neighbor = neighbor, Finfo = Finfo, trafo = trafo)
+ neighbor = neighbor, Finfo = Finfo, trafo = trafo,
+ verbose = verbose)
res <- c(res, list(biastype = biastype, normtype = NormType()))
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = res$b, cent = res$a,
@@ -21,7 +22,7 @@
Cov <- res$risk$asCov
res$risk$asBias <- list(value = b, biastype = biastype,
normtype = NormType(),
- neighbortype = class(neighbor))
+ neighbortype = class(neighbor))
res$risk$asMSE <- list(value = Cov + radius^2*b^2,
r = radius,
at = neighbor)
@@ -35,6 +36,7 @@
else
S <- FALSE
+ prec <- 1
repeat{
iter <- iter + 1
z.old <- z
@@ -63,7 +65,8 @@
normtype = normtype(risk)),
neighbor = neighbor, Finfo = Finfo,
symm = symm, trafo = trafo, upper = upper,
- maxiter = maxiter, tol = tol, warn = warn)
+ maxiter = maxiter, tol = tol, warn = warn,
+ verbose = verbose)
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = res$b, cent = res$a,
stand = res$A, trafo = trafo)
@@ -74,9 +77,18 @@
clip = c0, cent = z, symm = S, trafo = trafo, tol.z = tol)
# cat("c0:\t", c0, "c0.old:\t", c0.old, "z:\t", z, "z.old:\t", z.old, "\n")
if(S) break
- if(max(abs(z - z.old), abs(c0-c0.old)) < tol) break
+
+ prec.old <- prec
+ prec <- max(abs(z - z.old), abs(c0-c0.old))
+ if(verbose)
+ cat("current precision in IC algo:\t", prec, "\n")
+ if(prec < tol) break
+ if(abs(prec.old - prec) < 1e-10){
+ cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
+ break
+ }
if(iter > maxiter){
- cat("maximum iterations reached!\n", "achieved precision:\t", abs(c0 - c0.old), "\n")
+ cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
break
}
}
@@ -90,7 +102,7 @@
trafo = trafo)
Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = c0, cent = z, stand = A)
-
+
Risk <- c(Risk, list(asCov = Cov,
asBias = list(value = b, biastype = biastype,
normtype = normtype(risk),
@@ -100,17 +112,17 @@
r = radius,
at = neighbor)))
- if(is(neighbor,"ContNeighborhood"))
- {w <- new("HampelWeight")
+ if(is(neighbor,"ContNeighborhood")){
+ w <- new("HampelWeight")
clip(w) <- b
cent(w) <- z
stand(w) <- A
- }else{
+ }else{
w <- new("BdStWeight")
clip(w) <- c(0,b)+a
stand(w) <- A
- }
-
+ }
+
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = NormType())
@@ -128,8 +140,7 @@
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE,
- z.start, A.start, upper, maxiter,
- tol, warn){
+ z.start, A.start, upper, maxiter, tol, warn, verbose = FALSE){
biastype <- biastype(risk)
normtype <- normtype(risk)
@@ -138,7 +149,7 @@
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
normtype(risk) <- normtype}
QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(trafo))
-
+
if(is.null(z.start)) z.start <- numeric(ncol(trafo))
if(is.null(A.start)) A.start <- trafo %*% solve(Finfo)
@@ -148,7 +159,7 @@
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(), neighbor = neighbor,
Distr = Distr, Finfo = Finfo, trafo = trafo,
- QuadForm = QF)
+ QuadForm = QF, verbose = verbose)
res <- c(res, list(biastype = biastype, normtype = normtype))
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, cent = res$a,
@@ -159,16 +170,15 @@
res$risk$trAsCov <- list(value = trAsCov, normtype = normtype)
res$risk$asBias <- list(value = b, biastype = biastype,
normtype = normtype,
- neighbortype = class(neighbor))
+ neighbortype = class(neighbor))
res$risk$asMSE <- list(value = trAsCov + r^2*b^2,
r = r,
at = neighbor)
return(res)
}
- comp <- .getComp(L2deriv, DistrSymm, L2derivSymm,
- L2derivDistrSymm)
-
+ comp <- .getComp(L2deriv, DistrSymm, L2derivSymm, L2derivDistrSymm)
+
z.comp <- comp$"z.comp"
A.comp <- comp$"A.comp"
@@ -177,6 +187,7 @@
A <- A.start
b <- 0
iter <- 0
+ prec <- 1
repeat{
iter <- iter + 1
z.old <- z
@@ -199,7 +210,6 @@
if(is.null(upper)) upper <- 10*upper0
}else{ lower <- lower0; upper <- upper0}
-
##
b <- try(uniroot(getInfClip,
## new
@@ -220,7 +230,8 @@
neighbor = neighbor, Distr = Distr, DistrSymm = DistrSymm,
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
z.start = z.start, A.start = A.start, trafo = trafo,
- maxiter = maxiter, tol = tol, warn = warn, Finfo = Finfo)
+ maxiter = maxiter, tol = tol, warn = warn, Finfo = Finfo,
+ verbose = verbose)
normtype(risk) <- res$normtype
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = NULL,
@@ -233,7 +244,6 @@
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = normtype)
-
z <- getInfCent(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, Distr = Distr, z.comp = z.comp,
@@ -250,9 +260,15 @@
Distr = Distr, V.comp = A.comp, cent = as.vector(A %*% z),
stand = A, w = w)}
+ prec.old <- prec
prec <- max(abs(b-b.old), max(abs(A-A.old)), max(abs(z-z.old)))
- cat("current precision in IC algo:\t", prec, "\n")
+ if(verbose)
+ cat("current precision in IC algo:\t", prec, "\n")
if(prec < tol) break
+ if(abs(prec.old - prec) < 1e-10){
+ cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
+ break
+ }
if(iter > maxiter){
cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
break
@@ -263,8 +279,8 @@
stand(w) <- A
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = normtype)
- } else normtype <- normtype.old
-
+ }else normtype <- normtype.old
+
a <- as.vector(A %*% z)
info <- paste("optimally robust IC for", sQuote(class(risk)[1]))
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
@@ -274,7 +290,7 @@
biastype = biastype, Distr = Distr,
V.comp = A.comp, cent = a,
stand = A, w = w)
-
+
QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A))
trAsCov <- sum(diag(QF%*%Cov))
@@ -289,5 +305,5 @@
at = neighbor)))
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info, w = w,
- biastype = biastype, normtype = normtype))
+ biastype = biastype, normtype = normtype))
})
Modified: pkg/ROptEst/R/getInfRobIC_asHampel.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,7 +5,7 @@
risk = "asHampel",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn, noLow = FALSE){
+ upper, maxiter, tol, warn, noLow = FALSE, verbose = FALSE){
biastype <- biastype(risk)
normtype <- normtype(risk)
@@ -17,30 +17,29 @@
if(warn) cat("'b >= maximum asymptotic bias' => (classical) optimal IC\n",
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
- neighbor = neighbor, Finfo = Finfo, trafo = trafo)
+ neighbor = neighbor, Finfo = Finfo, trafo = trafo,
+ verbose = verbose)
res <- c(res, list(biastype = biastype, normtype = NormType()))
Cov <- res$risk$asCov
r <- neighbor at radius
res$risk$asBias <- list(value = b, biastype = biastype,
normtype = normtype,
- neighbortype = class(neighbor))
+ neighbortype = class(neighbor))
res$risk$asMSE <- list(value = Cov + r^2*b^2,
r = r,
at = neighbor)
return(res)
}
- if(!noLow)
- {res <- getInfRobIC(L2deriv = L2deriv, risk = asBias(biastype = biastype),
- neighbor = neighbor, symm = symm,
- trafo = trafo, maxiter = maxiter, tol = tol, Finfo = Finfo,
- warn = warn)
- bmin <- res$b
- cat("minimal bound:\t", bmin, "\n")
+ if(!noLow){
+ res <- getInfRobIC(L2deriv = L2deriv, risk = asBias(biastype = biastype),
+ neighbor = neighbor, symm = symm,
+ trafo = trafo, maxiter = maxiter, tol = tol, Finfo = Finfo,
+ warn = warn, verbose = verbose)
+ bmin <- res$b
+ cat("minimal bound:\t", bmin, "\n")
+ }else bmin <- b/2
- } else bmin <- b/2
-
-
if(b <= bmin){
if(warn) cat("'b <= minimum asymptotic bias'\n",
"=> the minimum asymptotic bias (lower case) solution is returned\n")
@@ -94,12 +93,12 @@
a <- as.vector(A)*z
Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = c0, cent = z, stand = A)
-
+
# getAsRisk(risk = asHampel(), L2deriv = L2deriv, neighbor = neighbor,
# biastype = biastype, clip = b, cent = a, stand = A)$asCov
r <- neighbor at radius
- Risk <- list(asCov = Cov,
+ Risk <- list(asCov = Cov,
asBias = list(value = b, biastype = biastype,
normtype = normtype,
neighbortype = class(neighbor)),
@@ -107,17 +106,17 @@
asMSE = list(value = Cov + r^2*b^2,
r = r,
at = neighbor))
-
- if(is(neighbor,"ContNeighborhood"))
- {w <- new("HampelWeight")
+
+ if(is(neighbor,"ContNeighborhood")){
+ w <- new("HampelWeight")
clip(w) <- b
cent(w) <- z
stand(w) <- A
- }else{
+ }else{
w <- new("BdStWeight")
clip(w) <- c(0,b)+a
stand(w) <- A
- }
+ }
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = NormType())
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info,
@@ -129,7 +128,7 @@
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE,
- z.start, A.start, upper, maxiter, tol, warn){
+ z.start, A.start, upper, maxiter, tol, warn, verbose = FALSE){
biastype <- biastype(risk)
normtype <- normtype(risk)
@@ -157,14 +156,14 @@
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(), neighbor = neighbor,
Distr = Distr, Finfo = Finfo, trafo = trafo,
- QuadForm = std)
+ QuadForm = std, verbose = verbose)
res <- c(res, list(biastype = biastype, normtype = normtype))
trAsCov <- sum(diag(std%*%res$risk$asCov));
r <- neighbor at radius
res$risk$trAsCov <- list(value = trAsCov, normtype = normtype)
res$risk$asBias <- list(value = b, biastype = biastype,
normtype = normtype,
- neighbortype = class(neighbor))
+ neighbortype = class(neighbor))
res$risk$asMSE <- list(value = trAsCov + r^2*b^2,
r = r,
at = neighbor)
@@ -176,7 +175,8 @@
neighbor = neighbor, Distr = Distr, DistrSymm = DistrSymm,
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
z.start = z.start, A.start = A.start, trafo = trafo,
- maxiter = maxiter, tol = tol, warn = warn, Finfo = Finfo)
+ maxiter = maxiter, tol = tol, warn = warn, Finfo = Finfo,
+ verbose = verbose)
bmin <- res$b
cat("minimal bound:\t", bmin, "\n")
@@ -193,7 +193,7 @@
comp <- .getComp(L2deriv, DistrSymm, L2derivSymm,
L2derivDistrSymm)
-
+
z.comp <- comp$"z.comp"
A.comp <- comp$"A.comp"
@@ -229,7 +229,8 @@
}
prec <- max(max(abs(A-A.old)), max(abs(z-z.old)))
- cat("current precision in IC algo:\t", prec, "\n")
+ if(verbose)
+ cat("current precision in IC algo:\t", prec, "\n")
if(prec < tol) break
if(iter > maxiter){
cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
@@ -244,7 +245,7 @@
normW = normtype)
}
else normtype <- normtype.old
-
+
info <- paste("optimally robust IC for 'asHampel' with bound =", round(b,3))
a <- as.vector(A %*% z)
Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
@@ -260,11 +261,11 @@
asCov = Cov,
asBias = list(value = b, biastype = biastype,
normtype = normtype,
- neighbortype = class(neighbor)),
+ neighbortype = class(neighbor)),
asMSE = list(value = trAsCov + r^2*b^2,
r = r,
at = neighbor))
-
+
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info,
w = w, biastype = biastype, normtype = normtype))
})
Modified: pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -14,20 +14,19 @@
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
neighbor = TotalVarNeighborhood(radius = neighbor at radius),
Finfo = Finfo, trafo = trafo)
- if(is(neighbor, "ContNeighborhoood"))
- {
+ if(is(neighbor, "ContNeighborhoood")){
res.c <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
neighbor = ContNeighborhood(radius = neighbor at radius),
- Finfo = Finfo, trafo = trafo)
+ Finfo = Finfo, trafo = trafo, verbose = FALSE)
res$risk <- res.c$risk
- }
+ }
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = res$b, cent = res$a,
stand = res$A, trafo = trafo)
res$risk <- c(Risk, res$risk)
return(res)
}
-
+
bound <- risk at width*(-m1df(L2deriv, 0))
if(is(neighbor, "ContNeighborhood")){
if(identical(all.equal(radius, 2*bound), TRUE)){
@@ -44,11 +43,11 @@
a <- -b*(1-p0)/(1-ws0)
else
a <- b*(p0-ws0)/(1-ws0)
-
+
info <- paste("optimally robust IC for", sQuote(class(risk)[1]))
Risk <- list(asUnOvShoot = 0.5)
- return(list(A = A, a = a, b = b, d = 1, risk = Risk, info = info))
+ return(list(A = A, a = a, b = b, d = 1, risk = Risk, info = info))
}
if(radius > 2*bound)
stop("boundedness condition is violated!")
@@ -69,16 +68,16 @@
a <- -b*(1-p0)/(1-ws0)
else
a <- b*(p0-ws0)/(1-ws0)
-
+
info <- paste("optimally robust IC for", sQuote(class(risk)[1]))
Risk <- list(asUnOvShoot = 0.5)
- return(list(A = A, a = a, b = b, d = 1, risk = Risk, info = info))
+ return(list(A = A, a = a, b = b, d = 1, risk = Risk, info = info))
}
if(radius > bound)
stop("boundedness condition is violated!")
}
-
+
z <- 0
c0 <- 0
iter <- 0
@@ -86,7 +85,7 @@
S <- symm at SymmCenter == 0
else
S <- FALSE
-
+
repeat{
iter <- iter + 1
z.old <- z
Copied: pkg/ROptEst/R/getModifyIC.R (from rev 157, branches/robast-0.6/pkg/ROptEst/R/getModifyIC.R)
===================================================================
--- pkg/ROptEst/R/getModifyIC.R (rev 0)
+++ pkg/ROptEst/R/getModifyIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,136 @@
+###############################################################################
+## internal functions/methods to fill slot modifyIC
+###############################################################################
+
+setMethod("getModifyIC", signature(L2FamIC = "L2ParamFamily",
+ neighbor = "Neighborhood", risk = "asRisk"),
+ function(L2FamIC, neighbor, risk){
+ modIC <- function(L2Fam, IC){}
+ body(modIC) <- substitute({ infMod <- InfRobModel(L2Fam, nghb)
+ optIC(infMod, R) },
+ list(nghb = neighbor, R = risk))
+ return(modIC)
+ })
+
+setMethod("getModifyIC", signature(L2FamIC = "L2LocationFamily",
+ neighbor = "UncondNeighborhood", risk = "asGRisk"),
+ function(L2FamIC, neighbor, risk){
+ modIC <- function(L2Fam, IC){
+ D <- distribution(eval(CallL2Fam(IC)))
+ if(is(L2Fam, "L2LocationFamily") && is(distribution(L2Fam), class(D))){
+ CallL2Fam(IC) <- fam.call(L2Fam)
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+ return(modIC)
+ })
+
+setMethod("getModifyIC", signature(L2FamIC = "L2ScaleFamily",
+ neighbor = "ContNeighborhood", risk = "asGRisk"),
+ function(L2FamIC, neighbor, risk){
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
+ sdneu <- main(L2Fam)
+ sdalt <- main(ICL2Fam)
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+ return(modIC)
+ })
+
+setMethod("getModifyIC", signature(L2FamIC = "L2ScaleFamily",
+ neighbor = "TotalVarNeighborhood", risk = "asGRisk"),
+ function(L2FamIC, neighbor, risk){
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
+ sdneu <- main(L2Fam)
+ sdalt <- main(ICL2Fam)
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = TotalVarNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ blo <- sdneu*clipLo(IC)/sdalt
+ b <- sdneu*clipUp(IC)/sdalt - blo
+ res <- list(A = A, a = blo, b = b, d = NULL,
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = TotalVarNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+ return(modIC)
+ })
+
+setMethod("getModifyIC", signature(L2FamIC = "L2LocationScaleFamily",
+ neighbor = "ContNeighborhood", risk = "asGRisk"),
+ function(L2FamIC, neighbor, risk){
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
+ sdneu <- main(L2Fam)[2]
+ sdalt <- main(ICL2Fam)[2]
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ a <- sdneu*cent(IC)/sdalt
+ mse <- sum(diag(A))
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = mse, asBias = b,
+ trAsCov = mse - r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+ return(modIC)
+ })
Modified: pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- pkg/ROptEst/R/leastFavorableRadius.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/leastFavorableRadius.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -7,7 +7,7 @@
risk = "asGRisk"),
function(L2Fam, neighbor, risk, rho, upRad = 1, z.start = NULL,
A.start = NULL, upper = 100, maxiter = 100,
- tol = .Machine$double.eps^0.4, warn = FALSE){
+ tol = .Machine$double.eps^0.4, warn = FALSE, verbose = FALSE){
if(length(rho) != 1)
stop("'rho' is not of length == 1")
if((rho <= 0)||(rho >= 1))
@@ -40,7 +40,8 @@
resLo <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps, warn = warn)
+ trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ warn = warn, verbose = verbose)
loRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
@@ -58,7 +59,8 @@
resUp <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps, warn = warn)
+ trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps,
+ warn = warn, verbose = verbose)
upRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resUp$b, cent = resUp$a,
@@ -130,7 +132,7 @@
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = MaxIter,
- tol = eps, warn = warn)
+ tol = eps, warn = warn, verbose = verbose)
riskLo <- risk
normtype(riskLo) <- resLo$normtype
loRisk <- getAsRisk(risk = riskLo, L2deriv = L2deriv, neighbor = neighbor,
@@ -161,7 +163,7 @@
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = maxiter,
- tol = tol, warn = warn)
+ tol = tol, warn = warn, verbose = verbose)
riskUp <- risk
normtype(riskUp) <- resUp$normtype
upRisk <- getAsRisk(risk = riskUp, L2deriv = L2deriv, neighbor = neighbor,
Modified: pkg/ROptEst/R/optIC.R
===================================================================
--- pkg/ROptEst/R/optIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/optIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,7 +3,8 @@
###############################################################################
setMethod("optIC", signature(model = "InfRobModel", risk = "asRisk"),
function(model, risk, z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE){
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE,
+ noLow = FALSE, verbose = FALSE){
L2derivDim <- numberOfMaps(model at center@L2deriv)
if(L2derivDim == 1){
ow <- options("warn")
@@ -13,9 +14,12 @@
symm = model at center@L2derivDistrSymm[[1]],
Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
upper = upper, maxiter = maxiter, tol = tol, warn = warn,
- noLow = noLow)
- options(ow)
+ noLow = noLow, verbose = verbose)
+ options(ow)
res$info <- c("optIC", res$info)
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
+ neighbor = model at neighbor,
+ risk = risk))
return(generateIC(model at neighbor, model at center, res))
}else{
if(is(model at center@distribution, "UnivariateDistribution")){
@@ -45,11 +49,15 @@
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
L2derivDistrSymm = L2derivDistrSymm, Finfo = model at center@FisherInfo,
trafo = model at center@param at trafo, z.start = z.start, A.start = A.start,
- upper = upper, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
+ upper = upper, maxiter = maxiter, tol = tol, warn = warn,
+ verbose = verbose)
+ options(ow)
res$info <- c("optIC", res$info)
- return(generateIC(model at neighbor, model at center, res))
- }else{
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
+ neighbor = model at neighbor,
+ risk = risk))
+ return(generateIC(model at neighbor, model at center, res))
+ }else{
stop("not yet implemented")
}
}
@@ -71,11 +79,14 @@
symm = model at center@L2derivDistrSymm[[1]],
Finfo = model at center@FisherInfo, trafo = model at center@param at trafo,
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
+ options(ow)
if(is(model at neighbor, "ContNeighborhood"))
res$info <- c("optIC", "optIC", res$info, "Optimal IC for 'InfRobModel' with 'ContNeighborhood'!!!")
else
- res$info <- c("optIC", res$info)
+ res$info <- c("optIC", res$info)
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
+ neighbor = model at neighbor,
+ risk = risk))
return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
}else{
stop("restricted to 1-dimensional parameteric models")
@@ -88,7 +99,8 @@
###############################################################################
setMethod("optIC", signature(model = "FixRobModel", risk = "fiUnOvShoot"),
function(model, risk, sampleSize, upper = 1e4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A", cont = "left"){
+ tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A",
+ cont = "left", verbose = FALSE){
if(!identical(all.equal(sampleSize, trunc(sampleSize)), TRUE))
stop("'sampleSize' has to be an integer > 0")
if(is(model at center@distribution, "UnivariateDistribution")){
@@ -98,11 +110,14 @@
neighbor = model at neighbor, risk = risk,
sampleSize = sampleSize, upper = upper, maxiter = maxiter,
tol = tol, warn = warn, Algo = Algo, cont = cont)
- options(ow)
+ options(ow)
if(is(model at neighbor, "ContNeighborhood"))
res$info <- c("optIC", "optIC", res$info, "Optimal IC for 'FixRobModel' with 'ContNeighborhood'!!!")
else
- res$info <- c("optIC", res$info)
+ res$info <- c("optIC", res$info)
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
+ neighbor = model at neighbor,
+ risk = risk))
return(generateIC(TotalVarNeighborhood(radius = model at neighbor@radius), model at center, res))
}else{
stop("restricted to 1-dimensional parametric models")
Modified: pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptEst/R/radiusMinimaxIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/R/radiusMinimaxIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,8 +5,9 @@
setMethod("radiusMinimaxIC", signature(L2Fam = "L2ParamFamily",
neighbor = "UncondNeighborhood",
risk = "asGRisk"),
- function(L2Fam, neighbor, risk, loRad, upRad, z.start = NULL, A.start = NULL,
- upper = 1e5, maxiter = 100, tol = .Machine$double.eps^0.4, warn = FALSE){
+ function(L2Fam, neighbor, risk, loRad, upRad, z.start = NULL,
+ A.start = NULL, upper = 1e5, maxiter = 50,
+ tol = .Machine$double.eps^0.4, warn = FALSE, verbose = FALSE){
if(length(loRad) != 1)
stop("'loRad' is not of length == 1")
if(length(upRad) != 1)
@@ -15,10 +16,10 @@
stop("'upRad < loRad' is not fulfilled")
biastype <- biastype(risk)
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
-
+
if(is(normtype(risk),"SelfNorm")||is(normtype(risk),"InfoNorm"))
upRad <- min(upRad,10)
-
+
if(L2derivDim == 1){
ow <- options("warn")
options(warn = -1)
@@ -34,7 +35,8 @@
resLo <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol, warn = warn)
+ trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ warn = warn, verbose = verbose)
loRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
@@ -52,7 +54,8 @@
resUp <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol, warn = warn)
+ trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ warn = warn, verbose = verbose)
upRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
clip = resUp$b, cent = resUp$a,
@@ -70,8 +73,9 @@
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b,
- trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
+ trafo = L2Fam at param@trafo, maxiter = maxiter, tol = tol,
+ warn = warn, verbose = verbose)
+ options(ow)
res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [",
round(loRad, 3), ", ", round(upRad, 3), "]", sep=""))
res$info <- rbind(res$info, c("radiusMinimaxIC",
@@ -79,6 +83,9 @@
res$info <- rbind(res$info, c("radiusMinimaxIC",
paste("maximum ", sQuote(class(risk)[1]), "-inefficiency: ",
round(ineff, 3), sep="")))
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = L2Fam,
+ neighbor = neighbor,
+ risk = risk))
return(generateIC(neighbor, L2Fam, res))
}else{
if(is(L2Fam at distribution, "UnivariateDistribution")){
@@ -109,13 +116,12 @@
p <- nrow(trafo)
FI0 <- trafo%*%solve(Finfo)%*%t(trafo)
FI <- solve(FI0)
-
+
if(is(normtype,"InfoNorm") || is(normtype,"SelfNorm") )
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
normtype(risk) <- normtype}
std <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(p)
-
ow <- options("warn")
options(warn = -1)
upper.b <- upper
@@ -125,7 +131,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
loRisk <- sum(diag(std%*%FI0))
- loNorm <- normtype
+ loNorm <- normtype
}else{
neighbor at radius <- loRad
resLo <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
@@ -133,14 +139,14 @@
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = maxiter,
- tol = tol, warn = warn)
+ tol = tol, warn = warn, verbose = verbose)
riskLo <- risk
normtype(riskLo) <- resLo$normtype
loRisk <- getAsRisk(risk = riskLo, L2deriv = L2deriv,
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
stand = resLo$A, trafo = trafo)[[1]]
- loNorm <- resLo$normtype
+ loNorm <- resLo$normtype
}
if(upRad == Inf){
@@ -150,7 +156,7 @@
Distr = L2Fam at distribution,
DistrSymm = L2Fam at distrSymm,
L2derivSymm = L2derivSymm,
- L2derivDistrSymm= L2derivDistrSymm,
+ L2derivDistrSymm= L2derivDistrSymm,
trafo = trafo, z.start = z.start,
A.start = A.start,
maxiter = maxiter, tol = tol,
@@ -165,27 +171,27 @@
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = maxiter,
- tol = tol, warn = warn)
+ tol = tol, warn = warn, verbose = verbose)
riskUp <- risk
normtype(riskUp) <- resUp$normtype
upRisk <- getAsRisk(risk = riskUp, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = resUp$b, cent = resUp$a, stand = resUp$A, trafo = trafo)[[1]]
- upNorm <- resUp$normtype
+ upNorm <- resUp$normtype
}
leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
z.start = z.start, A.start = A.start, upper.b = upper.b, risk = risk,
loRad = loRad, upRad = upRad, loRisk = loRisk, upRisk = upRisk,
eps = tol, MaxIter = maxiter, warn = warn,
- loNorm = loNorm, upNorm = upNorm)$root
+ loNorm = loNorm, upNorm = upNorm, verbose = verbose)$root
neighbor at radius <- leastFavR
res <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
Distr = L2Fam at distribution, DistrSymm = L2Fam at distrSymm,
L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start,
A.start = A.start, upper = upper.b, maxiter = maxiter,
- tol = tol, warn = warn)
- options(ow)
+ tol = tol, warn = warn, verbose = verbose)
+ options(ow)
res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [",
round(loRad, 3), ", ", round(upRad, 3), "]", sep=""))
res$info <- rbind(res$info, c("radiusMinimaxIC",
@@ -193,6 +199,9 @@
res$info <- rbind(res$info, c("radiusMinimaxIC",
paste("maximum ", sQuote(class(risk)[1]), "-inefficiency: ",
round(ineff, 3), sep="")))
+ res <- c(res, modifyIC = getModifyIC(L2FamIC = L2Fam,
+ neighbor = neighbor,
+ risk = risk))
return(generateIC(neighbor, L2Fam, res))
}else{
stop("not yet implemented")
Copied: pkg/ROptEst/R/roptest.R (from rev 157, branches/robast-0.6/pkg/ROptEst/R/roptest.R)
===================================================================
--- pkg/ROptEst/R/roptest.R (rev 0)
+++ pkg/ROptEst/R/roptest.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,85 @@
+###############################################################################
+## Optimally robust estimation
+###############################################################################
+roptest <- function(x, L2Fam, eps, eps.lower, eps.upper, initial.est,
+ neighbor = ContNeighborhood(), risk = asMSE(), steps = 1,
+ distance = CvMDist, startPar = NULL, verbose = FALSE,
+ useLast = getRobAStBaseOption("kStepUseLast"), ...){
+ es.call <- match.call()
+ if(missing(x))
+ stop("'x' is missing with no default")
+ if(missing(L2Fam))
+ stop("'L2Fam' is missing with no default")
+ if(!is.numeric(x)){
+ if(is.data.frame(x))
+ x <- data.matrix(x)
+ else
+ x <- as.matrix(x)
+ if(!is.matrix(x))
+ stop("'x' has to be a numeric vector resp. a matrix or data.frame")
+ }
+ if(missing(eps) && missing(eps.lower) && missing(eps.upper)){
+ eps.lower <- 0
+ eps.upper <- 0.5
+ }
+ if(missing(eps)){
+ if(!missing(eps.lower) && missing(eps.upper))
+ eps.upper <- 0.5
+ if(missing(eps.lower) && !missing(eps.upper))
+ eps.lower <- 0
+ if(length(eps.lower) != 1 || length(eps.upper) != 1)
+ stop("'eps.lower' and 'eps.upper' have to be of length 1")
+ if(!is.numeric(eps.lower) || !is.numeric(eps.upper) || eps.lower >= eps.upper)
+ stop("'eps.lower' < 'eps.upper' is not fulfilled")
+ if((eps.lower < 0) || (eps.upper > 0.5))
+ stop("'eps.lower' and 'eps.upper' have to be in [0, 0.5]")
+ }else{
+ if(length(eps) != 1)
+ stop("'eps' has to be of length 1")
+ if(eps == 0)
+ stop("'eps = 0'! => use functions 'mean' and 'sd' for estimation")
+ if((eps < 0) || (eps > 0.5))
+ stop("'eps' has to be in (0, 0.5]")
+ }
+ if(!is.integer(steps))
+ steps <- as.integer(steps)
+ if(steps < 1){
+ stop("'steps' has to be some positive integer value")
+ }
+ if(length(steps) != 1){
+ stop("'steps' has to be of length 1")
+ }
+
+ if(missing(initial.est))
+ initial.est <- MDEstimator(x = x, ParamFamily = L2Fam, distance = distance,
+ startPar = startPar, ...)
+ if(is(initial.est, "Estimate")) initial.est <- estimate(initial.est)
+ newParam <- param(L2Fam)
+ main(newParam) <- initial.est
+ L2FamStart <- modifyModel(L2Fam, newParam)
+ if(is.matrix(x))
+ sqrtn <- sqrt(ncol(x))
+ else
+ sqrtn <- sqrt(length(x))
+ if(missing(eps)){
+ r.lower <- sqrtn*eps.lower
+ r.upper <- sqrtn*eps.upper
+ ICstart <- radiusMinimaxIC(L2Fam = L2FamStart, neighbor = neighbor, risk = risk,
+ loRad = r.lower, upRad = r.upper, verbose = verbose)
+ }else{
+ r <- sqrtn*eps
+ neighbor at radius <- r
+ infMod <- InfRobModel(center = L2FamStart, neighbor = neighbor)
+ ICstart <- optIC(model = infMod, risk = risk, verbose = verbose)
+ }
+ res <- kStepEstimator(x, IC = ICstart, start = initial.est, steps = steps, useLast = useLast)
+ res at estimate.call <- es.call
+ Infos <- matrix(c("roptest",
+ paste(steps, "-step estimate for ", name(L2Fam), sep = "")),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ Infos <- rbind(Infos, c("roptest",
+ paste("computation of IC, asvar and asbias via useLast =", useLast)))
+ Infos(res) <- Infos
+ return(res)
+}
Modified: pkg/ROptEst/chm/00Index.html
===================================================================
--- pkg/ROptEst/chm/00Index.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/chm/00Index.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -286,6 +286,8 @@
<td>Generic function for the computation of the radius minimax IC</td></tr>
<tr><td width="25%"><a href="radiusMinimaxIC.html">radiusMinimaxIC-methods</a></td>
<td>Generic function for the computation of the radius minimax IC</td></tr>
+<tr><td width="25%"><a href="roptest.html">roptest</a></td>
+<td>Optimally robust estimation </td></tr>
</table>
<h2><a name="U">-- U --</a></h2>
Modified: pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: pkg/ROptEst/chm/ROptEst.hhp
===================================================================
--- pkg/ROptEst/chm/ROptEst.hhp 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/chm/ROptEst.hhp 2008-08-10 16:49:24 UTC (rev 159)
@@ -33,4 +33,5 @@
optIC.html
optRisk.html
radiusMinimaxIC.html
+roptest.html
updateNorm-methods.html
Modified: pkg/ROptEst/chm/ROptEst.toc
===================================================================
--- pkg/ROptEst/chm/ROptEst.toc 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/chm/ROptEst.toc 2008-08-10 16:49:24 UTC (rev 159)
@@ -490,6 +490,10 @@
<param name="Local" value="radiusMinimaxIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="roptest">
+<param name="Local" value="roptest.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="updateNorm">
<param name="Local" value="updateNorm-methods.html">
</OBJECT>
@@ -582,6 +586,10 @@
<param name="Name" value="Methods for Function updateNorm in Package `ROptEst' ">
<param name="Local" value="updateNorm-methods.html">
</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Optimally robust estimation ">
+<param name="Local" value="roptest.html">
+</OBJECT>
</UL>
</UL>
</BODY></HTML>
Modified: pkg/ROptEst/chm/getAsRisk.html
===================================================================
--- pkg/ROptEst/chm/getAsRisk.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/chm/getAsRisk.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -165,6 +165,14 @@
object of class <code>"NormType"</code>. </td></tr>
</table>
+<h3>Details</h3>
+
+<p>
+This function is rarely called directly. It is used by
+other functions/methods.
+</p>
+
+
<h3>Value</h3>
<p>
Modified: pkg/ROptEst/chm/getBiasIC.html
===================================================================
--- pkg/ROptEst/chm/getBiasIC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/chm/getBiasIC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -49,6 +49,14 @@
additional parameters </td></tr>
</table>
+<h3>Details</h3>
+
+<p>
+This function is rarely called directly. It is used by
+other functions/methods.
+</p>
+
+
<h3>Value</h3>
<p>
Modified: pkg/ROptEst/inst/scripts/BinomialModel.R
===================================================================
--- pkg/ROptEst/inst/scripts/BinomialModel.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/inst/scripts/BinomialModel.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -103,30 +103,152 @@
risk=asMSE(), rho=0.5))
r.rho2
+
+###############################################################################
+## k-step (k >= 1) estimation
+###############################################################################
+
## one-step estimation
## 1. generate a contaminated sample
ind <- rbinom(100, size=1, prob=0.05)
x <- rbinom(100, size=25, prob=(1-ind)*0.25 + ind*0.75)
## 2. Kolmogorov(-Smirnov) minimum distance estimator
-(est0 <- MDEstimator(x=x, BinomFamily(size=25), interval = c(0, 1)))
+(est0 <- MDEstimator(x=x, BinomFamily(size=25)))
-## 3. one-step estimation: radius known
-RobB3 <- InfRobModel(center=BinomFamily(size=25, prob=est0$estimate),
- neighbor=ContNeighborhood(radius=0.5))
+## 3.1. one-step estimation: radius known
+## ac) Define infinitesimal robust model
+RobB3 <- InfRobModel(center=BinomFamily(size=25, prob=estimate(est0)),
+ neighbor=ContNeighborhood(radius=0.5))
+## bc) Compute optimally robust IC
IC9 <- optIC(model=RobB3, risk=asMSE())
-(est1c <- oneStepEstimator(x, IC=IC9, start=est0$estimate))
+checkIC(IC9)
+## cc) Determine 1-step estimate
+(est1c <- oneStepEstimator(x, IC=IC9, start=est0))
-RobB4 <- InfRobModel(center=BinomFamily(size=25, prob=est0$estimate),
+## instead of ac)-cc) you can also use function roptest
+est1c1 <- roptest(x, BinomFamily(size = 25), eps = 0.05, initial.est = est0)
+checkIC(pIC(est1c1))
+## you can also omit step 2
+est1c2 <- roptest(x, BinomFamily(size = 25), eps = 0.05, distance = KolmogorovDist)
+checkIC(pIC(est1c2))
+
+## Using Cramer-von-Mises MD estimator (default)
+est1c3 <- roptest(x, BinomFamily(size = 25), eps = 0.025)
+checkIC(pIC(est1c3))
+
+## comparison of estimates
+estimate(est1c)
+estimate(est1c1)
+estimate(est1c2)
+estimate(est1c3)
+
+
+## av) Define infinitesimal robust model
+RobB4 <- InfRobModel(center=BinomFamily(size=25, prob=estimate(est0)),
neighbor=TotalVarNeighborhood(radius=0.25))
+## bv) Compute optimally robust IC
IC10 <- optIC(model=RobB4, risk=asMSE())
-(est1v <- oneStepEstimator(x, IC=IC10, start=est0$estimate))
+checkIC(IC10)
+## cv) Determine 1-step estimate
+(est1v <- oneStepEstimator(x, IC=IC10, start=est0))
-## 4. one-step estimation: radius interval
-IC11 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=est0$estimate),
+## instead of av)-cv) you can also use function roptest
+est1v1 <- roptest(x, BinomFamily(size = 25), eps = 0.025, initial.est = est0,
+ neighbor = TotalVarNeighborhood())
+checkIC(pIC(est1v1))
+## you can also omit step 2
+est1v2 <- roptest(x, BinomFamily(size = 25), eps = 0.025,
+ neighbor = TotalVarNeighborhood(), distance = KolmogorovDist)
+checkIC(pIC(est1v2))
+
+## Using Cramer-von-Mises MD estimator (default)
+est1v3 <- roptest(x, BinomFamily(size = 25), eps = 0.025, neighbor = TotalVarNeighborhood())
+checkIC(pIC(est1v3))
+
+## comparison of estimates
+estimate(est1v)
+estimate(est1v1)
+estimate(est1v2)
+estimate(est1v3)
+
+## 3.2. k-step estimation: radius known
+IC9 <- optIC(model=RobB3, risk=asMSE())
+(est2c <- kStepEstimator(x, IC=IC9, start=est0, steps = 3L))
+
+est2c1 <- roptest(x, BinomFamily(size = 25), eps = 0.05, initial.est = est0, steps = 3L)
+checkIC(pIC(est2c1))
+
+est2c2 <- roptest(x, BinomFamily(size = 25), eps = 0.05, steps = 3L,
+ distance = KolmogorovDist)
+checkIC(pIC(est2c2))
+
+## Using Cramer-von-Mises MD estimator
+est2c3 <- roptest(x, BinomFamily(size = 25), eps = 0.05, steps = 3L)
+checkIC(pIC(est2c3))
+
+## comparison of estimates
+estimate(est2c)
+estimate(est2c1)
+estimate(est2c2)
+estimate(est2c3)
+
+
+IC10 <- optIC(model=RobB4, risk=asMSE())
+(est2v <- kStepEstimator(x, IC=IC10, start=est0, steps = 3L))
+checkIC(pIC(est2v))
+
+est2v1 <- roptest(x, BinomFamily(size = 25), eps = 0.025, initial.est = est0,
+ steps = 3L, neighbor = TotalVarNeighborhood())
+checkIC(pIC(est2v1))
+
+est2v2 <- roptest(x, BinomFamily(size = 25), eps = 0.025, steps = 3L,
+ distance = KolmogorovDist, neighbor = TotalVarNeighborhood())
+checkIC(pIC(est2v2))
+
+## Using Cramer-von-Mises MD estimator
+est2v3 <- roptest(x, BinomFamily(size = 25), eps = 0.025, steps = 3L,
+ neighbor = TotalVarNeighborhood())
+checkIC(pIC(est2v3))
+
+## comparison of estimates
+estimate(est2v)
+estimate(est2v1)
+estimate(est2v2)
+estimate(est2v3)
+
+
+## 4.1. one-step estimation: radius interval
+IC11 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=estimate(est0)),
neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
-(est2c <- oneStepEstimator(x, IC=IC11, start=est0$estimate))
+(est3c <- oneStepEstimator(x, IC=IC11, start=est0))
+checkIC(pIC(est3c))
-IC12 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=est0$estimate),
+IC12 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=estimate(est0)),
neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
-(est2v <- oneStepEstimator(x, IC=IC12, start=est0$estimate))
+(est3v <- oneStepEstimator(x, IC=IC12, start=est0))
+checkIC(pIC(est3v))
+
+## maximum radius for given sample size n: sqrt(n)*0.5
+(est3c1 <- roptest(x, BinomFamily(size = 25), eps.upper = 0.5))
+checkIC(pIC(est3c1))
+(est3v1 <- roptest(x, BinomFamily(size = 25), eps.upper = 0.5, neighbor = TotalVarNeighborhood()))
+checkIC(pIC(est3v1))
+
+## 4.2. k-step estimation: radius interval
+IC11 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=estimate(est0)),
+ neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
+(est4c <- kStepEstimator(x, IC=IC11, start=est0, steps = 3L))
+checkIC(pIC(est4c))
+
+IC12 <- radiusMinimaxIC(L2Fam=BinomFamily(size=25, prob=estimate(est0)),
+ neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
+(est4v <- kStepEstimator(x, IC=IC12, start=est0, steps = 3L))
+checkIC(pIC(est4v))
+
+## maximum radius for given sample size n: sqrt(n)*0.5
+(est4c1 <- roptest(x, BinomFamily(size = 25), eps.upper = 0.5, steps = 3L))
+checkIC(pIC(est4c1))
+(est4v1 <- roptest(x, BinomFamily(size = 25), eps.upper = 0.5, neighbor = TotalVarNeighborhood(),
+ steps = 3L))
+checkIC(pIC(est4v1))
Modified: pkg/ROptEst/inst/scripts/ExponentialScaleModel.R
===================================================================
--- pkg/ROptEst/inst/scripts/ExponentialScaleModel.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/inst/scripts/ExponentialScaleModel.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,8 +3,8 @@
###############################################################################
require(ROptEst)
-## generates Exponential Scale Family with rate = 2
-E1 <- ExpScaleFamily(rate = 2)
+## generates Exponential Scale Family with scale = 0.5 (rate = 2)
+E1 <- ExpScaleFamily(scale = 0.5)
E1 # show E1
plot(E1) # plot of Exp(rate = 1) and L_2 derivative
checkL2deriv(E1)
@@ -74,13 +74,13 @@
E1.x <- rexp(1e2, rate=(1-ind)*2+ind*10)
## 2. Kolmogorov(-Smirnov) minimum distance estimator
-(E1.est0 <- MDEstimator(x=E1.x, ExpScaleFamily(), interval = c(0, 10)))
+(E1.est0 <- MDEstimator(x=E1.x, ExpScaleFamily()))
## 3. one-step estimation: radius known
-E1.Rob3 <- InfRobModel(center=ExpScaleFamily(rate=1/E1.est0$estimate),
+E1.Rob3 <- InfRobModel(center=ExpScaleFamily(scale=estimate(E1.est0)),
neighbor=ContNeighborhood(radius=0.5))
E1.IC9 <- optIC(model=E1.Rob3, risk=asMSE())
-(E1.est1 <- oneStepEstimator(E1.x, IC=E1.IC9, start=E1.est0$estimate))
+(E1.est1 <- oneStepEstimator(E1.x, IC=E1.IC9, start=E1.est0))
## 4. one-step estimation: radius interval
E1.IC10 <- radiusMinimaxIC(L2Fam=ExpScaleFamily(rate=1/E1.est0$estimate),
Modified: pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
===================================================================
--- pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,10 +3,10 @@
###############################################################################
require(ROptEst)
-## generates normal location and scale family with mean = 0 and sd = 1
-N0 <- NormLocationScaleFamily(mean=0, sd=1)
+## generates normal location and scale family with mean = -2 and sd = 3
+N0 <- NormLocationScaleFamily(mean=-2, sd=3)
N0 # show G0
-plot(N0) # plot of Norm(mean = 0, sd = 1) and L_2 derivative
+plot(N0) # plot of Norm(mean = -2, sd = 3) and L_2 derivative
checkL2deriv(N0)
## classical optimal IC
@@ -64,7 +64,7 @@
## radius minimax IC
## (may take quite some time!)
-(N0.IC4 <- radiusMinimaxIC(L2Fam=N0, neighbor=ContNeighborhood(),
+system.time(N0.IC4 <- radiusMinimaxIC(L2Fam=N0, neighbor=ContNeighborhood(),
risk=asMSE(), loRad=0, upRad=Inf))
checkIC(N0.IC4)
Risks(N0.IC4)
@@ -100,13 +100,13 @@
## 2. Kolmogorov(-Smirnov) minimum distance estimator
(est0 <- MDEstimator(x=x, NormLocationScaleFamily()))
-## 3. one-step estimation: radius known
-N1 <- NormLocationScaleFamily(mean=est0$estimate[1], sd=est0$estimate[2])
+## 3. k-step estimation: radius known
+N1 <- NormLocationScaleFamily(mean=estimate(est0)[1], sd=estimate(est0)[2])
N1.Rob <- InfRobModel(center = N1, neighbor = ContNeighborhood(radius = 0.5))
IC1 <- optIC(model = N1.Rob, risk = asMSE())
-(est1 <- oneStepEstimator(x, IC1, est0$estimate))
+(est1 <- kStepEstimator(x, IC1, est0, steps = 3))
-## 4. one-step estimation: radius unknown
+## 4. k-step estimation: radius unknown
## rough estimate: 1-10% contamination
## => r\in[0.1,1.0]
Modified: pkg/ROptEst/inst/scripts/PoissonModel.R
===================================================================
--- pkg/ROptEst/inst/scripts/PoissonModel.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/inst/scripts/PoissonModel.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -123,20 +123,141 @@
rep(5, 408), rep(6, 273), rep(7, 139), rep(8, 45), rep(9, 27),
rep(10, 10), rep(11, 4), rep(12, 0), rep(13, 1), rep(14, 1))
-## 0. mean (classical optimal)
+## 0. ML-estimator (mean)
(est0 <- mean(x))
-## 1. Kolmogorov(-Smirnov) minimum distance estimator
-(est1 <- MDEstimator(x=x, PoisFamily(), interval = c(0, 10)))
+## with distrMod
+MLEstimator(x, PoisFamily())
-## 2. one-step estimation: radius interval
+## with MASS
+library(MASS)
+fitdistr(x, densfun = "Poisson")
+
+## 1.1. Kolmogorov(-Smirnov) minimum distance estimator
+(est11 <- MDEstimator(x=x, PoisFamily()))
+
+## 1.2. Cramer von Mises minimum distance estimator
+(est12 <- MDEstimator(x=x, PoisFamily(), distance = CvMDist))
+
+## 2. k-step estimation: contamination neighborhood
## 2.1 small amount of contamination < 2%
-IC9 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=est1$estimate),
+IC9 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est11)),
neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=1)
-(est21 <- oneStepEstimator(x, IC=IC9, start=est1$estimate))
+IC10 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est12)),
+ neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=1)
+(est211 <- kStepEstimator(x, IC=IC9, start=est11, steps = 1L))
+## one could also use function oneStepEstimator
+oneStepEstimator(x, IC=IC9, start=est11)
+checkIC(pIC(est211))
+
+(est212 <- kStepEstimator(x, IC=IC9, start=est11, steps = 3L))
+checkIC(pIC(est212))
+
+(est213 <- kStepEstimator(x, IC=IC10, start=est12, steps = 1L))
+checkIC(pIC(est213))
+
+(est214 <- kStepEstimator(x, IC=IC10, start=est12, steps = 3L))
+checkIC(pIC(est214))
+
+(est215 <- roptest(x, PoisFamily(), eps.upper = 1/sqrt(length(x)), steps = 3L))
+checkIC(pIC(est215))
+
+## comparision of estimates
+estimate(est211)
+estimate(est212)
+estimate(est213)
+estimate(est214)
+estimate(est215)
+
+
## 2.2 amount of contamination unknown
-IC10 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=est1$estimate),
+IC11 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est11)),
neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
-(est22 <- oneStepEstimator(x, IC=IC10, start=est1$estimate))
+IC12 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est12)),
+ neighbor=ContNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
+(est221 <- oneStepEstimator(x, IC=IC11, start=est11))
+kStepEstimator(x, IC=IC11, start=est11)
+checkIC(pIC(est221))
+(est222 <- kStepEstimator(x, IC=IC11, start=est11, steps = 3L))
+checkIC(pIC(est222))
+
+(est223 <- kStepEstimator(x, IC=IC12, start=est12, steps = 1L))
+checkIC(pIC(est223))
+
+(est224 <- kStepEstimator(x, IC=IC12, start=est12, steps = 3L))
+checkIC(pIC(est224))
+
+(est225 <- roptest(x, PoisFamily(), eps.upper = 0.5, steps = 3L))
+checkIC(pIC(est225))
+
+## comparision of estimates
+estimate(est221)
+estimate(est222)
+estimate(est223)
+estimate(est224)
+estimate(est225)
+
+
+## 3. k-step estimation: total variation neighborhood
+## 3.1 small amount of contamination < 2%
+IC13 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est11)),
+ neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=1)
+IC14 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est12)),
+ neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=1)
+(est311 <- kStepEstimator(x, IC=IC13, start=est11, steps = 1L))
+## one could also use function oneStepEstimator
+oneStepEstimator(x, IC=IC13, start=est11)
+checkIC(pIC(est311))
+
+(est312 <- kStepEstimator(x, IC=IC13, start=est11, steps = 3L))
+checkIC(pIC(est312))
+
+(est313 <- kStepEstimator(x, IC=IC14, start=est12, steps = 1L))
+checkIC(pIC(est313))
+
+(est314 <- kStepEstimator(x, IC=IC14, start=est12, steps = 3L))
+checkIC(pIC(est314))
+
+(est315 <- roptest(x, PoisFamily(), eps.upper = 1/sqrt(length(x)), steps = 3L,
+ neighbor = TotalVarNeighborhood()))
+checkIC(pIC(est315))
+
+## comparison of estimates
+estimate(est311)
+estimate(est312)
+estimate(est313)
+estimate(est314)
+estimate(est315)
+
+
+## 3.2 amount of contamination unknown
+IC15 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est11)),
+ neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
+IC16 <- radiusMinimaxIC(L2Fam=PoisFamily(lambda=estimate(est12)),
+ neighbor=TotalVarNeighborhood(), risk=asMSE(), loRad=0, upRad=Inf)
+(est321 <- oneStepEstimator(x, IC=IC15, start=est11))
+kStepEstimator(x, IC=IC15, start=est11)
+checkIC(pIC(est321))
+
+(est322 <- kStepEstimator(x, IC=IC15, start=est11, steps = 3L))
+checkIC(pIC(est322))
+
+(est323 <- kStepEstimator(x, IC=IC16, start=est12, steps = 1L))
+checkIC(pIC(est323))
+
+(est324 <- kStepEstimator(x, IC=IC16, start=est12, steps = 3L))
+checkIC(pIC(est324))
+
+(est325 <- roptest(x, PoisFamily(), eps.upper = 0.5, steps = 3L,
+ neighbor = TotalVarNeighborhood()))
+checkIC(pIC(est325))
+
+## comparision of estimates
+estimate(est321)
+estimate(est322)
+estimate(est323)
+estimate(est324)
+estimate(est325)
+
distroptions("TruncQuantile", 1e-5) # default
Modified: pkg/ROptEst/man/getAsRisk.Rd
===================================================================
--- pkg/ROptEst/man/getAsRisk.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getAsRisk.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -25,35 +25,49 @@
\usage{
getAsRisk(risk, L2deriv, neighbor, biastype, ...)
-\S4method{getAsRisk}{asMSE,UnivariateDistribution,Neighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand, trafo)
+\S4method{getAsRisk}{asMSE,UnivariateDistribution,Neighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand, trafo)
-\S4method{getAsRisk}{asMSE,EuclRandVariable,Neighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand, trafo)
+\S4method{getAsRisk}{asMSE,EuclRandVariable,Neighborhood,ANY}(risk, L2deriv, neighbor,
+ biastype, clip, cent, stand, trafo)
-\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, trafo)
+\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, trafo)
-\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,onesidedBias}(risk, L2deriv, neighbor, biastype, trafo)
+\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,onesidedBias}(risk,
+ L2deriv, neighbor, biastype, trafo)
-\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,asymmetricBias}(risk, L2deriv, neighbor, biastype, trafo)
+\S4method{getAsRisk}{asBias,UnivariateDistribution,ContNeighborhood,asymmetricBias}(risk,
+ L2deriv, neighbor, biastype, trafo)
-\S4method{getAsRisk}{asBias,UnivariateDistribution,TotalVarNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, trafo)
+\S4method{getAsRisk}{asBias,UnivariateDistribution,TotalVarNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, trafo)
-\S4method{getAsRisk}{asBias,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, trafo, z.start, A.start, maxiter, tol, warn)
+\S4method{getAsRisk}{asBias,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor,
+ biastype, Distr, DistrSymm, L2derivSymm, L2derivDistrSymm,
+ trafo, z.start, A.start, maxiter, tol, warn)
-\S4method{getAsRisk}{asCov,UnivariateDistribution,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand)
+\S4method{getAsRisk}{asCov,UnivariateDistribution,ContNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand)
-\S4method{getAsRisk}{asCov,UnivariateDistribution,TotalVarNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand)
+\S4method{getAsRisk}{asCov,UnivariateDistribution,TotalVarNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand)
-\S4method{getAsRisk}{asCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand)
+\S4method{getAsRisk}{asCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor,
+ biastype, Distr, cent, stand,
+ V.comp = matrix(TRUE, ncol = nrow(stand), nrow = nrow(stand)), w)
-\S4method{getAsRisk}{trAsCov,UnivariateDistribution,UncondNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand)
+\S4method{getAsRisk}{trAsCov,UnivariateDistribution,UncondNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand)
-\S4method{getAsRisk}{trAsCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, normtype)
+\S4method{getAsRisk}{trAsCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor,
+ biastype, Distr, clip, cent, stand, normtype)
-\S4method{getAsRisk}{asUnOvShoot,UnivariateDistribution,UncondNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand, trafo)
+\S4method{getAsRisk}{asUnOvShoot,UnivariateDistribution,UncondNeighborhood,ANY}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand, trafo)
-\S4method{getAsRisk}{asSemivar,UnivariateDistribution,Neighborhood,onesidedBias}(risk, L2deriv, neighbor, biastype,
- clip, cent, stand, trafo)
+\S4method{getAsRisk}{asSemivar,UnivariateDistribution,Neighborhood,onesidedBias}(risk, L2deriv,
+ neighbor, biastype, clip, cent, stand, trafo)
}
\arguments{
\item{risk}{ object of class \code{"asRisk"}. }
@@ -76,8 +90,12 @@
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
\item{normtype}{ object of class \code{"NormType"}. }
+ \item{V.comp}{ matrix: indication which components of the standardizing
+ matrix have to be computed. }
+ \item{w}{object of class \code{RobWeight}; current weight}
}
-%\details{}
+\details{ This function is rarely called directly. It is used by
+ other functions/methods. }
\value{The asymptotic risk is computed.}
\section{Methods}{
\describe{
@@ -147,4 +165,4 @@
%\examples{}
\concept{asymptotic risk}
\concept{risk}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getBiasIC.Rd
===================================================================
--- pkg/ROptEst/man/getBiasIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getBiasIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -11,7 +11,7 @@
\usage{
getBiasIC(IC, neighbor, ...)
-\S4method{getBiasIC}{HampIC,UncondNeighborhood}(IC, neighbor, L2Fam)
+\S4method{getBiasIC}{HampIC,UncondNeighborhood}(IC, neighbor, L2Fam, ...)
}
\arguments{
\item{IC}{ object of class \code{"InfluenceCurve"} }
@@ -19,7 +19,8 @@
\item{L2Fam}{ object of class \code{"L2ParamFamily"}. }
\item{\dots}{ additional parameters }
}
-\details{}
+\details{ This function is rarely called directly. It is used by
+ other functions/methods. }
\value{The bias of the IC is computed.}
\section{Methods}{
\describe{
@@ -45,4 +46,4 @@
\seealso{\code{\link{getRiskIC-methods}}, \code{\link[RobAStBase]{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getFiRisk.Rd
===================================================================
--- pkg/ROptEst/man/getFiRisk.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getFiRisk.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -60,4 +60,4 @@
%\examples{}
\concept{finite-sample risk}
\concept{risk}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getFixClip.Rd
===================================================================
--- pkg/ROptEst/man/getFixClip.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getFixClip.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -46,4 +46,4 @@
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getFixRobIC.Rd
===================================================================
--- pkg/ROptEst/man/getFixRobIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getFixRobIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -28,7 +28,12 @@
\item{Algo}{ "A" or "B". }
\item{cont}{ "left" or "right". }
}
-%\details{}
+\details{
+Computation of the optimally robust IC in sense of Huber (1968) which
+is also treated in Kohl (2005). The Algorithm used to compute the exact
+finite sample risk is introduced and explained in Kohl (2005). It is
+based on FFT.
+}
\value{The optimally robust IC is computed.}
\section{Methods}{
\describe{
@@ -40,6 +45,8 @@
Huber, P.J. (1968) Robust Confidence Limits. Z. Wahrscheinlichkeitstheor.
Verw. Geb. \bold{10}:269--278.
+ Rieder, H. (1980) Estimates derived from robust tests. Ann. Stats. \bold{8}: 106-115.
+
Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
Bayreuth: Dissertation.
}
@@ -48,4 +55,4 @@
\seealso{\code{\link[RobAStBase]{FixRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getIneffDiff.Rd
===================================================================
--- pkg/ROptEst/man/getIneffDiff.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getIneffDiff.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -15,7 +15,7 @@
\S4method{getIneffDiff}{numeric,L2ParamFamily,UncondNeighborhood,asMSE}(
radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk,
z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
- loNorm = NULL, upNorm = NULL)
+ loNorm = NULL, upNorm = NULL, verbose = FALSE)
}
\arguments{
\item{radius}{ neighborhood radius. }
@@ -39,6 +39,7 @@
\item{upNorm}{object of class \code{"NormType"}; used in selfstandardization
to evaluate the bias of the current IC in the norm of the upper
bound}
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
}
%\details{}
\value{The inefficieny difference between the left and
@@ -52,6 +53,9 @@
the boundaries of a given radius interval.}
}}
\references{
+ Rieder, H., Kohl, M. and Ruckdeschel, P. (2008) The Costs of not Knowing
+ the Radius. Statistical Methods and Applications, \emph{17}(1) 13-40.
+
Rieder, H., Kohl, M. and Ruckdeschel, P. (2001) The Costs of not Knowing
the Radius. Submitted. Appeared as discussion paper Nr. 81.
SFB 373 (Quantification and Simulation of Economic Processes),
@@ -65,4 +69,4 @@
%\note{}
\seealso{\code{\link{radiusMinimaxIC}}, \code{\link{leastFavorableRadius}}}
%\examples{}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfCent.Rd
===================================================================
--- pkg/ROptEst/man/getInfCent.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfCent.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -25,7 +25,7 @@
neighbor, biastype, clip, cent, tol.z, symm, trafo)
\S4method{getInfCent}{RealRandVariable,ContNeighborhood,BiasType}(L2deriv,
- neighbor, biastype, z.comp, stand, cent, clip, w)
+ neighbor, biastype, Distr, z.comp, w)
\S4method{getInfCent}{UnivariateDistribution,ContNeighborhood,onesidedBias}(L2deriv,
neighbor, biastype, clip, cent, tol.z, symm, trafo)
@@ -41,10 +41,10 @@
\item{\dots}{ additional parameters. }
\item{clip}{ optimal clipping bound. }
\item{cent}{ optimal centering constant. }
- \item{stand}{ standardizing matrix. }
\item{tol.z}{ the desired accuracy (convergence tolerance). }
\item{symm}{ logical: indicating symmetry of \code{L2deriv}. }
\item{trafo}{ matrix: transformation of the parameter. }
+ \item{Distr}{object of class \code{Distribution}. }
\item{z.comp}{ logical vector: indication which components of the
centering constant have to be computed. }
\item{w}{object of class \code{RobWeight}; current weight}
@@ -83,4 +83,4 @@
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfClip.Rd
===================================================================
--- pkg/ROptEst/man/getInfClip.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfClip.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -16,15 +16,20 @@
\usage{
getInfClip(clip, L2deriv, risk, neighbor, ...)
-\S4method{getInfClip}{numeric,UnivariateDistribution,asMSE,ContNeighborhood}(clip, L2deriv, risk, neighbor, biastype, cent, symm, trafo)
+\S4method{getInfClip}{numeric,UnivariateDistribution,asMSE,ContNeighborhood}(clip, L2deriv,
+ risk, neighbor, biastype, cent, symm, trafo)
-\S4method{getInfClip}{numeric,UnivariateDistribution,asMSE,TotalVarNeighborhood}(clip, L2deriv, risk, neighbor, biastype, cent, symm, trafo)
+\S4method{getInfClip}{numeric,UnivariateDistribution,asMSE,TotalVarNeighborhood}(clip, L2deriv,
+ risk, neighbor, biastype, cent, symm, trafo)
-\S4method{getInfClip}{numeric,EuclRandVariable,asMSE,ContNeighborhood}(clip, L2deriv, risk, neighbor, Distr, stand, biastype, cent, trafo)
+\S4method{getInfClip}{numeric,EuclRandVariable,asMSE,ContNeighborhood}(clip, L2deriv, risk,
+ neighbor, biastype, Distr, stand, cent, trafo)
-\S4method{getInfClip}{numeric,UnivariateDistribution,asUnOvShoot,UncondNeighborhood}(clip, L2deriv, risk, neighbor, biastype, cent, symm, trafo)
+\S4method{getInfClip}{numeric,UnivariateDistribution,asUnOvShoot,UncondNeighborhood}(clip, L2deriv,
+ risk, neighbor, biastype, cent, symm, trafo)
-\S4method{getInfClip}{numeric,UnivariateDistribution,asSemivar,ContNeighborhood}(clip, L2deriv, risk, neighbor, cent, symm, trafo)
+\S4method{getInfClip}{numeric,UnivariateDistribution,asSemivar,ContNeighborhood}(clip, L2deriv,
+ risk, neighbor, cent, symm, trafo)
}
\arguments{
\item{clip}{ positive real: clipping bound }
@@ -82,4 +87,4 @@
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfGamma.Rd
===================================================================
--- pkg/ROptEst/man/getInfGamma.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfGamma.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -100,4 +100,4 @@
\code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfRobIC.Rd
===================================================================
--- pkg/ROptEst/man/getInfRobIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfRobIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -21,30 +21,30 @@
\usage{
getInfRobIC(L2deriv, risk, neighbor, ...)
-\S4method{getInfRobIC}{UnivariateDistribution,asCov,ContNeighborhood}(L2deriv, risk, neighbor, Finfo, trafo)
+\S4method{getInfRobIC}{UnivariateDistribution,asCov,ContNeighborhood}(L2deriv, risk, neighbor, Finfo, trafo, verbose = FALSE)
-\S4method{getInfRobIC}{UnivariateDistribution,asCov,TotalVarNeighborhood}(L2deriv, risk, neighbor, Finfo, trafo)
+\S4method{getInfRobIC}{UnivariateDistribution,asCov,TotalVarNeighborhood}(L2deriv, risk, neighbor, Finfo, trafo, verbose = FALSE)
\S4method{getInfRobIC}{RealRandVariable,asCov,ContNeighborhood}(L2deriv, risk, neighbor, Distr, Finfo, trafo,
- QuadForm = diag(nrow(trafo)))
+ QuadForm = diag(nrow(trafo)), verbose = FALSE)
\S4method{getInfRobIC}{UnivariateDistribution,asBias,UncondNeighborhood}(L2deriv, risk, neighbor, symm, trafo,
- maxiter, tol, warn, Finfo)
+ maxiter, tol, warn, Finfo, verbose = FALSE, ...)
\S4method{getInfRobIC}{RealRandVariable,asBias,ContNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol, warn)
+ L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol, warn, verbose = FALSE, ...)
\S4method{getInfRobIC}{UnivariateDistribution,asHampel,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn, noLow = FALSE)
+ upper, maxiter, tol, warn, noLow = FALSE, verbose = FALSE)
\S4method{getInfRobIC}{RealRandVariable,asHampel,ContNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, Finfo, z.start, A.start, trafo, upper, maxiter, tol, warn)
+ L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE, z.start, A.start, upper, maxiter, tol, warn, verbose = FALSE)
\S4method{getInfRobIC}{UnivariateDistribution,asGRisk,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn, noLow = FALSE)
+ upper, maxiter, tol, warn, noLow = FALSE, verbose = FALSE)
\S4method{getInfRobIC}{RealRandVariable,asGRisk,ContNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, Finfo, z.start, A.start, trafo, upper, maxiter, tol, warn)
+ L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE, z.start, A.start, upper, maxiter, tol, warn, verbose = FALSE)
\S4method{getInfRobIC}{UnivariateDistribution,asUnOvShoot,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo,
upper, maxiter, tol, warn)
@@ -69,9 +69,11 @@
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
\item{noLow}{ logical: is lower case to be computed? }
+ \item{onesetLM}{ logical: use one set of Lagrange multipliers? }
\item{QuadForm}{ matrix of (or which may coerced to) class
\code{PosSemDefSymmMatrix} for use of different
(standardizing) norm }
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
}
%\details{}
\value{The optimally robust IC is computed.}
@@ -151,4 +153,4 @@
\seealso{\code{\link[RobAStBase]{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfStand.Rd
===================================================================
--- pkg/ROptEst/man/getInfStand.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfStand.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -23,7 +23,7 @@
neighbor, biastype, clip, cent, trafo)
\S4method{getInfStand}{RealRandVariable,ContNeighborhood,BiasType}(L2deriv,
- neighbor, biastype, Distr, A.comp, stand, clip, cent, trafo, w)
+ neighbor, biastype, Distr, A.comp, cent, trafo, w)
\S4method{getInfStand}{UnivariateDistribution,ContNeighborhood,BiasType}(L2deriv,
neighbor, biastype, clip, cent, trafo)
@@ -39,7 +39,6 @@
\item{\dots}{ additional parameters }
\item{clip}{ optimal clipping bound. }
\item{cent}{ optimal centering constant. }
- \item{stand}{ standardizing matrix. }
\item{Distr}{ object of class \code{"Distribution"}. }
\item{trafo}{ matrix: transformation of the parameter. }
\item{A.comp}{ matrix: indication which components of the standardizing
@@ -85,4 +84,4 @@
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getInfV.Rd
===================================================================
--- pkg/ROptEst/man/getInfV.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getInfV.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -59,4 +59,4 @@
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link[RobAStBase]{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getL1normL2deriv.Rd
===================================================================
--- pkg/ROptEst/man/getL1normL2deriv.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getL1normL2deriv.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -12,9 +12,8 @@
\S4method{getL1normL2deriv}{UnivariateDistribution}(L2deriv,
cent, ...)
-\S4method{getL1normL2deriv}{UnivariateDistribution}(L2deriv,
+\S4method{getL1normL2deriv}{RealRandVariable}(L2deriv,
cent, stand, Distr, normtype, ...)
-
}
%\details{}
\arguments{
@@ -33,5 +32,5 @@
##
}
\concept{L1norm}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/getL2normL2deriv.Rd
===================================================================
--- pkg/ROptEst/man/getL2normL2deriv.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getL2normL2deriv.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -20,4 +20,4 @@
##
}
\concept{L2norm}
-\keyword{}
+\keyword{robust}
Copied: pkg/ROptEst/man/getModifyIC.Rd (from rev 157, branches/robast-0.6/pkg/ROptEst/man/getModifyIC.Rd)
===================================================================
--- pkg/ROptEst/man/getModifyIC.Rd (rev 0)
+++ pkg/ROptEst/man/getModifyIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,40 @@
+\name{getModifyIC}
+\alias{getModifyIC}
+\alias{getModifyIC-methods}
+\alias{getModifyIC,L2ParamFamily,Neighborhood,asRisk-method}
+\alias{getModifyIC,L2LocationFamily,UncondNeighborhood,asGRisk-method}
+\alias{getModifyIC,L2ScaleFamily,ContNeighborhood,asGRisk-method}
+\alias{getModifyIC,L2ScaleFamily,TotalVarNeighborhood,asGRisk-method}
+\alias{getModifyIC,L2LocationScaleFamily,ContNeighborhood,asGRisk-method}
+
+\title{Generic Function for the Computation of Functions for Slot modifyIC}
+\description{
+ This function is used by internal computations and is rarely called directly.
+}
+\usage{
+getModifyIC(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2ParamFamily,Neighborhood,asRisk}(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2LocationFamily,UncondNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2ScaleFamily,ContNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2ScaleFamily,TotalVarNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
+\S4method{getModifyIC}{L2LocationScaleFamily,ContNeighborhood,asGRisk}(L2FamIC, neighbor, risk)
+}
+\arguments{
+ \item{L2FamIC}{ object of class \code{L2ParamFamily}. }
+ \item{neighbor}{ object of class \code{"Neighborhood"}. }
+ \item{risk}{ object of class \code{"RiskType"} }
+}
+\details{ This function is used for internal computations. }
+\value{ Function for slot \code{modifyIC} of \code{IC}s }
+\references{
+ Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
+
+ Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
+ Bayreuth: Dissertation.
+}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{\code{\link{optIC}}, \code{\link[RobAStBase]{IC-class}}}
+%\examples{}
+\concept{influence curve}
+\keyword{robust}
Modified: pkg/ROptEst/man/getRiskIC.Rd
===================================================================
--- pkg/ROptEst/man/getRiskIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/getRiskIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -55,4 +55,4 @@
\seealso{\code{\link[ROptEst]{getRiskIC-methods}}, \code{\link[RobAStBase]{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/leastFavorableRadius.Rd
===================================================================
--- pkg/ROptEst/man/leastFavorableRadius.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/leastFavorableRadius.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -13,7 +13,7 @@
\S4method{leastFavorableRadius}{L2ParamFamily,UncondNeighborhood,asGRisk}(
L2Fam, neighbor, risk, rho, upRad = 1,
z.start = NULL, A.start = NULL, upper = 100, maxiter = 100,
- tol = .Machine$double.eps^0.4, warn = FALSE)
+ tol = .Machine$double.eps^0.4, warn = FALSE, verbose = FALSE)
}
\arguments{
\item{L2Fam}{ L2-differentiable family of probability measures. }
@@ -29,6 +29,7 @@
\item{maxiter}{ the maximum number of iterations }
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
}
%\details{}
\value{
@@ -66,4 +67,4 @@
risk=asMSE(), rho=0.5)
}
\concept{least favorable radius}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/lowerCaseRadius.Rd
===================================================================
--- pkg/ROptEst/man/lowerCaseRadius.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/lowerCaseRadius.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -66,4 +66,4 @@
lowerCaseRadius(BinomFamily(size = 10), TotalVarNeighborhood(), asMSE())
}
\concept{lower case radius}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/minmaxBias.Rd
===================================================================
--- pkg/ROptEst/man/minmaxBias.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/minmaxBias.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -17,7 +17,7 @@
minmaxBias(L2deriv, neighbor, biastype, ...)
\S4method{minmaxBias}{UnivariateDistribution,ContNeighborhood,BiasType}(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol, Finfo)
+ maxiter, tol, warn, Finfo)
\S4method{minmaxBias}{UnivariateDistribution,ContNeighborhood,asymmetricBias}(L2deriv, neighbor, biastype, symm, trafo,
maxiter, tol, warn, Finfo)
@@ -28,8 +28,8 @@
\S4method{minmaxBias}{UnivariateDistribution,TotalVarNeighborhood,BiasType}(L2deriv, neighbor, biastype, symm, trafo,
maxiter, tol, warn, Finfo)
-\S4method{minmaxBias}{RealRandVariable,ContNeighborhood,BiasType}(L2deriv, neighbor, biastype, Distr,
- L2derivDistrSymm, z.start, A.start, z.comp, A.comp, trafo, maxiter, tol, warn)
+\S4method{minmaxBias}{RealRandVariable,ContNeighborhood,BiasType}(L2deriv, neighbor, biastype, normtype, Distr,
+ z.start, A.start, z.comp, A.comp, trafo, maxiter, tol)
}
\arguments{
@@ -37,10 +37,10 @@
of probability measures. }
\item{neighbor}{ object of class \code{"Neighborhood"}. }
\item{biastype}{ object of class \code{"BiasType"}. }
+ \item{normtype}{ object of class \code{"NormType"}. }
\item{\dots}{ additional parameters. }
\item{Distr}{ object of class \code{"Distribution"}. }
\item{symm}{ logical: indicating symmetry of \code{L2deriv}. }
- \item{L2derivDistrSymm}{ object of class \code{"DistrSymmList"}. }
\item{z.start}{ initial value for the centering constant. }
\item{A.start}{ initial value for the standardizing matrix. }
\item{z.comp}{ \code{logical} indicator which indices need to be computed and which are 0 due to symmetry. }
@@ -94,4 +94,4 @@
\seealso{\code{\link[RobAStBase]{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/optIC.Rd
===================================================================
--- pkg/ROptEst/man/optIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/optIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -12,16 +12,18 @@
\usage{
optIC(model, risk, ...)
-\S4method{optIC}{InfRobModel,asRisk}(model, risk,
- z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE)
+\S4method{optIC}{InfRobModel,asRisk}(model, risk, z.start = NULL, A.start = NULL,
+ upper = 1e4, maxiter = 50,
+ tol = .Machine$double.eps^0.4, warn = TRUE,
+ noLow = FALSE, verbose = FALSE)
-\S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk,
- upper = 1e4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE)
+\S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk, upper = 1e4, maxiter = 50,
+ tol = .Machine$double.eps^0.4, warn = TRUE)
-\S4method{optIC}{FixRobModel,fiUnOvShoot}(model, risk, sampleSize, upper = 1e4, maxiter = 50,
- tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A", cont = "left")
+\S4method{optIC}{FixRobModel,fiUnOvShoot}(model, risk, sampleSize, upper = 1e4,
+ maxiter = 50, tol = .Machine$double.eps^0.4,
+ warn = TRUE, Algo = "A", cont = "left",
+ verbose = FALSE)
}
\arguments{
\item{model}{ probability model. }
@@ -37,6 +39,7 @@
\item{Algo}{ "A" or "B". }
\item{cont}{ "left" or "right". }
\item{noLow}{ logical: is lower case to be computed? }
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
}
\details{ In case of the finite-sample risk \code{"fiUnOvShoot"} one can choose
between two algorithms for the computation of this risk where the least favorable
@@ -84,4 +87,4 @@
}
\concept{robust influence curve}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/optRisk.Rd
===================================================================
--- pkg/ROptEst/man/optRisk.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/optRisk.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -73,4 +73,4 @@
optRisk(model = NormLocationScaleFamily(), risk = asCov())
}
\concept{risk}
-\keyword{}
+\keyword{robust}
Modified: pkg/ROptEst/man/radiusMinimaxIC.Rd
===================================================================
--- pkg/ROptEst/man/radiusMinimaxIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/ROptEst/man/radiusMinimaxIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -12,7 +12,8 @@
\S4method{radiusMinimaxIC}{L2ParamFamily,UncondNeighborhood,asGRisk}(
L2Fam, neighbor, risk, loRad, upRad, z.start = NULL, A.start = NULL,
- upper = 1e5, maxiter = 100, tol = .Machine$double.eps^0.4, warn = FALSE)
+ upper = 1e5, maxiter = 100, tol = .Machine$double.eps^0.4,
+ warn = FALSE, verbose = FALSE)
}
\arguments{
\item{L2Fam}{ L2-differentiable family of probability measures. }
@@ -27,8 +28,14 @@
\item{maxiter}{ the maximum number of iterations }
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
}
-%\details{}
+\details{
+In case the neighborhood radius is unknown, Rieder et al. (2001, 2008)
+and Kohl (2005) show that there is nevertheless a way to compute an
+optimally robust IC - the so-called radius-minimax IC - which is
+optimal for some radius interval.
+}
\value{The radius minimax IC is computed.}
\section{Methods}{
\describe{
@@ -37,10 +44,10 @@
}}
\references{
Rieder, H., Kohl, M. and Ruckdeschel, P. (2008) The Costs of not Knowing
- the Radius. Statistical Methods and Applications \emph{17}(1) 13-40.
+ the Radius. Statistical Methods and Applications, \emph{17}(1) 13-40.
Rieder, H., Kohl, M. and Ruckdeschel, P. (2001) The Costs of not Knowing
- the Radius. Submitted. Appeared as discussion paper Nr. 81.
+ the Radius. Appeared as discussion paper Nr. 81.
SFB 373 (Quantification and Simulation of Economic Processes),
Humboldt University, Berlin; also available under
\url{www.uni-bayreuth.de/departments/math/org/mathe7/RIEDER/pubs/RR.pdf}
@@ -54,9 +61,10 @@
\seealso{\code{\link{radiusMinimaxIC}}}
\examples{
N <- NormLocationFamily(mean=0, sd=1)
-radiusMinimaxIC(L2Fam=N, neighbor=ContNeighborhood(),
- risk=asMSE(), loRad=0.1, upRad=0.5)
+radIC <- radiusMinimaxIC(L2Fam=N, neighbor=ContNeighborhood(),
+ risk=asMSE(), loRad=0.1, upRad=0.5)
+checkIC(radIC)
}
\concept{radius minimax influence curve}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Copied: pkg/ROptEst/man/roptest.Rd (from rev 157, branches/robast-0.6/pkg/ROptEst/man/roptest.Rd)
===================================================================
--- pkg/ROptEst/man/roptest.Rd (rev 0)
+++ pkg/ROptEst/man/roptest.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,157 @@
+\name{roptest}
+\alias{roptest}
+\title{ Optimally robust estimation }
+\description{
+ Function to compute optimally robust estimates for L2-differentiable
+ parametric families via k-step construction.
+}
+\usage{
+roptest(x, L2Fam, eps, eps.lower, eps.upper, initial.est,
+ neighbor = ContNeighborhood(), risk = asMSE(), steps = 1,
+ distance = CvMDist, startPar = NULL, verbose = FALSE,
+ useLast = getRobAStBaseOption("kStepUseLast"), ...)
+}
+\arguments{
+ \item{x}{ sample }
+ \item{L2Fam}{ object of class \code{"L2ParamFamily"} }
+ \item{eps}{ positive real (0 < \code{eps} <= 0.5): amount of gross errors.
+ See details below. }
+ \item{eps.lower}{ positive real (0 <= \code{eps.lower} <= \code{eps.upper}):
+ lower bound for the amount of gross errors. See details below. }
+ \item{eps.upper}{ positive real (\code{eps.lower} <= \code{eps.upper} <= 0.5):
+ upper bound for the amount of gross errors. See details below. }
+ \item{initial.est}{ initial estimate for unknown parameter. If missing
+ minimum distance estimator is computed. }
+ \item{neighbor}{ object of class \code{"UncondNeighborhood"} }
+ \item{risk}{ object of class \code{"RiskType"} }
+ \item{steps}{ positive integer: number of steps used for k-steps construction }
+ \item{distance}{ distance function }
+ \item{startPar}{ initial information used by \code{optimize} resp. \code{optim};
+ i.e; if (total) parameter is of length 1, \code{startPar} is
+ a search interval, else it is an initial parameter value; if \code{NULL}
+ slot \code{startPar} of \code{ParamFamily} is used to produce it;
+ in the multivariate case, \code{startPar} may also be of class \code{Estimate},
+ in which case slot \code{untransformed.estimate} is used.}
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
+ \item{useLast}{ which parameter estimate (initial estimate or
+ k-step estimate) shall be used to fill the slots \code{pIC},
+ \code{asvar} and \code{asbias} of the return value. }
+ \item{\dots}{ further arguments }
+}
+\details{
+ Computes the optimally robust estimator for a given L2 differentiable
+ parametric family. The computation uses a k-step construction with an
+ appropriate initial estimate; cf. also \code{\link[RobAStBase]{kStepEstimator}}.
+ Valid candidates are e.g. Kolmogorov(-Smirnov) or von Mises minimum
+ distance estimators (default); cf. Rieder (1994) and Kohl (2005).
+
+ If the amount of gross errors (contamination) is known, it can be
+ specified by \code{eps}. The radius of the corresponding infinitesimal
+ contamination neighborhood is obtained by multiplying \code{eps}
+ by the square root of the sample size.
+
+ If the amount of gross errors (contamination) is unknown, try to find a
+ rough estimate for the amount of gross errors, such that it lies
+ between \code{eps.lower} and \code{eps.upper}.
+
+ In case \code{eps.lower} is specified and \code{eps.upper} is missing,
+ \code{eps.upper} is set to 0.5. In case \code{eps.upper} is specified and
+ \code{eps.lower} is missing, \code{eps.lower} is set to 0.
+
+ If neither \code{eps} nor \code{eps.lower} and/or \code{eps.upper} is
+ specified, \code{eps.lower} and \code{eps.upper} are set to 0 and 0.5,
+ respectively.
+
+ If \code{eps} is missing, the radius-minimax estimator in sense of
+ Rieder et al. (2001, 2008), respectively Section 2.2 of Kohl (2005) is returned.
+
+ The default value of argument \code{useLast} is set by the
+ global option \code{kStepUseLast} which by default is set to
+ \code{FALSE}. In case of general models \code{useLast}
+ remains unchanged during the computations. However, if
+ slot \code{CallL2Fam} of \code{IC} generates an object of
+ class \code{"L2GroupParamFamily"} the value of \code{useLast}
+ is changed to \code{TRUE}.
+ Explicitly setting \code{useLast} to \code{TRUE} should
+ be done with care as in this situation the influence curve
+ is re-computed using the value of the one-step estimate
+ which may take quite a long time depending on the model.
+
+ If \code{useLast} is set to \code{TRUE} the computation of \code{asvar},
+ \code{asbias} and \code{IC} is based on the k-step estimate.
+}
+\value{Object of class \code{"kStepEstimate"}. }
+\references{
+ Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
+ Bayreuth: Dissertation.
+
+ Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
+
+ Rieder, H., Kohl, M. and Ruckdeschel, P. (2008) The Costs of not Knowing
+ the Radius. Statistical Methods and Applications \emph{17}(1) 13-40.
+
+ Rieder, H., Kohl, M. and Ruckdeschel, P. (2001) The Costs of not Knowing
+ the Radius. Appeared as discussion paper Nr. 81.
+ SFB 373 (Quantification and Simulation of Economic Processes),
+ Humboldt University, Berlin; also available under
+ \url{www.uni-bayreuth.de/departments/math/org/mathe7/RIEDER/pubs/RR.pdf}
+}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{ \code{\link[RobLox]{roblox}},
+ \code{\link[distrMod]{L2ParamFamily-class}}
+ \code{\link[RobAStBase]{UncondNeighborhood-class}},
+ \code{\link[distrMod]{RiskType-class}} }
+\examples{
+#############################
+## 1. Binomial data
+#############################
+## generate a sample of contaminated data
+ind <- rbinom(100, size=1, prob=0.05)
+x <- rbinom(100, size=25, prob=(1-ind)*0.25 + ind*0.9)
+
+## ML-estimate
+MLEstimator(x, BinomFamily(size = 25))
+
+## compute optimally robust estimator (known contamination)
+roptest(x, BinomFamily(size = 25), eps = 0.05, steps = 3)
+
+## compute optimally robust estimator (unknown contamination)
+roptest(x, BinomFamily(size = 25), eps.lower = 0, eps.upper = 0.1, steps = 3)
+
+
+#############################
+## 2. Poisson data
+#############################
+## Example: Rutherford-Geiger (1910); cf. Feller~(1968), Section VI.7 (a)
+x <- c(rep(0, 57), rep(1, 203), rep(2, 383), rep(3, 525), rep(4, 532),
+ rep(5, 408), rep(6, 273), rep(7, 139), rep(8, 45), rep(9, 27),
+ rep(10, 10), rep(11, 4), rep(12, 0), rep(13, 1), rep(14, 1))
+
+## ML-estimate
+MLEstimator(x, PoisFamily())
+
+## compute optimally robust estimator (unknown contamination)
+roptest(x, PoisFamily(), eps.upper = 0.05, steps = 3)
+
+#############################
+## 3. Normal (Gaussian) location and scale
+#############################
+## Generate a contaminated sample
+ind <- rbinom(100, size=1, prob=0.05)
+x <- rnorm(100, mean=0, sd=(1-ind) + ind*9)
+
+## ML-estimate
+MLEstimator(x, NormLocationScaleFamily())
+
+## compute optimally robust estimator (known contamination)
+## takes some time
+roptest(x, NormLocationScaleFamily(), eps = 0.05, steps = 3)
+
+## compute optimally robust estimator (unknown contamination)
+## takes some time
+roptest(x, NormLocationScaleFamily(), eps.upper = 0.1, steps = 3)
+}
+\concept{k-step construction}
+\concept{optimally robust estimation}
+\keyword{robust}
Modified: pkg/RandVar/chm/RandVar.chm
===================================================================
(Binary files differ)
Modified: pkg/RandVar/inst/doc/RandVar.pdf
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/DESCRIPTION
===================================================================
--- pkg/RobAStBase/DESCRIPTION 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/DESCRIPTION 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,12 +1,11 @@
Package: RobAStBase
Version: 0.1.0
-Date: 2008-07-21
+Date: 2008-08-04
Title: Robust Asymptotic Statistics
Description: Base S4-classes and functions for robust asymptotic statistics.
-Depends: R(>= 2.6.0), methods, distr(>= 2.0), distrEx(>= 2.0), distrMod(>= 2.0), RandVar(>= 0.6.2)
+Depends: R(>= 2.6.0), methods, distr(>= 2.0), distrEx(>= 2.0), distrMod(>= 2.0), RandVar(>= 0.6.3)
Author: Matthias Kohl, Peter Ruckdeschel
Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
LazyLoad: yes
License: GPL version 2 or later
URL: http://robast.r-forge.r-project.org/
-Packaged: Thu Jan 3 20:00:08 2008; btm722
Modified: pkg/RobAStBase/NAMESPACE
===================================================================
--- pkg/RobAStBase/NAMESPACE 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/NAMESPACE 2008-08-10 16:49:24 UTC (rev 159)
@@ -27,7 +27,8 @@
exportMethods("Curve",
"Risks", "Risks<-", "addRisk<-",
"Infos", "Infos<-", "addInfo<-",
- "CallL2Fam", "CallL2Fam<-",
+ "CallL2Fam", "CallL2Fam<-",
+ "modifyIC",
"generateIC",
"checkIC",
"evalIC",
@@ -39,7 +40,8 @@
"clipLo", "clipLo<-",
"clipUp", "clipUp<-",
"optIC")
-exportMethods("oneStepEstimator",
+exportMethods("oneStepEstimator",
+ "kStepEstimator",
"locMEstimator")
exportMethods("weight", "weight<-",
"getweight",
@@ -49,8 +51,11 @@
exportMethods("getRiskIC")
exportMethods("getBiasIC")
exportMethods("comparePlot")
-exportMethods("pIC", "steps", "Mroot")
+exportMethods("pIC", "asbias",
+ "steps",
+ "Mroot")
export("ContNeighborhood", "TotalVarNeighborhood")
export("FixRobModel", "InfRobModel")
export("InfluenceCurve", "IC", "ContIC", "TotalVarIC")
export(".eq", ".getDistr")
+export("RobAStBaseOptions", "getRobAStBaseOption")
Modified: pkg/RobAStBase/R/AllClass.R
===================================================================
--- pkg/RobAStBase/R/AllClass.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/AllClass.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,6 +5,10 @@
require("distrMod", character = TRUE, quietly = TRUE)
require("RandVar", character = TRUE, quietly = TRUE)
}
+.onAttach <- function(library, pkg){
+ unlockBinding(".RobAStBaseOptions", asNamespace("RobAStBase"))
+ invisible()
+}
## neighborhood
setClass("Neighborhood",
@@ -85,14 +89,16 @@
else TRUE
})
## partial incluence curve
-setClass("IC", representation(CallL2Fam = "call"),
+setClass("IC", representation(CallL2Fam = "call",
+ modifyIC = "OptionalFunction"),
prototype(name = "square integrable (partial) influence curve",
Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
Domain = Reals())),
Risks = list(),
Infos = matrix(c(character(0),character(0)), ncol=2,
dimnames=list(character(0), c("method", "message"))),
- CallL2Fam = call("L2ParamFamily")),
+ CallL2Fam = call("L2ParamFamily"),
+ modifyIC = NULL),
contains = "InfluenceCurve",
validity = function(object){
L2Fam <- eval(object at CallL2Fam)
@@ -119,6 +125,7 @@
Infos = matrix(c(character(0),character(0)), ncol=2,
dimnames=list(character(0), c("method", "message"))),
CallL2Fam = call("L2ParamFamily"),
+ modifyIC = NULL,
stand = as.matrix(1),
lowerCase = NULL,
neighborRadius = 0,
@@ -147,26 +154,19 @@
Infos = matrix(c(character(0),character(0)), ncol=2,
dimnames=list(character(0), c("method", "message"))),
CallL2Fam = call("L2ParamFamily"),
+ modifyIC = NULL,
clip = Inf, cent = 0, stand = as.matrix(1),
lowerCase = NULL,
neighborRadius = 0, weight = new("HampelWeight"),
biastype = symmetricBias(), NormType = NormType()),
contains = "HampIC",
validity = function(object){
- if(any(object at neighborRadius < 0)) # radius vector?!
- stop("'neighborRadius' has to be in [0, Inf]")
if(length(object at cent) != nrow(object at stand))
stop("length of centering constant != nrow of standardizing matrix")
if((length(object at clip) != 1) && (length(object at clip) != length(object at Curve)))
stop("length of clipping bound != 1 and != length of 'Curve'")
- if(!is.null(object at lowerCase))
- if(length(object at lowerCase) != nrow(object at stand))
- stop("length of 'lowerCase' != nrow of standardizing matrix")
- L2Fam <- eval(object at CallL2Fam)
if(!is(weight,"HampelWeight"))
stop("Weight has to be of class 'HampelWeight'")
- if(!identical(dim(L2Fam at param@trafo), dim(object at stand)))
- stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
return(TRUE)
})
## (partial) influence curve of total variation type
@@ -180,50 +180,78 @@
Infos = matrix(c(character(0),character(0)), ncol=2,
dimnames=list(character(0), c("method", "message"))),
CallL2Fam = call("L2ParamFamily"),
+ modifyIC = NULL,
clipLo = -Inf, clipUp = Inf, stand = as.matrix(1),
lowerCase = NULL,
- neighborRadius = 0, weight = new("BdStWeight")),
+ neighborRadius = 0, weight = new("BdStWeight"),
+ biastype = symmetricBias(), NormType = NormType()),
contains = "HampIC",
validity = function(object){
- if(any(object at neighborRadius < 0)) # radius vector?!
- stop("'neighborRadius' has to be in [0, Inf]")
if((length(object at clipLo) != 1) && (length(object at clipLo) != length(object at Curve)))
stop("length of lower clipping bound != 1 and != length of 'Curve'")
if((length(object at clipLo) != 1) && (length(object at clipLo) != length(object at Curve)))
stop("length of upper clipping bound != 1 and != length of 'Curve'")
- L2Fam <- eval(object at CallL2Fam)
if(!is(weight,"BdStWeight"))
stop("Weight has to be of class 'BdStWeight'")
- if(!identical(dim(L2Fam at param@trafo), dim(object at stand)))
- stop(paste("dimension of 'trafo' of 'param' != dimension of 'stand'"))
return(TRUE)
})
## ALEstimate
setClassUnion("OptionalInfluenceCurve", c("InfluenceCurve", "NULL"))
setClass("ALEstimate",
- representation(pIC = "OptionalInfluenceCurve"),
+ representation(pIC = "OptionalInfluenceCurve",
+ asbias = "OptionalNumeric"),
prototype(name = "Asymptotically linear estimate",
estimate = numeric(0),
+ samplesize = numeric(0),
+ estimate.call = call("{}"),
+ asvar = NULL,
+ asbias = NULL,
pIC = NULL,
+ nuis.idx = NULL,
+ trafo = list(fct = function(x){
+ list(fval = x, mat = matrix(0))},
+ mat = matrix(1)), ### necessary for comparison with unit matrix
Infos = matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))),
+ dimnames=list(character(0), c("method", "message"))),
+ untransformed.estimate = NULL,
+ untransformed.asvar = NULL),
contains = "Estimate")
setClass("kStepEstimate",
representation(steps = "integer"),
- prototype(name = "k-step estimate",
+ prototype(name = "Asymptotically linear estimate",
estimate = numeric(0),
+ samplesize = numeric(0),
+ estimate.call = call("{}"),
+ steps = integer(0),
+ asvar = NULL,
+ asbias = NULL,
pIC = NULL,
- steps = integer(0),
+ nuis.idx = NULL,
+ trafo = list(fct = function(x){
+ list(fval = x, mat = matrix(0))},
+ mat = matrix(1)), ### necessary for comparison with unit matrix
Infos = matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))),
+ dimnames=list(character(0), c("method", "message"))),
+ untransformed.estimate = NULL,
+ untransformed.asvar = NULL),
contains = "ALEstimate")
setClass("MEstimate",
representation(Mroot = "numeric"),
- prototype(name = "M estimate",
+ prototype(name = "Asymptotically linear estimate",
estimate = numeric(0),
+ samplesize = numeric(0),
+ estimate.call = call("{}"),
+ Mroot = numeric(0),
+ asvar = NULL,
+ asbias = NULL,
pIC = NULL,
- Mroot = numeric(0),
+ nuis.idx = NULL,
+ trafo = list(fct = function(x){
+ list(fval = x, mat = matrix(0))},
+ mat = matrix(1)), ### necessary for comparison with unit matrix
Infos = matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))),
+ dimnames=list(character(0), c("method", "message"))),
+ untransformed.estimate = NULL,
+ untransformed.asvar = NULL),
contains = "ALEstimate")
Modified: pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- pkg/RobAStBase/R/AllGeneric.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/AllGeneric.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -87,8 +87,12 @@
}
if(!isGeneric("oneStepEstimator")){
setGeneric("oneStepEstimator",
- function(x, IC, start) standardGeneric("oneStepEstimator"))
+ function(x, IC, start, ...) standardGeneric("oneStepEstimator"))
}
+if(!isGeneric("kStepEstimator")){
+ setGeneric("kStepEstimator",
+ function(x, IC, start, ...) standardGeneric("kStepEstimator"))
+}
if(!isGeneric("locMEstimator")){
setGeneric("locMEstimator", function(x, IC, ...) standardGeneric("locMEstimator"))
}
@@ -106,7 +110,7 @@
}
if(!isGeneric("weight<-")){
setGeneric("weight<-",
- function(object, value, ...) standardGeneric("weight<-"))
+ function(object, value) standardGeneric("weight<-"))
}
if(!isGeneric("clip")){
setGeneric("clip",
@@ -163,9 +167,15 @@
if(!isGeneric("pIC")){
setGeneric("pIC", function(object) standardGeneric("pIC"))
}
+if(!isGeneric("asbias")){
+ setGeneric("asbias", function(object) standardGeneric("asbias"))
+}
if(!isGeneric("steps")){
setGeneric("steps", function(object) standardGeneric("steps"))
}
if(!isGeneric("Mroot")){
setGeneric("Mroot", function(object) standardGeneric("Mroot"))
}
+if(!isGeneric("modifyIC")){
+ setGeneric("modifyIC", function(object) standardGeneric("modifyIC"))
+}
Modified: pkg/RobAStBase/R/AllShow.R
===================================================================
--- pkg/RobAStBase/R/AllShow.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/AllShow.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -92,3 +92,34 @@
cat("\n### Infos:\n")
show(object at Infos)
})
+setMethod("show", "ALEstimate",
+ function(object){
+ digits <- getOption("digits")
+ show(as(object,"Estimate"))
+ if(getdistrModOption("show.details") != "minimal"){
+ cat("asymptotic bias:\n")
+ print(asbias(object), quote = FALSE)
+ }
+ if(getdistrModOption("show.details") == "maximal" && !is.null(pIC(object))){
+ cat("(partial) influence curve:\n")
+ show(pIC(object))
+ }
+ })
+setMethod("show", "kStepEstimate",
+ function(object){
+ digits <- getOption("digits")
+ show(as(object,"ALEstimate"))
+ if(getdistrModOption("show.details") != "minimal"){
+ cat("steps:\n")
+ print(steps(object), quote = FALSE)
+ }
+ })
+setMethod("show", "MEstimate",
+ function(object){
+ digits <- getOption("digits")
+ show(as(object,"ALEstimate"))
+ if(getdistrModOption("show.details") != "minimal"){
+ cat("value of M equation:\n")
+ print(Mroot(object), quote = FALSE)
+ }
+ })
Modified: pkg/RobAStBase/R/ContIC.R
===================================================================
--- pkg/RobAStBase/R/ContIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/ContIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -4,7 +4,8 @@
Domain = Reals())),
Risks, Infos, clip = Inf, cent = 0, stand = as.matrix(1),
lowerCase = NULL, neighborRadius = 0, w = new("HampelWeight"),
- normtype = NormType(), biastype = symmetricBias()){
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL){
if(missing(name))
name <- "IC of contamination type"
if(missing(Risks))
@@ -40,6 +41,7 @@
contIC at weight <- w
contIC at biastype <- biastype
contIC at normtype <- normtype
+ contIC at modifyIC <- modifyIC
return(contIC)
# return(new("ContIC", name = name, Curve = Curve, Risks = Risks, Infos = Infos,
@@ -48,7 +50,6 @@
}
-
setMethod("generateIC", signature(neighbor = "ContNeighborhood",
L2Fam = "L2ParamFamily"),
function(neighbor, L2Fam, res){
@@ -56,26 +57,12 @@
a <- res$a
b <- res$b
d <- res$d
- normtype <- res$normtype
- biastype <- res$biastype
- if(is.null(res$w)) res$w <- new("HampelWeight")
+ normtype <- res$normtype
+ biastype <- res$biastype
w <- res$w
return(ContIC(
name = "IC of contamination type",
- CallL2Fam = call("L2ParamFamily",
- name = L2Fam at name,
- distribution = L2Fam at distribution,
- distrSymm = L2Fam at distrSymm,
- param = L2Fam at param,
- modifyParam = L2Fam at modifyParam,
- props = L2Fam at props,
-# L2deriv = L2Fam at L2deriv,
- L2deriv.fct = L2Fam at L2deriv.fct,
- L2derivSymm = L2Fam at L2derivSymm,
- L2derivDistr = L2Fam at L2derivDistr,
- L2derivDistrSymm = L2Fam at L2derivDistrSymm,
- FisherInfo = L2Fam at FisherInfo,
- FisherInfo.fct = L2Fam at FisherInfo.fct),
+ CallL2Fam = L2Fam at fam.call,
Curve = generateIC.fct(neighbor, L2Fam, res),
clip = b,
cent = a,
@@ -83,6 +70,7 @@
lowerCase = d,
w = w,
neighborRadius = neighbor at radius,
+ modifyIC = res$modifyIC,
normtype = normtype,
biastype = biastype,
Risks = res$risk,
@@ -91,9 +79,9 @@
})
## Access methods
-
setMethod("clip", "ContIC", function(object) object at clip)
setMethod("cent", "ContIC", function(object) object at cent)
+setMethod("neighbor", "ContIC", function(object) ContNeighborhood(radius = object at neighborRadius) )
## replace methods
setReplaceMethod("clip", "ContIC",
@@ -107,7 +95,8 @@
normW = object at normtype)
res <- list(A = object at stand, a = object at cent, b = value, d = object at lowerCase,
risk = object at Risks, info = object at Infos, w = w,
- normtype = object at normtype, biastype = object at biastype)
+ normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clip<-", "The clipping bound has been changed")
@@ -125,7 +114,8 @@
normW = object at normtype)
res <- list(A = object at stand, a = value, b = object at clip, d = object at lowerCase,
risk = object at Risks, info = object at Infos, w = w,
- normtype = object at normtype, biastype = object at biastype)
+ normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("cent<-", "The centering constant has been changed")
@@ -143,7 +133,8 @@
normW = object at normtype)
res <- list(A = value, a = object at cent, b = object at clip, d = object at lowerCase,
risk = object at Risks, info = object at Infos, w = w,
- normtype = object at normtype, biastype = object at biastype)
+ normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("stand<-", "The standardizing matrix has been changed")
@@ -156,7 +147,8 @@
L2Fam <- eval(object at CallL2Fam)
res <- list(A = object at stand, a = object at cent, b = object at clip, d = value,
risk = object at Risks, info = object at Infos, w = object at weight,
- normtype = object at normtype, biastype = object at biastype)
+ normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("lowerCase<-", "The slot 'lowerCase' has been changed")
@@ -168,7 +160,8 @@
L2Fam <- eval(value)
res <- list(A = object at stand, a = object at cent, b = object at clip, d = object at lowerCase,
risk = object at Risks, info = object at Infos, w = object at weight,
- normtype = object at normtype, biastype = object at biastype)
+ normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("CallL2Fam<-", "The slot 'CallL2Fam' has been changed")
Modified: pkg/RobAStBase/R/IC.R
===================================================================
--- pkg/RobAStBase/R/IC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/IC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,6 +1,7 @@
## generating function
IC <- function(name, Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
- Domain = Reals())), Risks, Infos, CallL2Fam = call("L2ParamFamily")){
+ Domain = Reals())), Risks, Infos, CallL2Fam = call("L2ParamFamily"),
+ modifyIC = NULL){
if(missing(name))
name <- "square integrable (partial) influence curve"
if(missing(Risks))
@@ -32,12 +33,14 @@
IC1 at Risks <- Risks
IC1 at Infos <- Infos
IC1 at CallL2Fam <- CallL2Fam
+ IC1 at modifyIC <- modifyIC
return(IC1)
}
## access methods
setMethod("CallL2Fam", "IC", function(object) object at CallL2Fam)
+setMethod("modifyIC", "IC", function(object) object at modifyIC)
## replace methods
setReplaceMethod("CallL2Fam", "IC",
@@ -126,25 +129,30 @@
trafo <- trafo(L2Fam at param)
IC1 <- as(diag(dimension(IC at Curve)) %*% IC at Curve, "EuclRandVariable")
cent <- E(D1, IC1)
+ IC1 <- IC1 - cent
dims <- length(L2Fam at param)
- if(dimension(Domain(IC at Curve[[1]])) != dims)
- stop("Dimension of IC and parameter must be the equal")
-
+ 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)
-
stand <- trafo %*% solve(E1)
- Y <- as(stand %*% L2Fam at L2deriv - cent, "EuclRandVariable")
- ICfct <- vector(mode = "list", length = dims)
- ICfct[[1]] <- function(x){Y(x)}
- return(IC(name = name(IC),
- Curve = EuclRandVarList(EuclRandVariable(Map = ICfct,
- Domain = Y at Domain,Range = Y at Range)),
- Risks=list(), Infos=matrix(c("IC<-",
- "generated by affine linear trafo to enforce consistency"), ncol=2,
- dimnames=list(character(0), c("method", "message"))),
- CallL2Fam = IC at CallL2Fam))
+ Y <- as(stand %*% IC1, "EuclRandVariable")
+ #ICfct <- vector(mode = "list", length = dims)
+ #ICfct[[1]] <- function(x){Y(x)}
+
+ modifyIC <- function(L2Fam, IC){ makeIC(IC, L2Fam) }
+
+ CallL2Fam <- L2Fam at fam.call
+
+ return(IC(name = name(IC),
+ Curve = EuclRandVarList(Y),
+ Risks = list(),
+ Infos=matrix(c("IC<-",
+ "generated by affine linear trafo to enforce consistency"),
+ ncol=2, dimnames=list(character(0), c("method", "message"))),
+ CallL2Fam = CallL2Fam,
+ modifyIC = modifyIC))
})
-
Copied: pkg/RobAStBase/R/RobAStBaseOptions.R (from rev 157, branches/robast-0.6/pkg/RobAStBase/R/RobAStBaseOptions.R)
===================================================================
--- pkg/RobAStBase/R/RobAStBaseOptions.R (rev 0)
+++ pkg/RobAStBase/R/RobAStBaseOptions.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,26 @@
+.RobAStBaseOptions <- list(
+ kStepUseLast = FALSE
+)
+
+RobAStBaseOptions <- function(...) {
+ if (nargs() == 0) return(.RobAStBaseOptions)
+ current <- .RobAStBaseOptions
+ temp <- list(...)
+ if (length(temp) == 1 && is.null(names(temp))) {
+ arg <- temp[[1]]
+ switch(mode(arg),
+ list = temp <- arg,
+ character = return(.RobAStBaseOptions[arg]),
+ stop("invalid argument: ", sQuote(arg)))
+ }
+ if (length(temp) == 0) return(current)
+ n <- names(temp)
+ if (is.null(n)) stop("options must be given by name")
+ changed <- current[n]
+ current[n] <- temp
+ env <- if (sys.parent() == 0) asNamespace("RobAStBase") else parent.frame()
+ assign(".RobAStBaseOptions", current, envir = env)
+ invisible(current)
+}
+
+getRobAStBaseOption <- function(x) RobAStBaseOptions(x)[[1]]
Modified: pkg/RobAStBase/R/TotalVarIC.R
===================================================================
--- pkg/RobAStBase/R/TotalVarIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/TotalVarIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -2,7 +2,9 @@
TotalVarIC <- function(name, CallL2Fam = call("L2ParamFamily"),
Curve = EuclRandVarList(RealRandVariable(Map = c(function(x){x}), Domain = Reals())),
Risks, Infos, clipLo = -Inf, clipUp = Inf, stand = as.matrix(1),
- lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight")){
+ lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight"),
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL){
if(missing(name))
name <- "IC of total variation type"
@@ -32,6 +34,9 @@
IC1 at lowerCase <- lowerCase
IC1 at neighborRadius <- neighborRadius
IC1 at weight <- w
+ IC1 at biastype <- biastype
+ IC1 at normtype <- normtype
+ IC1 at modifyIC <- modifyIC
return(IC1)
}
@@ -44,7 +49,6 @@
A <- res$A
clipLo <- sign(as.vector(A))*res$a
b <- res$b
- if(is.null(res$w)) res$w <- new("BdStWeight")
w <- res$w
ICfct <- vector(mode = "list", length = 1)
Y <- as(A %*% L2Fam at L2deriv, "EuclRandVariable")
@@ -55,27 +59,17 @@
return(TotalVarIC(
name = "IC of total variation type",
- CallL2Fam = call("L2ParamFamily",
- name = L2Fam at name,
- distribution = L2Fam at distribution,
- distrSymm = L2Fam at distrSymm,
- param = L2Fam at param,
- modifyParam = L2Fam at modifyParam,
- props = L2Fam at props,
-# L2deriv = L2Fam at L2deriv,
- L2deriv.fct = L2Fam at L2deriv.fct,
- L2derivSymm = L2Fam at L2derivSymm,
- L2derivDistr = L2Fam at L2derivDistr,
- L2derivDistrSymm = L2Fam at L2derivDistrSymm,
- FisherInfo = L2Fam at FisherInfo,
- FisherInfo.fct = L2Fam at FisherInfo.fct),
+ CallL2Fam = L2Fam at fam.call,
Curve = generateIC.fct(neighbor, L2Fam, res),
clipUp = clipUp,
clipLo = clipLo,
stand = A,
lowerCase = res$d,
w = w,
- neighborRadius = neighbor at radius,
+ modifyIC = res$modifyIC,
+ normtype = res$normtype,
+ biastype = res$biastype,
+ neighborRadius = neighbor at radius,
Risks = res$risk,
Infos = matrix(res$info, ncol = 2,
dimnames = list(character(0), c("method", "message")))))
@@ -84,6 +78,7 @@
## Access methods
setMethod("clipLo", "TotalVarIC", function(object) object at clipLo)
setMethod("clipUp", "TotalVarIC", function(object) object at clipUp)
+setMethod("neighbor", "TotalVarIC", function(object) TotalVarNeighborhood(radius = object at neighborRadius) )
## Replace methods
setReplaceMethod("clipLo", "TotalVarIC",
@@ -97,7 +92,8 @@
normW = object at normtype)
res <- list(A = object at stand, a = value, b = object at clipUp-value,
d = object at lowerCase, risk = object at Risks, info = object at Infos,
- w = w, normtype = object at normtype, biastype = object at biastype)
+ w = w, normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clipLo<-", "The lower clipping bound has been changed")
@@ -115,7 +111,8 @@
normW = object at normtype)
res <- list(A = object at stand, a = object at clipLo, b = value-object at clipLo,
d = object at lowerCase, risk = object at Risks, info = object at Infos,
- w = w, normtype = object at normtype, biastype = object at biastype)
+ w = w, normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clipUp<-", "The upper clipping bound has been changed")
@@ -133,7 +130,8 @@
normW = object at normtype)
res <- list(A = value, a = object at clipLo, b = object at clipUp-object@clipLo,
d = object at lowerCase, risk = object at Risks, info = object at Infos,
- w = w, normtype = object at normtype, biastype = object at biastype)
+ w = w, normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("stand<-", "The standardizing matrix has been changed")
@@ -146,7 +144,8 @@
L2Fam <- eval(object at CallL2Fam)
res <- list(A = object at stand, a = object at clipLo, b = object at clipUp-object@clipLo,
d = value, risk = object at Risks, info = object at Infos,
- w = object at weight, normtype = object at normtype, biastype = object at biastype)
+ w = object at weight, normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("lowerCase<-", "The slot 'lowerCase' has been changed")
@@ -158,7 +157,8 @@
L2Fam <- eval(value)
res <- list(A = object at stand, a = object at clipLo, b = object at clipUp-object@clipLo,
d = object at lowerCase, risk = object at Risks, info = object at Infos,
- w = object at weight, normtype = object at normtype, biastype = object at biastype)
+ w = object at weight, normtype = object at normtype, biastype = object at biastype,
+ modifyIC = object at modifyIC)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("CallL2Fam<-", "The slot 'CallL2Fam' has been changed")
Modified: pkg/RobAStBase/R/bALEstimate.R
===================================================================
--- pkg/RobAStBase/R/bALEstimate.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/bALEstimate.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,5 +3,6 @@
###############################################################################
setMethod("pIC", "ALEstimate", function(object) object at pIC)
+setMethod("asbias", "ALEstimate", function(object) object at asbias)
setMethod("steps", "kStepEstimate", function(object) object at steps)
setMethod("Mroot", "MEstimate", function(object) object at Mroot)
Modified: pkg/RobAStBase/R/getBiasIC.R
===================================================================
--- pkg/RobAStBase/R/getBiasIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/getBiasIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -8,8 +8,10 @@
numbeval = 1e5){
misF <- FALSE
- if(missing(L2Fam))
- {misF <- TRUE; L2Fam <- eval(IC at CallL2Fam)}
+ if(missing(L2Fam)){
+ misF <- TRUE
+ L2Fam <- eval(IC at CallL2Fam)
+ }
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'")
@@ -23,7 +25,7 @@
prec <- if(misF) checkIC(IC, out = FALSE) else
checkIC(IC, L2Fam, out = FALSE)
if(prec > tol)
- warning("The maximum deviation from the exact IC properties is", prec,
+ warning("The maximum deviation from the exact IC properties is ", prec,
"\nThis is larger than the specified 'tol' ",
"=> the result may be wrong")
return(list(asBias = list(distribution = .getDistr(L2Fam),
Modified: pkg/RobAStBase/R/getRiskIC.R
===================================================================
--- pkg/RobAStBase/R/getRiskIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/getRiskIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -25,7 +25,7 @@
prec <- checkIC(IC, L2Fam, out = FALSE)
if(prec > tol)
- warning("The maximum deviation from the exact IC properties is", prec,
+ warning("The maximum deviation from the exact IC properties is ", prec,
"\nThis is larger than the specified 'tol' ",
"=> the result may be wrong")
@@ -57,7 +57,7 @@
prec <- checkIC(IC, L2Fam, out = FALSE)
if(prec > tol)
- warning("The maximum deviation from the exact IC properties is", prec,
+ warning("The maximum deviation from the exact IC properties is ", prec,
"\nThis is larger than the specified 'tol' ",
"=> the result may be wrong")
@@ -113,7 +113,7 @@
prec <- checkIC(IC, L2Fam, out = FALSE)
if(prec > tol)
- warning("The maximum deviation from the exact IC properties is", prec,
+ warning("The maximum deviation from the exact IC properties is ", prec,
"\nThis is larger than the specified 'tol' ",
"=> the result may be wrong")
Copied: pkg/RobAStBase/R/kStepEstimator.R (from rev 157, branches/robast-0.6/pkg/RobAStBase/R/kStepEstimator.R)
===================================================================
--- pkg/RobAStBase/R/kStepEstimator.R (rev 0)
+++ pkg/RobAStBase/R/kStepEstimator.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,486 @@
+###############################################################################
+## one-step estimator
+###############################################################################
+setMethod("kStepEstimator", signature(x = "numeric",
+ IC = "IC",
+ start = "numeric"),
+ function(x, IC, start, steps = 1L, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("kStepEstimator")
+ if(!is.integer(steps))
+ steps <- as.integer(steps)
+ if(steps < 1)
+ stop("steps needs to be a positive integer")
+
+ nrvalues <- dimension(IC at Curve)
+ if(is.list(start)) start <- unlist(start)
+ if(nrvalues != length(start))
+ stop("dimension of 'start' != dimension of 'Curve'")
+
+ res <- start + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
+
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("kStepEstimator",
+ paste(steps, "-step estimate for ", name(L2Fam), sep = "")),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+
+ if(steps == 1){
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos))
+ }else{
+ if(is(modifyIC(IC), "NULL"))
+ stop("slot 'modifyIC' of 'IC' is 'NULL'!")
+ for(i in 2:steps){
+ start <- res
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- start
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ res <- start + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
+ }
+ if(useLast){
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = steps, Infos = Infos))
+ }
+ })
+
+setMethod("kStepEstimator", signature(x = "matrix",
+ IC = "IC",
+ start = "numeric"),
+ function(x, IC, start, steps = 1, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("kStepEstimator")
+ if(!is.integer(steps))
+ steps <- as.integer(steps)
+ if(steps < 1)
+ stop("steps needs to be a positive integer")
+
+ nrvalues <- dimension(IC at Curve)
+ if(is.list(start)) start <- unlist(start)
+ if(nrvalues != length(start))
+ stop("dimension of 'start' != dimension of 'Curve'")
+ if(ncol(x) != IC at Curve[[1]]@Domain at dimension)
+ stop("'x' has wrong dimension")
+
+ res <- start + rowMeans(evalIC(IC, x), na.rm = TRUE)
+
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("kStepEstimator",
+ paste(steps, "-step estimate for ", name(L2Fam), sep = "")),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+
+ if(steps == 1){
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos))
+ }else{
+ if(is(modifyIC(IC), "NULL"))
+ stop("slot 'modifyIC' of 'IC' is 'NULL'!")
+ for(i in 2:steps){
+ start <- res
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- start
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ res <- start + rowMeans(evalIC(IC, x), na.rm = TRUE)
+ }
+ if(useLast){
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = steps, Infos = Infos))
+ }
+ })
+setMethod("kStepEstimator", signature(x = "numeric",
+ IC = "IC",
+ start = "Estimate"),
+ function(x, IC, start, steps = 1, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("kStepEstimator")
+ if(!is.integer(steps))
+ steps <- as.integer(steps)
+ if(steps < 1)
+ stop("steps needs to be a positive integer")
+
+ nrvalues <- dimension(IC at Curve)
+ start0 <- estimate(start)
+ if(is.list(start0)) start0 <- unlist(start0)
+ if(nrvalues != length(start0))
+ stop("dimension of slot 'estimate' of 'start' != dimension of 'Curve'")
+
+ res <- start0 + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
+
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("kStepEstimator",
+ paste(steps, "-step estimate for ", name(L2Fam), sep = "")),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+
+ if(steps == 1){
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos))
+ }else{
+ if(is(modifyIC(IC), "NULL"))
+ stop("slot 'modifyIC' of 'IC' is 'NULL'!")
+ for(i in 2:steps){
+ start0 <- res
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- start0
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ res <- start0 + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
+ }
+ if(useLast){
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = steps, Infos = Infos))
+ }
+ })
+setMethod("kStepEstimator", signature(x = "matrix",
+ IC = "IC",
+ start = "Estimate"),
+ function(x, IC, start, steps = 1, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("kStepEstimator")
+ if(!is.integer(steps))
+ steps <- as.integer(steps)
+ if(steps < 1)
+ stop("steps needs to be a positive integer")
+
+ nrvalues <- dimension(IC at Curve)
+ start0 <- estimate(start)
+ if(is.list(start0)) start0 <- unlist(start0)
+ if(nrvalues != length(start0))
+ stop("dimension of slot 'estimate' of 'start' != dimension of 'Curve'")
+ if(ncol(x) != IC at Curve[[1]]@Domain at dimension)
+ stop("'x' has wrong dimension")
+
+ res <- start0 + rowMeans(evalIC(IC, x), na.rm = TRUE)
+
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("kStepEstimator",
+ paste(steps, "-step estimate for ", name(L2Fam), sep = "")),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+
+ if(steps == 1){
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos))
+ }else{
+ if(is(modifyIC(IC), "NULL"))
+ stop("slot 'modifyIC' of 'IC' is 'NULL'!")
+ for(i in 2:steps){
+ start0 <- res
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- start0
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ res <- start0 + rowMeans(evalIC(IC, x), na.rm = TRUE)
+ }
+ if(useLast){
+ newL2Fam <- eval(CallL2Fam(IC))
+ newParam <- param(newL2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(newL2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ Infos <- rbind(Infos, c("kStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ return(new("kStepEstimate", estimate.call = es.call,
+ name = paste(steps, "-step estimate", sep = ""),
+ estimate = res, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = steps, Infos = Infos))
+ }
+ })
Modified: pkg/RobAStBase/R/locMEstimator.R
===================================================================
--- pkg/RobAStBase/R/locMEstimator.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/locMEstimator.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,6 +3,8 @@
###############################################################################
setMethod("locMEstimator", signature(x = "numeric", IC = "InfluenceCurve"),
function(x, IC, eps = .Machine$double.eps^0.5){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("locMEstimator")
if(numberOfMaps(IC at Curve) > 1)
stop("number of Maps of 'IC' has to be 1")
@@ -11,16 +13,21 @@
}
res <- uniroot(f = mest, interval = c(min(x), max(x)),
tol = eps, x = x, IC = IC)
+
if(is(IC, "IC")){
L2Fam <- eval(CallL2Fam(IC))
Infos <- matrix(c("locMEstimator",
- paste("Location M estimate for", name(L2Fam))))
+ paste("Location M estimate for", name(L2Fam))),
+ ncol = 2)
colnames(Infos) <- c("method", "message")
+ asVar <- getRiskIC(IC, risk = asCov(), L2Fam = L2Fam)$asCov$value
+ asBias <- getRiskIC(IC, risk = asBias(), L2Fam = L2Fam)$asBias$value
}else{
- Infos <- matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))
+ Infos <- matrix(c("locMEstimator", "Location M estimate"), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ asvar <- NULL
}
-
new("MEstimate", name = "Location M estimate", estimate = res$root,
- pIC = IC, Mroot = res$f.root, Infos = Infos)
+ estimate.call = es.call, pIC = IC, Mroot = res$f.root,
+ Infos = Infos, samplesize = length(x), asvar = asVar, asbias = asBias)
})
Modified: pkg/RobAStBase/R/oneStepEstimator.R
===================================================================
--- pkg/RobAStBase/R/oneStepEstimator.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/oneStepEstimator.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -4,7 +4,9 @@
setMethod("oneStepEstimator", signature(x = "numeric",
IC = "InfluenceCurve",
start = "numeric"),
- function(x, IC, start){
+ function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("oneStepEstimator")
nrvalues <- dimension(IC at Curve)
if(is.list(start)) start <- unlist(start)
if(nrvalues != length(start))
@@ -12,12 +14,68 @@
res <- start + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
- return(res)
+ if(is(IC, "IC")){
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("oneStepEstimator",
+ paste("1-step estimate for", name(L2Fam))),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ }else{
+ Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ asVar <- NULL
+ asBias <- NULL
+ }
+
+ new("kStepEstimate", name = "1-step estimate", estimate = res,
+ estimate.call = es.call, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
})
setMethod("oneStepEstimator", signature(x = "matrix",
IC = "InfluenceCurve",
start = "numeric"),
- function(x, IC, start){
+ function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("oneStepEstimator")
nrvalues <- dimension(IC at Curve)
if(is.list(start)) start <- unlist(start)
if(nrvalues != length(start))
@@ -27,12 +85,68 @@
res <- start + rowMeans(evalIC(IC, x), na.rm = TRUE)
- return(res)
+ if(is(IC, "IC")){
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("oneStepEstimator",
+ paste("1-step estimate for", name(L2Fam))),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ }else{
+ Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ asVar <- NULL
+ asBias <- NULL
+ }
+
+ new("kStepEstimate", name = "1-step estimate", estimate = res,
+ estimate.call = es.call, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
})
setMethod("oneStepEstimator", signature(x = "numeric",
IC = "InfluenceCurve",
start = "Estimate"),
- function(x, IC, start){
+ function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("oneStepEstimator")
nrvalues <- dimension(IC at Curve)
start0 <- estimate(start)
if(is.list(start0)) start0 <- unlist(start0)
@@ -41,12 +155,68 @@
res <- start0 + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
- return(res)
+ if(is(IC, "IC")){
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("oneStepEstimator",
+ paste("1-step estimate for", name(L2Fam))),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ }else{
+ Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ asVar <- NULL
+ asBias <- NULL
+ }
+
+ new("kStepEstimate", name = "1-step estimate", estimate = res,
+ estimate.call = es.call, samplesize = length(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
})
setMethod("oneStepEstimator", signature(x = "matrix",
IC = "InfluenceCurve",
start = "Estimate"),
- function(x, IC, start){
+ function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
+ es.call <- match.call()
+ es.call[[1]] <- as.name("oneStepEstimator")
nrvalues <- dimension(IC at Curve)
start0 <- estimate(start)
if(is.list(start0)) start0 <- unlist(start0)
@@ -57,5 +227,59 @@
res <- start0 + rowMeans(evalIC(IC, x), na.rm = TRUE)
- return(res)
+ if(is(IC, "IC")){
+ L2Fam <- eval(CallL2Fam(IC))
+ Infos <- matrix(c("oneStepEstimator",
+ paste("1-step estimate for", name(L2Fam))),
+ ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
+ if(useLast && !is(modifyIC(IC), "NULL") ){
+ newParam <- param(L2Fam)
+ main(newParam) <- res
+ newL2Fam <- modifyModel(L2Fam, newParam)
+ IC <- modifyIC(IC)(newL2Fam, IC)
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = TRUE"))
+ }else{
+ if(useLast && is(modifyIC(IC), "NULL")){
+ warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
+ is filled with some function!")
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "slot 'modifyIC' of 'IC' was not filled!"))
+ }
+ Infos <- rbind(Infos, c("oneStepEstimator",
+ "computation of IC, asvar and asbias via useLast = FALSE"))
+ }
+ if("asCov" %in% names(Risks(IC)))
+ if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
+ asVar <- Risks(IC)$asCov
+ else
+ asVar <- Risks(IC)$asCov$value
+ else
+ asVar <- getRiskIC(IC, risk = asCov())$asCov$value
+
+ if("asBias" %in% names(Risks(IC))){
+ if(length(Risks(IC)$asBias) == 1)
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias
+ else
+ asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
+ }else{
+ if(is(IC, "HampIC")){
+ r <- neighborRadius(IC)
+ asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
+ }else{
+ asBias <- NULL
+ }
+ }
+ }else{
+ Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ asVar <- NULL
+ asBias <- NULL
+ }
+
+ new("kStepEstimate", name = "1-step estimate", estimate = res,
+ estimate.call = es.call, samplesize = ncol(x), asvar = asVar,
+ asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
})
Modified: pkg/RobAStBase/R/optIC.R
===================================================================
--- pkg/RobAStBase/R/optIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/R/optIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -6,23 +6,13 @@
Curve <- as((model at param@trafo %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
asCov <- model at param@trafo %*% solve(model at FisherInfo) %*% t(model at param@trafo)
+ modifyIC <- function(L2Fam, IC){ optIC(L2Fam, asCov()) }
+
return(IC(
name = paste("Classical optimal influence curve for", model at name),
- CallL2Fam = call("L2ParamFamily",
- name = model at name,
- distribution = model at distribution,
- distrSymm = model at distrSymm,
- param = model at param,
- modifyParam = model at modifyParam,
- props = model at props,
-# L2deriv = model at L2deriv,
- L2deriv.fct = model at L2deriv.fct,
- L2derivSymm = model at L2derivSymm,
- L2derivDistr = model at L2derivDistr,
- L2derivDistrSymm = model at L2derivDistrSymm,
- FisherInfo = model at FisherInfo,
- FisherInfo.fct = model at FisherInfo.fct),
- Curve = EuclRandVarList(Curve),
+ CallL2Fam = model at fam.call,
+ Curve = EuclRandVarList(Curve),
+ modifyIC = modifyIC,
Risks = list(asCov = asCov, trAsCov = sum(diag(asCov))),
Infos = matrix(c("optIC", "optimal IC in sense of Cramer-Rao bound"),
ncol = 2, dimnames = list(character(0), c("method", "message")))))
Modified: pkg/RobAStBase/chm/00Index.html
===================================================================
--- pkg/RobAStBase/chm/00Index.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/00Index.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -22,6 +22,7 @@
<a href="#G">G</a>
<a href="#H">H</a>
<a href="#I">I</a>
+<a href="#K">K</a>
<a href="#L">L</a>
<a href="#M">M</a>
<a href="#N">N</a>
@@ -43,6 +44,12 @@
<td>Influence curve</td></tr>
<tr><td width="25%"><a href="InfluenceCurve-class.html">addRisk<-,InfluenceCurve-method</a></td>
<td>Influence curve</td></tr>
+<tr><td width="25%"><a href="ALEstimate-class.html">ALEstimate-class</a></td>
+<td>ALEstimate-class.</td></tr>
+<tr><td width="25%"><a href="ALEstimate-class.html">asbias</a></td>
+<td>ALEstimate-class.</td></tr>
+<tr><td width="25%"><a href="ALEstimate-class.html">asbias,ALEstimate-method</a></td>
+<td>ALEstimate-class.</td></tr>
</table>
<h2><a name="B">-- B --</a></h2>
@@ -207,6 +214,8 @@
<td>Generic function for the computation of a risk for an IC</td></tr>
<tr><td width="25%"><a href="getRiskIC.html">getRiskIC-methods</a></td>
<td>Generic function for the computation of a risk for an IC</td></tr>
+<tr><td width="25%"><a href="RobAStBaseOptions.html">getRobAStBaseOption</a></td>
+<td>Function to change the global variables of the package ‘RobAStBase’ </td></tr>
<tr><td width="25%"><a href="getweight.html">getweight</a></td>
<td>Generating weights</td></tr>
<tr><td width="25%"><a href="getweight.html">getweight,BdStWeight,TotalVarNeighborhood,BiasType-method</a></td>
@@ -257,15 +266,36 @@
<td>Robust model with infinitesimal (unconditional) neighborhood</td></tr>
</table>
+<h2><a name="K">-- K --</a></h2>
+
+<table width="100%">
+<tr><td width="25%"><a href="kStepEstimate-class.html">kStepEstimate-class</a></td>
+<td>kStepEstimate-class.</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator,matrix,IC,Estimate-method</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator,matrix,IC,numeric-method</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator,numeric,IC,Estimate-method</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator,numeric,IC,numeric-method</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="kStepEstimator.html">kStepEstimator-methods</a></td>
+<td>Generic function for the computation of k-step estimates</td></tr>
+<tr><td width="25%"><a href="RobAStBaseOptions.html">kStepUseLast</a></td>
+<td>Function to change the global variables of the package ‘RobAStBase’ </td></tr>
+</table>
+
<h2><a name="L">-- L --</a></h2>
<table width="100%">
<tr><td width="25%"><a href="locMEstimator.html">locMEstimator</a></td>
-<td>Generic function for the computation of location M estimators</td></tr>
+<td>Generic function for the computation of location M estimates</td></tr>
<tr><td width="25%"><a href="locMEstimator.html">locMEstimator,numeric,InfluenceCurve-method</a></td>
-<td>Generic function for the computation of location M estimators</td></tr>
+<td>Generic function for the computation of location M estimates</td></tr>
<tr><td width="25%"><a href="locMEstimator.html">locMEstimator-methods</a></td>
-<td>Generic function for the computation of location M estimators</td></tr>
+<td>Generic function for the computation of location M estimates</td></tr>
<tr><td width="25%"><a href="HampIC-class.html">lowerCase</a></td>
<td>Influence curve of Hampel type</td></tr>
<tr><td width="25%"><a href="HampIC-class.html">lowerCase,HampIC-method</a></td>
@@ -289,6 +319,8 @@
<td>Generic Function for making ICs consistent at a possibly different model</td></tr>
<tr><td width="25%"><a href="InfluenceCurve-class.html">Map,InfluenceCurve-method</a></td>
<td>Influence curve</td></tr>
+<tr><td width="25%"><a href="MEstimate-class.html">MEstimate-class</a></td>
+<td>MEstimate-class.</td></tr>
<tr><td width="25%"><a href="getweight.html">minbiasweight</a></td>
<td>Generating weights</td></tr>
<tr><td width="25%"><a href="getweight.html">minbiasweight,BdStWeight,TotalVarNeighborhood,BiasType-method</a></td>
@@ -301,6 +333,14 @@
<td>Generating weights</td></tr>
<tr><td width="25%"><a href="getweight.html">minbiasweight-methods</a></td>
<td>Generating weights</td></tr>
+<tr><td width="25%"><a href="IC-class.html">modifyIC</a></td>
+<td>Influence curve</td></tr>
+<tr><td width="25%"><a href="IC-class.html">modifyIC,IC-method</a></td>
+<td>Influence curve</td></tr>
+<tr><td width="25%"><a href="MEstimate-class.html">Mroot</a></td>
+<td>MEstimate-class.</td></tr>
+<tr><td width="25%"><a href="MEstimate-class.html">Mroot,MEstimate-method</a></td>
+<td>MEstimate-class.</td></tr>
</table>
<h2><a name="N">-- N --</a></h2>
@@ -322,8 +362,12 @@
<td>Robust Weight classes</td></tr>
<tr><td width="25%"><a href="RobModel-class.html">neighbor</a></td>
<td>Robust model</td></tr>
+<tr><td width="25%"><a href="ContIC-class.html">neighbor,ContIC-method</a></td>
+<td>Influence curve of contamination type</td></tr>
<tr><td width="25%"><a href="RobModel-class.html">neighbor,RobModel-method</a></td>
<td>Robust model</td></tr>
+<tr><td width="25%"><a href="TotalVarIC-class.html">neighbor,TotalVarIC-method</a></td>
+<td>Influence curve of total variation type</td></tr>
<tr><td width="25%"><a href="FixRobModel-class.html">neighbor<-,FixRobModel-method</a></td>
<td>Robust model with fixed (unconditional) neighborhood</td></tr>
<tr><td width="25%"><a href="InfRobModel-class.html">neighbor<-,InfRobModel-method</a></td>
@@ -346,17 +390,17 @@
<table width="100%">
<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
-<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,matrix,InfluenceCurve,list-method</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
+<td>Generic function for the computation of one-step estimates</td></tr>
+<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,matrix,InfluenceCurve,Estimate-method</a></td>
+<td>Generic function for the computation of one-step estimates</td></tr>
<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,matrix,InfluenceCurve,numeric-method</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
-<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,numeric,InfluenceCurve,list-method</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
+<td>Generic function for the computation of one-step estimates</td></tr>
+<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,numeric,InfluenceCurve,Estimate-method</a></td>
+<td>Generic function for the computation of one-step estimates</td></tr>
<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator,numeric,InfluenceCurve,numeric-method</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
+<td>Generic function for the computation of one-step estimates</td></tr>
<tr><td width="25%"><a href="oneStepEstimator.html">oneStepEstimator-methods</a></td>
-<td>Generic function for the computation of one-step estimators</td></tr>
+<td>Generic function for the computation of one-step estimates</td></tr>
<tr><td width="25%"><a href="optIC.html">optIC</a></td>
<td>Generic function for the computation of optimally robust ICs</td></tr>
<tr><td width="25%"><a href="optIC.html">optIC,L2ParamFamily,asCov-method</a></td>
@@ -368,6 +412,10 @@
<h2><a name="P">-- P --</a></h2>
<table width="100%">
+<tr><td width="25%"><a href="ALEstimate-class.html">pIC</a></td>
+<td>ALEstimate-class.</td></tr>
+<tr><td width="25%"><a href="ALEstimate-class.html">pIC,ALEstimate-method</a></td>
+<td>ALEstimate-class.</td></tr>
<tr><td width="25%"><a href="IC-class.html">plot,IC-method</a></td>
<td>Influence curve</td></tr>
</table>
@@ -387,6 +435,8 @@
<td>Influence curve</td></tr>
<tr><td width="25%"><a href="InfluenceCurve-class.html">Risks<-,InfluenceCurve-method</a></td>
<td>Influence curve</td></tr>
+<tr><td width="25%"><a href="RobAStBaseOptions.html">RobAStBaseOptions</a></td>
+<td>Function to change the global variables of the package ‘RobAStBase’ </td></tr>
<tr><td width="25%"><a href="RobAStControl-class.html">RobAStControl-class</a></td>
<td>Control classes in package RobAStBase</td></tr>
<tr><td width="25%"><a href="RobModel-class.html">RobModel-class</a></td>
@@ -424,6 +474,10 @@
<td>Influence curve of contamination type</td></tr>
<tr><td width="25%"><a href="TotalVarIC-class.html">stand<-,TotalVarIC-method</a></td>
<td>Influence curve of total variation type</td></tr>
+<tr><td width="25%"><a href="kStepEstimate-class.html">steps</a></td>
+<td>kStepEstimate-class.</td></tr>
+<tr><td width="25%"><a href="kStepEstimate-class.html">steps,kStepEstimate-method</a></td>
+<td>kStepEstimate-class.</td></tr>
</table>
<h2><a name="T">-- T --</a></h2>
Modified: pkg/RobAStBase/chm/BdStWeight-class.html
===================================================================
--- pkg/RobAStBase/chm/BdStWeight-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/BdStWeight-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -56,9 +56,10 @@
<dt>stand<-</dt><dd><code>signature(object = "BdStWeight", value = "matrix")</code>:
-replacement function for slot <code>stand</code>. </dd>
-
-<p>
+replacement function for slot <code>stand</code>. This replacement method
+should be used with great care, as the slot <code>weight</code> is not
+simultaneously updated and hence, this may lead to inconsistent
+objects.</dd>
</dl>
<h3>Author(s)</h3>
@@ -91,7 +92,15 @@
</p>
+<h3>Examples</h3>
+<pre>
+## prototype
+new("BdStWeight")
+</pre>
+
+
+
<hr><div align="center">[Package <em>RobAStBase</em> version 0.1.0 <a href="00Index.html">Index]</a></div>
</body></html>
Modified: pkg/RobAStBase/chm/BoundedWeight-class.html
===================================================================
--- pkg/RobAStBase/chm/BoundedWeight-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/BoundedWeight-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -52,9 +52,10 @@
<dt>clip<-</dt><dd><code>signature(object = "BoundedWeight", value = "numeric")</code>:
-replacement function for slot <code>clip</code>. </dd>
-
-<p>
+replacement function for slot <code>clip</code>. This replacement method
+should be used with great care, as the slot <code>weight</code> is not
+simultaneously updated and hence, this may lead to inconsistent
+objects. </dd>
</dl>
<h3>Author(s)</h3>
@@ -86,7 +87,15 @@
</p>
+<h3>Examples</h3>
+<pre>
+## prototype
+new("BoundedWeight")
+</pre>
+
+
+
<hr><div align="center">[Package <em>RobAStBase</em> version 0.1.0 <a href="00Index.html">Index]</a></div>
</body></html>
Modified: pkg/RobAStBase/chm/ContIC-class.html
===================================================================
--- pkg/RobAStBase/chm/ContIC-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/ContIC-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -19,6 +19,7 @@
<param name="keyword" value="R: lowerCase<-,ContIC-method">
<param name="keyword" value="R: stand<-">
<param name="keyword" value="R: stand<-,ContIC-method">
+<param name="keyword" value="R: neighbor,ContIC-method">
<param name="keyword" value="R: generateIC,ContNeighborhood,L2ParamFamily-method">
<param name="keyword" value="R: show,ContIC-method">
<param name="keyword" value=" Influence curve of contamination type">
@@ -64,6 +65,13 @@
<dt><code>Curve</code>:</dt><dd>object of class <code>"EuclRandVarList"</code></dd>
+<dt><code>modifyIC</code>:</dt><dd>Object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This slot is mainly used for internal
+computations! </dd>
+
+
<dt><code>Risks</code>:</dt><dd>object of class <code>"list"</code>:
list of risks; cf. <code><a onclick="findlink('distrMod', 'RiskType-class.html')" style="text-decoration: underline; color: blue; cursor: hand">RiskType-class</a></code>. </dd>
@@ -87,8 +95,12 @@
<dt><code>weight</code>:</dt><dd>object of class <code>"HampelWeight"</code>:
weight function </dd>
+
+
<dt><code>biastype</code>:</dt><dd>object of class <code>"BiasType"</code>:
bias type (symmetric/onsided/asymmetric) </dd>
+
+
<dt><code>normtype</code>:</dt><dd>object of class <code>"NormType"</code>:
norm type (Euclidean, information/self-standardized)</dd>
@@ -142,6 +154,11 @@
replacement function for slot <code>lowerCase</code>. </dd>
+<dt>neighbor</dt><dd><code>signature(object = "ContIC")</code>:
+generates an object of class <code>"ContNeighborhood"</code> with
+radius given in slot <code>neighborRadius</code>. </dd>
+
+
<dt>generateIC</dt><dd><code>signature(neighbor = "ContNeighborhood", L2Fam = "L2ParamFamily")</code>:
generate an object of class <code>"ContIC"</code>. Rarely called directly. </dd>
Modified: pkg/RobAStBase/chm/ContIC.html
===================================================================
--- pkg/RobAStBase/chm/ContIC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/ContIC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -34,7 +34,8 @@
Domain = Reals())),
Risks, Infos, clip = Inf, cent = 0, stand = as.matrix(1),
lowerCase = NULL, neighborRadius = 0, w = new("HampelWeight"),
- normtype = NormType(), biastype = symmetricBias())
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL)
</pre>
@@ -85,6 +86,13 @@
<tr valign="top"><td><code>normtype</code></td>
<td>
NormType: type of the norm</td></tr>
+<tr valign="top"><td><code>modifyIC</code></td>
+<td>
+object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This function is mainly used for internal
+computations! </td></tr>
</table>
<h3>Value</h3>
Modified: pkg/RobAStBase/chm/HampIC-class.html
===================================================================
--- pkg/RobAStBase/chm/HampIC-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/HampIC-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -53,6 +53,13 @@
<dt><code>Curve</code>:</dt><dd>object of class <code>"EuclRandVarList"</code></dd>
+<dt><code>modifyIC</code>:</dt><dd>Object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This slot is mainly used for internal
+computations! </dd>
+
+
<dt><code>Risks</code>:</dt><dd>object of class <code>"list"</code>:
list of risks; cf. <code><a onclick="findlink('distrMod', 'RiskType-class.html')" style="text-decoration: underline; color: blue; cursor: hand">RiskType-class</a></code>. </dd>
Modified: pkg/RobAStBase/chm/HampelWeight-class.html
===================================================================
--- pkg/RobAStBase/chm/HampelWeight-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/HampelWeight-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -58,9 +58,10 @@
<dt>cent<-</dt><dd><code>signature(object = "HampelWeight", value = "matrix")</code>:
-replacement function for slot <code>cent</code>. </dd>
-
-<p>
+replacement function for slot <code>cent</code>. This replacement method
+should be used with great care, as the slot <code>weight</code> is not
+simultaneously updated and hence, this may lead to inconsistent
+objects. </dd>
</dl>
<h3>Author(s)</h3>
@@ -94,7 +95,15 @@
</p>
+<h3>Examples</h3>
+<pre>
+## prototype
+new("HampelWeight")
+</pre>
+
+
+
<hr><div align="center">[Package <em>RobAStBase</em> version 0.1.0 <a href="00Index.html">Index]</a></div>
</body></html>
Modified: pkg/RobAStBase/chm/IC-class.html
===================================================================
--- pkg/RobAStBase/chm/IC-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/IC-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -10,6 +10,8 @@
<param name="keyword" value="R: CallL2Fam,IC-method">
<param name="keyword" value="R: CallL2Fam<-">
<param name="keyword" value="R: CallL2Fam<-,IC-method">
+<param name="keyword" value="R: modifyIC">
+<param name="keyword" value="R: modifyIC,IC-method">
<param name="keyword" value="R: checkIC,IC,missing-method">
<param name="keyword" value="R: checkIC,IC,L2ParamFamily-method">
<param name="keyword" value="R: evalIC,IC,numeric-method">
@@ -46,6 +48,11 @@
<dt><code>CallL2Fam</code>:</dt><dd>Object of class <code>"call"</code>:
creates an object of the underlying L2-differentiable
parametric family. </dd>
+<dt><code>modifyIC</code>:</dt><dd>Object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This slot is mainly used for internal
+computations! </dd>
<dt><code>name</code>:</dt><dd>Object of class <code>"character"</code>. </dd>
<dt><code>Curve</code>:</dt><dd>Object of class <code>"EuclRandVarList"</code>.</dd>
<dt><code>Risks</code>:</dt><dd>Object of class <code>"list"</code>:
@@ -73,6 +80,10 @@
replacement function for slot <code>CallL2Fam</code>. </dd>
+<dt>modifyIC</dt><dd><code>signature(object = "IC")</code>:
+accessor function for slot <code>modifyIC</code>. </dd>
+
+
<dt>checkIC</dt><dd><code>signature(IC = "IC", L2Fam = "missing")</code>:
check centering and Fisher consistency of <code>IC</code> assuming
the L2-differentiable parametric family which can
Modified: pkg/RobAStBase/chm/IC.html
===================================================================
--- pkg/RobAStBase/chm/IC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/IC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -25,7 +25,7 @@
<pre>
IC(name, Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
Domain = Reals())),
- Risks, Infos, CallL2Fam = call("L2ParamFamily"))
+ Risks, Infos, CallL2Fam = call("L2ParamFamily"), modifyIC = NULL)
</pre>
@@ -51,6 +51,13 @@
<td>
matrix of characters with two columns
named <code>method</code> and <code>message</code>: additional informations. </td></tr>
+<tr valign="top"><td><code>modifyIC</code></td>
+<td>
+Object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This function is mainly used for internal
+computations! </td></tr>
</table>
<h3>Value</h3>
@@ -92,20 +99,6 @@
<pre>
IC1 <- IC()
plot(IC1)
-
-## The function is currently defined as
-IC <- function(name, Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x})),
- Domain = Reals()), Risks, Infos, CallL2Fam = call("L2ParamFamily")){
- if(missing(name))
- name <- "square integrable (partial) influence curve"
- if(missing(Risks))
- Risks <- list()
- if(missing(Infos))
- Infos <- matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))
- return(new("IC", name = name, Curve = Curve, Risks = Risks,
- Infos = Infos, CallL2Fam = CallL2Fam))
-}
</pre>
<script Language="JScript">
Modified: pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/chm/RobAStBase.hhp
===================================================================
--- pkg/RobAStBase/chm/RobAStBase.hhp 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/RobAStBase.hhp 2008-08-10 16:49:24 UTC (rev 159)
@@ -12,6 +12,7 @@
[FILES]
00Index.html
+ALEstimate-class.html
BdStWeight-class.html
BoundedWeight-class.html
ContIC-class.html
@@ -28,7 +29,9 @@
InfRobModel.html
InfluenceCurve-class.html
InfluenceCurve.html
+MEstimate-class.html
Neighborhood-class.html
+RobAStBaseOptions.html
RobAStControl-class.html
RobModel-class.html
RobWeight-class.html
@@ -47,6 +50,8 @@
getweight.html
infoPlot.html
internals.html
+kStepEstimate-class.html
+kStepEstimator.html
locMEstimator.html
makeIC-methods.html
oneStepEstimator.html
Modified: pkg/RobAStBase/chm/RobAStBase.toc
===================================================================
--- pkg/RobAStBase/chm/RobAStBase.toc 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/RobAStBase.toc 2008-08-10 16:49:24 UTC (rev 159)
@@ -34,6 +34,18 @@
<param name="Local" value="InfluenceCurve-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="ALEstimate-class">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="asbias">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="asbias,ALEstimate-method">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="BdStWeight-class">
<param name="Local" value="BdStWeight-class.html">
</OBJECT>
@@ -326,6 +338,10 @@
<param name="Local" value="getRiskIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="getRobAStBaseOption">
+<param name="Local" value="RobAStBaseOptions.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="getweight">
<param name="Local" value="getweight.html">
</OBJECT>
@@ -410,6 +426,38 @@
<param name="Local" value="internals.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimate-class">
+<param name="Local" value="kStepEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator,matrix,IC,Estimate-method">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator,matrix,IC,numeric-method">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator,numeric,IC,Estimate-method">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator,numeric,IC,numeric-method">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimator-methods">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepUseLast">
+<param name="Local" value="RobAStBaseOptions.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="locMEstimator">
<param name="Local" value="locMEstimator.html">
</OBJECT>
@@ -462,6 +510,10 @@
<param name="Local" value="InfluenceCurve-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="MEstimate-class">
+<param name="Local" value="MEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="minbiasweight">
<param name="Local" value="getweight.html">
</OBJECT>
@@ -486,6 +538,22 @@
<param name="Local" value="getweight.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="modifyIC">
+<param name="Local" value="IC-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="modifyIC,IC-method">
+<param name="Local" value="IC-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Mroot">
+<param name="Local" value="MEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Mroot,MEstimate-method">
+<param name="Local" value="MEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="name,InfluenceCurve-method">
<param name="Local" value="InfluenceCurve-class.html">
</OBJECT>
@@ -518,10 +586,18 @@
<param name="Local" value="RobModel-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="neighbor,ContIC-method">
+<param name="Local" value="ContIC-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="neighbor,RobModel-method">
<param name="Local" value="RobModel-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="neighbor,TotalVarIC-method">
+<param name="Local" value="TotalVarIC-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="neighbor<-">
<param name="Local" value="RobModel-class.html">
</OBJECT>
@@ -566,7 +642,7 @@
<param name="Local" value="oneStepEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="oneStepEstimator,matrix,InfluenceCurve,list-method">
+<param name="Name" value="oneStepEstimator,matrix,InfluenceCurve,Estimate-method">
<param name="Local" value="oneStepEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
@@ -574,7 +650,7 @@
<param name="Local" value="oneStepEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="oneStepEstimator,numeric,InfluenceCurve,list-method">
+<param name="Name" value="oneStepEstimator,numeric,InfluenceCurve,Estimate-method">
<param name="Local" value="oneStepEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
@@ -598,6 +674,14 @@
<param name="Local" value="optIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="pIC">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="pIC,ALEstimate-method">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="plot,IC-method">
<param name="Local" value="IC-class.html">
</OBJECT>
@@ -630,6 +714,10 @@
<param name="Local" value="InfluenceCurve-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="RobAStBaseOptions">
+<param name="Local" value="RobAStBaseOptions.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="RobAStControl-class">
<param name="Local" value="RobAStControl-class.html">
</OBJECT>
@@ -698,6 +786,14 @@
<param name="Local" value="TotalVarIC-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="steps">
+<param name="Local" value="kStepEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="steps,kStepEstimate-method">
+<param name="Local" value="kStepEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="TotalVarIC">
<param name="Local" value="TotalVarIC.html">
</OBJECT>
@@ -751,6 +847,10 @@
</OBJECT>
<UL>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="ALEstimate-class.">
+<param name="Local" value="ALEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Compare - Plots">
<param name="Local" value="comparePlot.html">
</OBJECT>
@@ -763,6 +863,10 @@
<param name="Local" value="RobAStControl-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Function to change the global variables of the package `RobAStBase' ">
+<param name="Local" value="RobAStBaseOptions.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Generating function for ContIC-class">
<param name="Local" value="ContIC.html">
</OBJECT>
@@ -815,11 +919,15 @@
<param name="Local" value="getRiskIC.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="Generic function for the computation of location M estimators">
+<param name="Name" value="Generic function for the computation of k-step estimates">
+<param name="Local" value="kStepEstimator.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Generic function for the computation of location M estimates">
<param name="Local" value="locMEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="Generic function for the computation of one-step estimators">
+<param name="Name" value="Generic function for the computation of one-step estimates">
<param name="Local" value="oneStepEstimator.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
@@ -855,6 +963,14 @@
<param name="Local" value="internals.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="kStepEstimate-class.">
+<param name="Local" value="kStepEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="MEstimate-class.">
+<param name="Local" value="MEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Neighborhood">
<param name="Local" value="Neighborhood-class.html">
</OBJECT>
Modified: pkg/RobAStBase/chm/RobAStControl-class.html
===================================================================
--- pkg/RobAStBase/chm/RobAStControl-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/RobAStControl-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -22,6 +22,20 @@
</p>
+<h3>Objects from the Class</h3>
+
+<p>
+This class is virtual; that is no objects may be created.
+</p>
+
+
+<h3>Slots</h3>
+
+<dl>
+<dt><code>name</code>:</dt><dd>Object of class <code>"character"</code>:
+name of the control object. </dd>
+</dl>
+
<h3>Methods</h3>
<dl>
Modified: pkg/RobAStBase/chm/RobWeight-class.html
===================================================================
--- pkg/RobAStBase/chm/RobWeight-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/RobWeight-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -8,11 +8,11 @@
<param name="keyword" value="R: RobWeight-class">
<param name="keyword" value="R: name,RobWeight-method">
<param name="keyword" value="R: name<-,RobWeight-method">
+<param name="keyword" value="R: weight">
<param name="keyword" value="R: weight,RobWeight-method">
-<param name="keyword" value="R: weight">
+<param name="keyword" value="R: weight<-">
<param name="keyword" value="R: weight<--methods">
<param name="keyword" value="R: weight<-,RobWeight-method">
-<param name="keyword" value="R: weight<-">
<param name="keyword" value=" Robust Weight classes">
</object>
@@ -48,7 +48,7 @@
accessor function for slot <code>name</code>. </dd>
-<dt>name<-</dt><dd><code>signature(object = "RobWeight", value = "character")</code>:
+<dt>name<-</dt><dd><code>signature(object = "RobWeight")</code>:
replacement function for slot <code>name</code>. </dd>
@@ -56,7 +56,7 @@
accessor function for slot <code>weight</code>. </dd>
-<dt>weight<-</dt><dd><code>signature(object = "RobWeight", value = "ANY")</code>:
+<dt>weight<-</dt><dd><code>signature(object = "RobWeight")</code>:
replacement function for slot <code>weight</code>. </dd>
</dl>
@@ -89,7 +89,15 @@
</p>
+<h3>Examples</h3>
+<pre>
+## prototype
+new("RobWeight")
+</pre>
+
+
+
<hr><div align="center">[Package <em>RobAStBase</em> version 0.1.0 <a href="00Index.html">Index]</a></div>
</body></html>
Modified: pkg/RobAStBase/chm/TotalVarIC-class.html
===================================================================
--- pkg/RobAStBase/chm/TotalVarIC-class.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/TotalVarIC-class.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -16,6 +16,7 @@
<param name="keyword" value="R: clipUp<-">
<param name="keyword" value="R: clipUp<-,TotalVarIC-method">
<param name="keyword" value="R: lowerCase<-,TotalVarIC-method">
+<param name="keyword" value="R: neighbor,TotalVarIC-method">
<param name="keyword" value="R: show,TotalVarIC-method">
<param name="keyword" value="R: stand<-,TotalVarIC-method">
<param name="keyword" value="R: generateIC,TotalVarNeighborhood,L2ParamFamily-method">
@@ -62,6 +63,13 @@
<dt><code>Curve</code>:</dt><dd>object of class <code>"EuclRandVarList"</code>.</dd>
+<dt><code>modifyIC</code>:</dt><dd>Object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This slot is mainly used for internal
+computations! </dd>
+
+
<dt><code>Risks</code>:</dt><dd>object of class <code>"list"</code>:
list of risks; cf. <code><a onclick="findlink('distrMod', 'RiskType-class.html')" style="text-decoration: underline; color: blue; cursor: hand">RiskType-class</a></code>. </dd>
@@ -87,6 +95,14 @@
weight function </dd>
+<dt><code>biastype</code>:</dt><dd>object of class <code>"BiasType"</code>:
+bias type (symmetric/onsided/asymmetric) </dd>
+
+
+<dt><code>normtype</code>:</dt><dd>object of class <code>"NormType"</code>:
+norm type (Euclidean, information/self-standardized)</dd>
+
+
<dt><code>neighborRadius</code>:</dt><dd>object of class <code>"numeric"</code>:
radius of the corresponding (unconditional) contamination
neighborhood. </dd>
@@ -128,6 +144,15 @@
replacement function for slot <code>stand</code>. </dd>
+<dt>lowerCase<-</dt><dd><code>signature(object = "TotalVarIC")</code>:
+replacement function for slot <code>lowerCase</code>. </dd>
+
+
+<dt>neighbor</dt><dd><code>signature(object = "TotalVarIC")</code>:
+generates an object of class <code>"TotalVarNeighborhood"</code> with
+radius given in slot <code>neighborRadius</code>. </dd>
+
+
<dt>generateIC</dt><dd><code>signature(neighbor = "TotalVarNeighborhood", L2Fam = "L2ParamFamily")</code>:
generate an object of class <code>"TotalVarIC"</code>. Rarely called directly. </dd>
Modified: pkg/RobAStBase/chm/TotalVarIC.html
===================================================================
--- pkg/RobAStBase/chm/TotalVarIC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/TotalVarIC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -33,7 +33,9 @@
Curve = EuclRandVarList(RealRandVariable(Map = c(function(x) {x}),
Domain = Reals())),
Risks, Infos, clipLo = -Inf, clipUp = Inf, stand = as.matrix(1),
- lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight"))
+ lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight"),
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL)
</pre>
@@ -78,6 +80,19 @@
<td>
radius of the corresponding (unconditional)
contamination neighborhood. </td></tr>
+<tr valign="top"><td><code>biastype</code></td>
+<td>
+BiasType: type of the bias</td></tr>
+<tr valign="top"><td><code>normtype</code></td>
+<td>
+NormType: type of the norm</td></tr>
+<tr valign="top"><td><code>modifyIC</code></td>
+<td>
+object of class <code>"OptionalFunction"</code>:
+function of two arguments, which are an L2 parametric family
+and an optional influence curve. Returns an object of
+class <code>"IC"</code>. This function is mainly used for internal
+computations! </td></tr>
</table>
<h3>Value</h3>
Modified: pkg/RobAStBase/chm/locMEstimator.html
===================================================================
--- pkg/RobAStBase/chm/locMEstimator.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/locMEstimator.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,4 +1,4 @@
-<html><head><title>Generic function for the computation of location M estimators</title>
+<html><head><title>Generic function for the computation of location M estimates</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link rel="stylesheet" type="text/css" href="Rchm.css">
</head>
@@ -8,17 +8,17 @@
<param name="keyword" value="R: locMEstimator">
<param name="keyword" value="R: locMEstimator-methods">
<param name="keyword" value="R: locMEstimator,numeric,InfluenceCurve-method">
-<param name="keyword" value=" Generic function for the computation of location M estimators">
+<param name="keyword" value=" Generic function for the computation of location M estimates">
</object>
-<h2>Generic function for the computation of location M estimators</h2>
+<h2>Generic function for the computation of location M estimates</h2>
<h3>Description</h3>
<p>
-Generic function for the computation of location M estimators.
+Generic function for the computation of location M estimates.
</p>
@@ -49,17 +49,20 @@
the desired accuracy (convergence tolerance). </td></tr>
</table>
-<h3>Value</h3>
+<h3>Details</h3>
<p>
-Returns a list with component
+Given some sample <code>x</code> and some influence curve <code>IC</code>
+an M estimate is computed by solving the corresponding
+M equation.
</p>
-<table summary="R argblock">
-<tr valign="top"><td><code>loc</code></td>
-<td>
-M estimator of location </td></tr>
-</table>
+
+<h3>Value</h3>
+
+<p>
+Object of class <code>"MEstimate"</code></p>
+
<h3>Methods</h3>
<dl>
@@ -91,7 +94,7 @@
<h3>See Also</h3>
<p>
-<code><a href="InfluenceCurve-class.html">InfluenceCurve-class</a></code>
+<code><a href="InfluenceCurve-class.html">InfluenceCurve-class</a></code>, <code><a href="MEstimate-class.html">MEstimate-class</a></code>
</p>
Modified: pkg/RobAStBase/chm/makeIC-methods.html
===================================================================
--- pkg/RobAStBase/chm/makeIC-methods.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/makeIC-methods.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -84,9 +84,26 @@
<h3>Examples</h3>
<pre>
+## default IC
IC1 <- new("IC")
+
+## L2-differentiable parametric family
B <- BinomFamily(13, 0.3)
-makeIC(IC1,B)
+
+## check IC properties
+checkIC(IC1, B)
+
+## make IC
+IC2 <- makeIC(IC1, B)
+
+## check IC properties
+checkIC(IC2)
+
+## slot modifyIC is filled in case of IC2
+IC3 <- modifyIC(IC2)(BinomFamily(13, 0.2), IC2)
+checkIC(IC3)
+## identical to
+checkIC(IC3, BinomFamily(13, 0.2))
</pre>
<script Language="JScript">
Modified: pkg/RobAStBase/chm/oneStepEstimator.html
===================================================================
--- pkg/RobAStBase/chm/oneStepEstimator.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/chm/oneStepEstimator.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,4 +1,4 @@
-<html><head><title>Generic function for the computation of one-step estimators</title>
+<html><head><title>Generic function for the computation of one-step estimates</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link rel="stylesheet" type="text/css" href="Rchm.css">
</head>
@@ -8,27 +8,44 @@
<param name="keyword" value="R: oneStepEstimator">
<param name="keyword" value="R: oneStepEstimator-methods">
<param name="keyword" value="R: oneStepEstimator,numeric,InfluenceCurve,numeric-method">
-<param name="keyword" value="R: oneStepEstimator,numeric,InfluenceCurve,list-method">
<param name="keyword" value="R: oneStepEstimator,matrix,InfluenceCurve,numeric-method">
-<param name="keyword" value="R: oneStepEstimator,matrix,InfluenceCurve,list-method">
-<param name="keyword" value=" Generic function for the computation of one-step estimators">
+<param name="keyword" value="R: oneStepEstimator,numeric,InfluenceCurve,Estimate-method">
+<param name="keyword" value="R: oneStepEstimator,matrix,InfluenceCurve,Estimate-method">
+<param name="keyword" value=" Generic function for the computation of one-step estimates">
</object>
-<h2>Generic function for the computation of one-step estimators</h2>
+<h2>Generic function for the computation of one-step estimates</h2>
<h3>Description</h3>
<p>
-Generic function for the computation of one-step estimators.
+Generic function for the computation of one-step estimates.
</p>
<h3>Usage</h3>
<pre>
-oneStepEstimator(x, IC, start)
+oneStepEstimator(x, IC, start, ...)
+
+## S4 method for signature 'numeric, InfluenceCurve,
+## numeric':
+oneStepEstimator(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+## S4 method for signature 'matrix, InfluenceCurve,
+## numeric':
+oneStepEstimator(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+## S4 method for signature 'numeric, InfluenceCurve,
+## Estimate':
+oneStepEstimator(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+## S4 method for signature 'matrix, InfluenceCurve,
+## Estimate':
+oneStepEstimator(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
</pre>
@@ -44,6 +61,14 @@
<tr valign="top"><td><code>start</code></td>
<td>
initial estimate </td></tr>
+<tr valign="top"><td><code>useLast</code></td>
+<td>
+which parameter estimate (initial estimate or
+one-step estimate) shall be used to fill the slots <code>pIC</code>,
+<code>asvar</code> and <code>asbias</code> of the return value. </td></tr>
+<tr valign="top"><td><code>...</code></td>
+<td>
+additional arguments </td></tr>
</table>
<h3>Details</h3>
@@ -51,22 +76,47 @@
<p>
Given an initial estimation <code>start</code>, a sample <code>x</code>
and an influence curve <code>IC</code> the corresponding one-step
-estimator is computed
+estimator is computed.
</p>
+<p>
+In case <code>IC</code> is an object of class <code>"IC"</code>
+the slots <code>asvar</code> and <code>asbias</code> of the return
+value are filled (based on the initial estimate).
+</p>
+<p>
+The default value of argument <code>useLast</code> is set by the
+global option <code>kStepUseLast</code> which by default is set to
+<code>FALSE</code>. In case of general models <code>useLast</code>
+remains unchanged during the computations. However, if
+slot <code>CallL2Fam</code> of <code>IC</code> generates an object of
+class <code>"L2GroupParamFamily"</code> the value of <code>useLast</code>
+is changed to <code>TRUE</code>.
+Explicitly setting <code>useLast</code> to <code>TRUE</code> should
+be done with care as in this situation the influence curve
+is re-computed using the value of the one-step estimate
+which may take quite a long time depending on the model.
+</p>
+<p>
+If <code>useLast</code> is set to <code>TRUE</code> and slot <code>modifyIC</code>
+of <code>IC</code> is filled with some function (which can be
+used to re-compute the IC for a different parameter), the
+computation of <code>asvar</code>, <code>asbias</code> and <code>IC</code> is
+based on the one-step estimate.
+</p>
<h3>Value</h3>
<p>
-The one-step estimation is computed.</p>
+Object of class <code>"kStepEstimate"</code></p>
<h3>Methods</h3>
<dl>
<dt>x = "numeric", IC = "InfluenceCurve", start = "numeric"</dt><dd>univariate samples. </dd>
-<dt>x = "numeric", IC = "InfluenceCurve", start = "list"</dt><dd>univariate samples. </dd>
<dt>x = "matrix", IC = "InfluenceCurve", start = "numeric"</dt><dd>multivariate samples. </dd>
-<dt>x = "matrix", IC = "InfluenceCurve", start = "list"</dt><dd>multivariate samples. </dd>
+<dt>x = "matrix", IC = "InfluenceCurve", start = "Estimate"</dt><dd>multivariate samples. </dd>
+<dt>x = "matrix", IC = "InfluenceCurve", start = "Estimate"</dt><dd>multivariate samples. </dd>
</dl>
<h3>Author(s)</h3>
@@ -90,7 +140,7 @@
<h3>See Also</h3>
<p>
-<code><a href="InfluenceCurve-class.html">InfluenceCurve-class</a></code>
+<code><a href="InfluenceCurve-class.html">InfluenceCurve-class</a></code>, <code><a href="kStepEstimate-class.html">kStepEstimate-class</a></code>
</p>
Modified: pkg/RobAStBase/man/ALEstimate-class.Rd
===================================================================
--- pkg/RobAStBase/man/ALEstimate-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/ALEstimate-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,6 +3,9 @@
\alias{ALEstimate-class}
\alias{pIC}
\alias{pIC,ALEstimate-method}
+\alias{asbias}
+\alias{asbias,ALEstimate-method}
+\alias{show,ALEstimate-method}
\title{ALEstimate-class.}
\description{Class of asymptotically linear estimates.}
@@ -15,8 +18,16 @@
name of the estimator. }
\item{\code{estimate}:}{Object of class \code{"ANY"}:
estimate. }
+ \item{\code{samplesize}:}{Object of class \code{"numeric"}:
+ sample size. }
+ \item{\code{asvar}:}{Optional object of class \code{"matrix"}:
+ asymptotic variance. }
+ \item{\code{asbias}:}{Optional object of class \code{"numeric"}:
+ asymptotic bias. }
\item{\code{pIC}:}{Optional object of class \code{InfluenceCurve}:
influence curve. }
+ \item{\code{nuis.idx}:}{ object of class \code{"OptionalNumeric"}:
+ indices of \code{estimate} belonging to the nuisance part. }
\item{\code{Infos}:}{ object of class \code{"matrix"}
with two columns named \code{method} and \code{message}:
additional informations. }
@@ -29,12 +40,17 @@
\describe{
\item{pIC}{\code{signature(object = "ALEstimate")}:
accessor function for slot \code{pIC}. }
+
+ \item{show}{\code{signature(object = "ALEstimate")} }
}
}
%\references{}
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
%\note{}
\seealso{\code{\link[distrMod]{Estimate-class}}}
-%\examples{}
+\examples{
+## prototype
+new("ALEstimate")
+}
\concept{estimate}
\keyword{classes}
Modified: pkg/RobAStBase/man/BdStWeight-class.Rd
===================================================================
--- pkg/RobAStBase/man/BdStWeight-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/BdStWeight-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -49,7 +49,8 @@
\seealso{\code{\link{BoundedWeight-class}}, \code{\link{RobWeight-class}},
\code{\link{IC}}, \code{\link{InfluenceCurve-class}}}
\examples{
-%
+## prototype
+new("BdStWeight")
}
\concept{influence curve}
\keyword{classes}
Modified: pkg/RobAStBase/man/BoundedWeight-class.Rd
===================================================================
--- pkg/RobAStBase/man/BoundedWeight-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/BoundedWeight-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -44,7 +44,8 @@
%\note{}
\seealso{\code{\link{RobWeight-class}}, \code{\link{IC}}, \code{\link{InfluenceCurve-class}}}
\examples{
-%
+## prototype
+new("BoundedWeight")
}
\concept{influence curve}
\keyword{classes}
Modified: pkg/RobAStBase/man/ContIC-class.Rd
===================================================================
--- pkg/RobAStBase/man/ContIC-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/ContIC-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -14,6 +14,7 @@
\alias{lowerCase<-,ContIC-method}
\alias{stand<-}
\alias{stand<-,ContIC-method}
+\alias{neighbor,ContIC-method}
\alias{generateIC,ContNeighborhood,L2ParamFamily-method}
\alias{show,ContIC-method}
@@ -41,6 +42,12 @@
\item{\code{Curve}:}{ object of class \code{"EuclRandVarList"}}
+ \item{\code{modifyIC}:}{ Object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This slot is mainly used for internal
+ computations! }
+
\item{\code{Risks}:}{ object of class \code{"list"}:
list of risks; cf. \code{\link[distrMod]{RiskType-class}}. }
@@ -59,10 +66,10 @@
\item{\code{weight}:}{ object of class \code{"HampelWeight"}:
weight function }
-
+
\item{\code{biastype}:}{ object of class \code{"BiasType"}:
bias type (symmetric/onsided/asymmetric) }
-
+
\item{\code{normtype}:}{ object of class \code{"NormType"}:
norm type (Euclidean, information/self-standardized)}
@@ -102,6 +109,10 @@
\item{lowerCase<-}{\code{signature(object = "ContIC")}:
replacement function for slot \code{lowerCase}. }
+ \item{neighbor}{\code{signature(object = "ContIC")}:
+ generates an object of class \code{"ContNeighborhood"} with
+ radius given in slot \code{neighborRadius}. }
+
\item{generateIC}{\code{signature(neighbor = "ContNeighborhood", L2Fam = "L2ParamFamily")}:
generate an object of class \code{"ContIC"}. Rarely called directly. }
Modified: pkg/RobAStBase/man/ContIC.Rd
===================================================================
--- pkg/RobAStBase/man/ContIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/ContIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -17,7 +17,8 @@
Domain = Reals())),
Risks, Infos, clip = Inf, cent = 0, stand = as.matrix(1),
lowerCase = NULL, neighborRadius = 0, w = new("HampelWeight"),
- normtype = NormType(), biastype = symmetricBias())
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL)
}
\arguments{
\item{name}{ object of class \code{"character"}. }
@@ -38,6 +39,11 @@
contamination neighborhood. }
\item{biastype}{ BiasType: type of the bias}
\item{normtype}{ NormType: type of the norm}
+ \item{modifyIC}{ object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This function is mainly used for internal
+ computations! }
}
%\details{}
\value{Object of class \code{"ContIC"}}
@@ -55,4 +61,4 @@
plot(IC1)
}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/HampIC-class.Rd
===================================================================
--- pkg/RobAStBase/man/HampIC-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/HampIC-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -30,6 +30,12 @@
\item{\code{Curve}:}{ object of class \code{"EuclRandVarList"}}
+ \item{\code{modifyIC}:}{ Object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This slot is mainly used for internal
+ computations! }
+
\item{\code{Risks}:}{ object of class \code{"list"}:
list of risks; cf. \code{\link[distrMod]{RiskType-class}}. }
Modified: pkg/RobAStBase/man/HampelWeight-class.Rd
===================================================================
--- pkg/RobAStBase/man/HampelWeight-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/HampelWeight-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -52,7 +52,8 @@
\code{\link{BoundedWeight-class}}, \code{\link{RobWeight-class}},
\code{\link{IC}}, \code{\link{InfluenceCurve-class}}}
\examples{
-%
+## prototype
+new("HampelWeight")
}
\concept{influence curve}
\keyword{classes}
Modified: pkg/RobAStBase/man/IC-class.Rd
===================================================================
--- pkg/RobAStBase/man/IC-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/IC-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -5,6 +5,8 @@
\alias{CallL2Fam,IC-method}
\alias{CallL2Fam<-}
\alias{CallL2Fam<-,IC-method}
+\alias{modifyIC}
+\alias{modifyIC,IC-method}
\alias{checkIC,IC,missing-method}
\alias{checkIC,IC,L2ParamFamily-method}
\alias{evalIC,IC,numeric-method}
@@ -25,6 +27,11 @@
\item{\code{CallL2Fam}:}{Object of class \code{"call"}:
creates an object of the underlying L2-differentiable
parametric family. }
+ \item{\code{modifyIC}:}{ Object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This slot is mainly used for internal
+ computations! }
\item{\code{name}:}{Object of class \code{"character"}. }
\item{\code{Curve}:}{Object of class \code{"EuclRandVarList"}.}
\item{\code{Risks}:}{Object of class \code{"list"}:
@@ -45,6 +52,9 @@
\item{CallL2Fam<-}{\code{signature(object = "IC")}:
replacement function for slot \code{CallL2Fam}. }
+ \item{modifyIC}{\code{signature(object = "IC")}:
+ accessor function for slot \code{modifyIC}. }
+
\item{checkIC}{\code{signature(IC = "IC", L2Fam = "missing")}:
check centering and Fisher consistency of \code{IC} assuming
the L2-differentiable parametric family which can
@@ -86,3 +96,4 @@
}
\concept{influence curve}
\keyword{classes}
+\keyword{robust}
Modified: pkg/RobAStBase/man/IC.Rd
===================================================================
--- pkg/RobAStBase/man/IC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/IC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -8,7 +8,7 @@
\usage{
IC(name, Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
Domain = Reals())),
- Risks, Infos, CallL2Fam = call("L2ParamFamily"))
+ Risks, Infos, CallL2Fam = call("L2ParamFamily"), modifyIC = NULL)
}
\arguments{
\item{name}{ Object of class \code{"character"}. }
@@ -20,6 +20,11 @@
list of risks; cf. \code{\link[distrMod]{RiskType-class}}. }
\item{Infos}{ matrix of characters with two columns
named \code{method} and \code{message}: additional informations. }
+ \item{modifyIC}{ Object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This function is mainly used for internal
+ computations! }
}
%\details{}
\value{Object of class \code{"IC"}}
@@ -38,20 +43,6 @@
\examples{
IC1 <- IC()
plot(IC1)
-
-## The function is currently defined as
-IC <- function(name, Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x})),
- Domain = Reals()), Risks, Infos, CallL2Fam = call("L2ParamFamily")){
- if(missing(name))
- name <- "square integrable (partial) influence curve"
- if(missing(Risks))
- Risks <- list()
- if(missing(Infos))
- Infos <- matrix(c(character(0),character(0)), ncol=2,
- dimnames=list(character(0), c("method", "message")))
- return(new("IC", name = name, Curve = Curve, Risks = Risks,
- Infos = Infos, CallL2Fam = CallL2Fam))
}
-}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/InfluenceCurve-class.Rd
===================================================================
--- pkg/RobAStBase/man/InfluenceCurve-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/InfluenceCurve-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -98,3 +98,4 @@
}
\concept{influence curve}
\keyword{classes}
+\keyword{robust}
Modified: pkg/RobAStBase/man/InfluenceCurve.Rd
===================================================================
--- pkg/RobAStBase/man/InfluenceCurve.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/InfluenceCurve.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -49,4 +49,4 @@
}
}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/MEstimate-class.Rd
===================================================================
--- pkg/RobAStBase/man/MEstimate-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/MEstimate-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,6 +3,7 @@
\alias{MEstimate-class}
\alias{Mroot}
\alias{Mroot,MEstimate-method}
+\alias{show,MEstimate-method}
\title{MEstimate-class.}
\description{Class of asymptotically linear estimates.}
@@ -17,8 +18,16 @@
name of the estimator. }
\item{\code{estimate}:}{Object of class \code{"ANY"}:
estimate. }
+ \item{\code{samplesize}:}{Object of class \code{"numeric"}:
+ sample size. }
+ \item{\code{asvar}:}{Optional object of class \code{"matrix"}:
+ asymptotic variance. }
+ \item{\code{asbias}:}{Optional object of class \code{"numeric"}:
+ asymptotic bias. }
\item{\code{pIC}:}{Optional object of class \code{InfluenceCurve}:
influence curve. }
+ \item{\code{nuis.idx}:}{ object of class \code{"OptionalNumeric"}:
+ indices of \code{estimate} belonging to the nuisance part. }
\item{\code{Mroot}:}{Object of class \code{"numeric"}: value of
the M equation at the estimate. }
\item{\code{Infos}:}{ object of class \code{"matrix"}
@@ -34,12 +43,17 @@
\describe{
\item{Mroot}{\code{signature(object = "MEstimate")}:
accessor function for slot \code{Mroot}. }
+
+ \item{show}{\code{signature(object = "MEstimate")} }
}
}
%\references{}
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
%\note{}
\seealso{\code{\link{ALEstimate-class}}}
-%\examples{}
+\examples{
+## prototype
+new("MEstimate")
+}
\concept{estimate}
\keyword{classes}
Copied: pkg/RobAStBase/man/RobAStBaseOptions.Rd (from rev 157, branches/robast-0.6/pkg/RobAStBase/man/RobAStBaseOptions.Rd)
===================================================================
--- pkg/RobAStBase/man/RobAStBaseOptions.Rd (rev 0)
+++ pkg/RobAStBase/man/RobAStBaseOptions.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,49 @@
+\name{RobAStBaseOptions}
+\alias{RobAStBaseOptions}
+\alias{getRobAStBaseOption}
+\alias{kStepUseLast}
+
+\title{Function to change the global variables of the package `RobAStBase' }
+\description{With \code{RobAStBaseOptions} you can inspect and change
+ the global variables of the package \pkg{RobAStBase}. }
+\usage{
+RobAStBaseOptions(...)
+getRobAStBaseOption(x)
+}
+\arguments{
+ \item{\dots}{ any options can be defined, using name = value or by passing a list of such tagged values. }
+ \item{x}{ a character string holding an option name.}
+}
+%\details{}
+\value{
+ \code{RobAStBaseOptions()} returns a list of the global variables.\newline
+ \code{RobAStBaseOptions(x)} returns the global variable \var{x}.\newline
+ \code{getRobAStBaseOption(x)} returns the global variable \var{x}.\newline
+ \code{RobAStBaseOptions(x=y)} sets the value of the global variable \var{x} to \var{y}.
+}
+\section{Global Options}{
+\describe{
+ \item{kStepUseLast:}{ The default value of argument \code{kStepUseLast} is
+ \code{FALSE}. Explicitly setting \code{kStepUseLast} to \code{TRUE} should
+ be done with care as in this situation the influence curve in case of
+ \code{oneStepEstimator} and \code{kStepEstimator} is re-computed using
+ the value of the one- resp. k-step estimate which may take quite a long
+ time depending on the model. }
+}
+}
+%\references{}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{\code{\link[base]{options}}, \code{\link[base]{getOption}}}
+\examples{
+RobAStBaseOptions()
+RobAStBaseOptions("kStepUseLast")
+RobAStBaseOptions("kStepUseLast" = TRUE)
+# or
+RobAStBaseOptions(kStepUseLast = 1e-6)
+getRobAStBaseOption("kStepUseLast")
+}
+\keyword{misc}
+\keyword{robust}
+\concept{global options}
+\concept{options}
Modified: pkg/RobAStBase/man/RobAStControl-class.Rd
===================================================================
--- pkg/RobAStBase/man/RobAStControl-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/RobAStControl-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -7,17 +7,14 @@
\title{Control classes in package RobAStBase}
\description{Control classes in package \pkg{RobAStBase}.}
\section{Objects from the Class}{
+ This class is virtual; that is no objects may be created.
}
\section{Slots}{
-% \describe{
-% \item{\code{CallL2Fam}:}{Object of class \code{"call"}:
-% creates an object of the underlying L2-differentiable
-% parametric family. }
-% }
+ \describe{
+ \item{\code{name}:}{Object of class \code{"character"}:
+ name of the control object. }
+ }
}
-%\section{Extends}{
-%Class \code{"InfluenceCurve"}, directly.
-%}
\section{Methods}{
\describe{
\item{name}{\code{signature(object = "RobAStControl")}:
@@ -39,11 +36,7 @@
}
\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
%\note{}
-\seealso{
-%
-}
-\examples{
-%
-}
+%\seealso{}
+%\examples{}
\concept{influence curve}
\keyword{classes}
Modified: pkg/RobAStBase/man/RobWeight-class.Rd
===================================================================
--- pkg/RobAStBase/man/RobWeight-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/RobWeight-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -48,7 +48,8 @@
%\note{}
\seealso{\code{\link{InfluenceCurve-class}}, \code{\link{IC}}}
\examples{
-%
+## prototype
+new("RobWeight")
}
\concept{influence curve}
\keyword{classes}
Modified: pkg/RobAStBase/man/TotalVarIC-class.Rd
===================================================================
--- pkg/RobAStBase/man/TotalVarIC-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/TotalVarIC-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -11,6 +11,7 @@
\alias{clipUp<-}
\alias{clipUp<-,TotalVarIC-method}
\alias{lowerCase<-,TotalVarIC-method}
+\alias{neighbor,TotalVarIC-method}
\alias{show,TotalVarIC-method}
\alias{stand<-,TotalVarIC-method}
\alias{generateIC,TotalVarNeighborhood,L2ParamFamily-method}
@@ -39,6 +40,12 @@
\item{\code{Curve}:}{ object of class \code{"EuclRandVarList"}.}
+ \item{\code{modifyIC}:}{ Object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This slot is mainly used for internal
+ computations! }
+
\item{\code{Risks}:}{ object of class \code{"list"}:
list of risks; cf. \code{\link[distrMod]{RiskType-class}}. }
@@ -58,6 +65,12 @@
\item{\code{weight}:}{ object of class \code{"BdStWeight"}:
weight function }
+ \item{\code{biastype}:}{ object of class \code{"BiasType"}:
+ bias type (symmetric/onsided/asymmetric) }
+
+ \item{\code{normtype}:}{ object of class \code{"NormType"}:
+ norm type (Euclidean, information/self-standardized)}
+
\item{\code{neighborRadius}:}{ object of class \code{"numeric"}:
radius of the corresponding (unconditional) contamination
neighborhood. }
@@ -88,6 +101,13 @@
\item{stand<-}{\code{signature(object = "TotalVarIC")}:
replacement function for slot \code{stand}. }
+ \item{lowerCase<-}{\code{signature(object = "TotalVarIC")}:
+ replacement function for slot \code{lowerCase}. }
+
+ \item{neighbor}{\code{signature(object = "TotalVarIC")}:
+ generates an object of class \code{"TotalVarNeighborhood"} with
+ radius given in slot \code{neighborRadius}. }
+
\item{generateIC}{\code{signature(neighbor = "TotalVarNeighborhood", L2Fam = "L2ParamFamily")}:
generate an object of class \code{"TotalVarIC"}. Rarely called directly. }
@@ -109,3 +129,4 @@
}
\concept{influence curve}
\keyword{classes}
+\keyword{robust}
Modified: pkg/RobAStBase/man/TotalVarIC.Rd
===================================================================
--- pkg/RobAStBase/man/TotalVarIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/TotalVarIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -16,7 +16,9 @@
Curve = EuclRandVarList(RealRandVariable(Map = c(function(x) {x}),
Domain = Reals())),
Risks, Infos, clipLo = -Inf, clipUp = Inf, stand = as.matrix(1),
- lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight"))
+ lowerCase = NULL, neighborRadius = 0, w = new("BdStWeight"),
+ normtype = NormType(), biastype = symmetricBias(),
+ modifyIC = NULL)
}
\arguments{
\item{name}{ object of class \code{"character"}. }
@@ -35,6 +37,13 @@
\item{lowerCase}{ optional constant for lower case solution. }
\item{neighborRadius}{ radius of the corresponding (unconditional)
contamination neighborhood. }
+ \item{biastype}{ BiasType: type of the bias}
+ \item{normtype}{ NormType: type of the norm}
+ \item{modifyIC}{ object of class \code{"OptionalFunction"}:
+ function of two arguments, which are an L2 parametric family
+ and an optional influence curve. Returns an object of
+ class \code{"IC"}. This function is mainly used for internal
+ computations! }
}
%\details{}
\value{Object of class \code{"TotalVarIC"}}
@@ -52,4 +61,4 @@
plot(IC1)
}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/checkIC.Rd
===================================================================
--- pkg/RobAStBase/man/checkIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/checkIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -33,4 +33,4 @@
checkIC(IC1)
}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/comparePlot.Rd
===================================================================
--- pkg/RobAStBase/man/comparePlot.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/comparePlot.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -39,4 +39,4 @@
comparePlot(IC1,IC2)
}
}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/evalIC.Rd
===================================================================
--- pkg/RobAStBase/man/evalIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/evalIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -27,4 +27,4 @@
\seealso{\code{\link{IC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/generateIC.Rd
===================================================================
--- pkg/RobAStBase/man/generateIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/generateIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -27,4 +27,4 @@
\seealso{\code{\link{IC-class}}, \code{\link{ContIC-class}}, \code{\link{TotalVarIC-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/generateICfct.Rd
===================================================================
--- pkg/RobAStBase/man/generateICfct.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/generateICfct.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -30,8 +30,6 @@
\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
%\note{}
\seealso{\code{\link[distrMod]{L2ParamFamily-class}}, \code{\link{IC-class}}}
-\examples{
-%
-}
+%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/getBiasIC.Rd
===================================================================
--- pkg/RobAStBase/man/getBiasIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/getBiasIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -23,7 +23,7 @@
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{numbeval}{number of evalation points.}
}
-\details{}
+%\details{}
\value{The bias of the IC is computed.}
\section{Methods}{
\describe{
@@ -63,4 +63,4 @@
\seealso{\code{\link{getRiskIC-methods}}, \code{\link{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/getRiskIC.Rd
===================================================================
--- pkg/RobAStBase/man/getRiskIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/getRiskIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -119,4 +119,4 @@
\seealso{\code{\link[ROptEst]{getRiskIC-methods}}, \code{\link{InfRobModel-class}}}
%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/getweight.Rd
===================================================================
--- pkg/RobAStBase/man/getweight.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/getweight.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -75,9 +75,6 @@
\seealso{\code{\link{BdStWeight-class}},
\code{\link{HampelWeight-class}},
\code{\link{IC-class}}}
-\examples{
-%
-}
-
+%\examples{}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- pkg/RobAStBase/man/infoPlot.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/infoPlot.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -33,4 +33,4 @@
}
\concept{absolute information}
\concept{relative information}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/kStepEstimate-class.Rd
===================================================================
--- pkg/RobAStBase/man/kStepEstimate-class.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/kStepEstimate-class.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -3,6 +3,7 @@
\alias{kStepEstimate-class}
\alias{steps}
\alias{steps,kStepEstimate-method}
+\alias{show,kStepEstimate-method}
\title{kStepEstimate-class.}
\description{Class of asymptotically linear estimates.}
@@ -17,8 +18,16 @@
name of the estimator. }
\item{\code{estimate}:}{Object of class \code{"ANY"}:
estimate. }
+ \item{\code{samplesize}:}{Object of class \code{"numeric"}:
+ sample size. }
+ \item{\code{asvar}:}{Optional object of class \code{"matrix"}:
+ asymptotic variance. }
+ \item{\code{asbias}:}{Optional object of class \code{"numeric"}:
+ asymptotic bias. }
\item{\code{pIC}:}{Optional object of class \code{InfluenceCurve}:
influence curve. }
+ \item{\code{nuis.idx}:}{ object of class \code{"OptionalNumeric"}:
+ indices of \code{estimate} belonging to the nuisance part. }
\item{\code{steps}:}{Object of class \code{"integer"}: number
of steps. }
\item{\code{Infos}:}{ object of class \code{"matrix"}
@@ -34,6 +43,8 @@
\describe{
\item{steps}{\code{signature(object = "kStepEstimate")}:
accessor function for slot \code{steps}. }
+
+ \item{show}{\code{signature(object = "kStepEstimate")} }
}
}
%\references{}
Copied: pkg/RobAStBase/man/kStepEstimator.Rd (from rev 157, branches/robast-0.6/pkg/RobAStBase/man/kStepEstimator.Rd)
===================================================================
--- pkg/RobAStBase/man/kStepEstimator.Rd (rev 0)
+++ pkg/RobAStBase/man/kStepEstimator.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -0,0 +1,83 @@
+\name{kStepEstimator}
+\alias{kStepEstimator}
+\alias{kStepEstimator-methods}
+\alias{kStepEstimator,numeric,IC,numeric-method}
+\alias{kStepEstimator,matrix,IC,numeric-method}
+\alias{kStepEstimator,numeric,IC,Estimate-method}
+\alias{kStepEstimator,matrix,IC,Estimate-method}
+
+\title{Generic function for the computation of k-step estimates}
+\description{
+ Generic function for the computation of k-step estimates.
+}
+\usage{
+kStepEstimator(x, IC, start, ...)
+
+\S4method{kStepEstimator}{numeric,IC,numeric}(x, IC, start, steps = 1L,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{kStepEstimator}{matrix,IC,numeric}(x, IC, start, steps = 1L,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{kStepEstimator}{numeric,IC,Estimate}(x, IC, start, steps = 1L,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{kStepEstimator}{matrix,IC,Estimate}(x, IC, start, steps = 1L,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+}
+\arguments{
+ \item{x}{ sample }
+ \item{IC}{ object of class \code{"IC"} }
+ \item{start}{ initial estimate }
+ \item{steps}{ integer: number of steps }
+ \item{useLast}{ which parameter estimate (initial estimate or
+ k-step estimate) shall be used to fill the slots \code{pIC},
+ \code{asvar} and \code{asbias} of the return value. }
+ \item{...}{ additional parameters }
+}
+\details{
+ Given an initial estimation \code{start}, a sample \code{x}
+ and an influence curve \code{IC} the corresponding k-step
+ estimator is computed.
+
+ The default value of argument \code{useLast} is set by the
+ global option \code{kStepUseLast} which by default is set to
+ \code{FALSE}. In case of general models \code{useLast}
+ remains unchanged during the computations. However, if
+ slot \code{CallL2Fam} of \code{IC} generates an object of
+ class \code{"L2GroupParamFamily"} the value of \code{useLast}
+ is changed to \code{TRUE}.
+ Explicitly setting \code{useLast} to \code{TRUE} should
+ be done with care as in this situation the influence curve
+ is re-computed using the value of the one-step estimate
+ which may take quite a long time depending on the model.
+
+ If \code{useLast} is set to \code{TRUE} and slot \code{modifyIC}
+ of \code{IC} is filled with some function (which can be
+ used to re-compute the IC for a different parameter), the
+ computation of \code{asvar}, \code{asbias} and \code{IC} is
+ based on the k-step estimate.
+}
+\value{Object of class \code{"kStepEstimate"}.}
+\section{Methods}{
+\describe{
+ \item{x = "numeric", IC = "IC", start = "numeric"}{
+ univariate samples. }
+ \item{x = "matrix", IC = "IC", start = "numeric"}{
+ multivariate samples. }
+ \item{x = "matrix", IC = "IC", start = "Estimate"}{
+ multivariate samples. }
+ \item{x = "matrix", IC = "IC", start = "Estimate"}{
+ multivariate samples. }
+}}
+\references{
+ Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.
+
+ Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
+ Bayreuth: Dissertation.
+}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{\code{\link{IC-class}}, \code{\link{kStepEstimate-class}} }
+%\examples{}
+\concept{k-step estimator}
+\concept{estimator}
+\keyword{univar}
+\keyword{robust}
Modified: pkg/RobAStBase/man/locMEstimator.Rd
===================================================================
--- pkg/RobAStBase/man/locMEstimator.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/locMEstimator.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -18,9 +18,10 @@
\item{\dots}{ additional parameters }
\item{eps}{ the desired accuracy (convergence tolerance). }
}
-%\details{}
+\details{ Given some sample \code{x} and some influence curve \code{IC}
+ an M estimate is computed by solving the corresponding
+ M equation. }
\value{Object of class \code{"MEstimate"}}
-}
\section{Methods}{
\describe{
\item{x = "numeric", IC = "InfluenceCurve"}{ univariate location. }
Modified: pkg/RobAStBase/man/makeIC-methods.Rd
===================================================================
--- pkg/RobAStBase/man/makeIC-methods.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/makeIC-methods.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -33,9 +33,26 @@
%\note{}
\seealso{\code{\link[distrMod]{L2ParamFamily-class}}, \code{\link{IC-class}}}
\examples{
+## default IC
IC1 <- new("IC")
+
+## L2-differentiable parametric family
B <- BinomFamily(13, 0.3)
-makeIC(IC1,B)
+
+## check IC properties
+checkIC(IC1, B)
+
+## make IC
+IC2 <- makeIC(IC1, B)
+
+## check IC properties
+checkIC(IC2)
+
+## slot modifyIC is filled in case of IC2
+IC3 <- modifyIC(IC2)(BinomFamily(13, 0.2), IC2)
+checkIC(IC3)
+## identical to
+checkIC(IC3, BinomFamily(13, 0.2))
}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobAStBase/man/oneStepEstimator.Rd
===================================================================
--- pkg/RobAStBase/man/oneStepEstimator.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/oneStepEstimator.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -11,19 +11,54 @@
Generic function for the computation of one-step estimates.
}
\usage{
-oneStepEstimator(x, IC, start)
+oneStepEstimator(x, IC, start, ...)
+
+\S4method{oneStepEstimator}{numeric,InfluenceCurve,numeric}(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{oneStepEstimator}{matrix,InfluenceCurve,numeric}(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{oneStepEstimator}{numeric,InfluenceCurve,Estimate}(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
+\S4method{oneStepEstimator}{matrix,InfluenceCurve,Estimate}(x, IC, start,
+ useLast = getRobAStBaseOption("kStepUseLast"))
}
\arguments{
\item{x}{ sample }
\item{IC}{ object of class \code{"InfluenceCurve"} }
\item{start}{ initial estimate }
+ \item{useLast}{ which parameter estimate (initial estimate or
+ one-step estimate) shall be used to fill the slots \code{pIC},
+ \code{asvar} and \code{asbias} of the return value. }
+ \item{...}{ additional arguments }
}
\details{
Given an initial estimation \code{start}, a sample \code{x}
and an influence curve \code{IC} the corresponding one-step
- estimator is computed
+ estimator is computed.
+
+ In case \code{IC} is an object of class \code{"IC"}
+ the slots \code{asvar} and \code{asbias} of the return
+ value are filled (based on the initial estimate).
+
+ The default value of argument \code{useLast} is set by the
+ global option \code{kStepUseLast} which by default is set to
+ \code{FALSE}. In case of general models \code{useLast}
+ remains unchanged during the computations. However, if
+ slot \code{CallL2Fam} of \code{IC} generates an object of
+ class \code{"L2GroupParamFamily"} the value of \code{useLast}
+ is changed to \code{TRUE}.
+ Explicitly setting \code{useLast} to \code{TRUE} should
+ be done with care as in this situation the influence curve
+ is re-computed using the value of the one-step estimate
+ which may take quite a long time depending on the model.
+
+ If \code{useLast} is set to \code{TRUE} and slot \code{modifyIC}
+ of \code{IC} is filled with some function (which can be
+ used to re-compute the IC for a different parameter), the
+ computation of \code{asvar}, \code{asbias} and \code{IC} is
+ based on the one-step estimate.
}
-\value{The one-step estimation is computed.}
+\value{Object of class \code{"kStepEstimate"}}
\section{Methods}{
\describe{
\item{x = "numeric", IC = "InfluenceCurve", start = "numeric"}{
@@ -43,7 +78,7 @@
}
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
%\note{}
-\seealso{\code{\link{InfluenceCurve-class}}}
+\seealso{\code{\link{InfluenceCurve-class}}, \code{\link{kStepEstimate-class}} }
%\examples{}
\concept{one-step estimator}
\concept{estimator}
Modified: pkg/RobAStBase/man/optIC.Rd
===================================================================
--- pkg/RobAStBase/man/optIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobAStBase/man/optIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -47,4 +47,4 @@
}
\concept{robust influence curve}
\concept{influence curve}
-\keyword{}
+\keyword{robust}
Modified: pkg/RobLox/DESCRIPTION
===================================================================
--- pkg/RobLox/DESCRIPTION 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/DESCRIPTION 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,6 +1,6 @@
Package: RobLox
Version: 0.6.0
-Date: 2008-07-28
+Date: 2008-08-04
Title: Optimally robust influence curves for location and scale
Description: functions for the determination of optimally
robust influence curves in case of normal
Modified: pkg/RobLox/R/colRoblox.R
===================================================================
--- pkg/RobLox/R/colRoblox.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/colRoblox.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -2,6 +2,7 @@
## Evaluate roblox on columns of a matrix
###############################################################################
colRoblox <- function(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1){
+ call.est <- match.call()
if(missing(x))
stop("'x' is missing with no default")
if(is.data.frame(x))
@@ -12,6 +13,8 @@
stop("'x' has to be a matrix resp. convertable to a matrix by 'as.matrix'
or 'data.matrix'")
- return(rowRoblox(x = t(x), mean = mean, sd = sd, eps = eps, eps.lower = eps.lower,
- eps.upper = eps.upper, initial.est = initial.est, k = k))
+ res <- rowRoblox(x = t(x), mean = mean, sd = sd, eps = eps, eps.lower = eps.lower,
+ eps.upper = eps.upper, initial.est = initial.est, k = k)
+ res at estimate.call <- call.est
+ return(res)
}
Modified: pkg/RobLox/R/rlOptIC.R
===================================================================
--- pkg/RobLox/R/rlOptIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/rlOptIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -18,12 +18,24 @@
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ if(is(L2Fam, "L2LocationFamily") && is(distribution(L2Fam), "Norm")){
+ CallL2Fam(IC) <- L2Fam at fam.call
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+
+ L2Fam <- substitute(NormLocationFamily(mean = m1, sd = s1),
+ list(m1 = mean, s1 = sd))
return(generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationFamily(mean = mean, sd = sd),
+ L2Fam = eval(L2Fam),
res = list(A = as.matrix(A), a = 0, b = b, d = NULL,
risk = list(asMSE = A, asBias = b, asCov = A - r^2*b^2),
info = c("rlOptIC", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType())))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC)))
}else{
return(list(A = A, a = 0, b = b))
}
Modified: pkg/RobLox/R/rlsOptIC_AL.R
===================================================================
--- pkg/RobLox/R/rlsOptIC_AL.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/rlsOptIC_AL.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -27,7 +27,7 @@
###############################################################################
## computation of a1, a2 and a3
###############################################################################
-.ALrlsGeta1a2a3 <- function(b, a1, a2, a3, inteps=1e-12){
+.ALrlsGeta1a2a3 <- function(b, a1, a2, a3){
integrand1 <- function(x, b, a1, a2, a3){
x^2*.ALrlsGetw(x, b, a1, a2, a3)*dnorm(x)
}
@@ -54,8 +54,27 @@
return(list(a1=a1, a2=a2, a3=a3))
}
+.ALrlsVar <- function(b, a1, a2, a3){
+ integrand1 <- function(x, b, a1, a2, a3){
+ x^2*.ALrlsGetw(x, b, a1, a2, a3)^2*dnorm(x)
+ }
+ Int1 <- 2*integrate(integrand1, lower = 0, upper = Inf,
+ rel.tol = .Machine$double.eps^0.5, b = b, a1 = a1,
+ a2 = a2, a3 = a3)$value
+ V1 <- a1^2*Int1
+ integrand2 <- function(x, b, a1, a2, a3){
+ (x^2 - a2)^2*.ALrlsGetw(x, b, a1, a2, a3)^2*dnorm(x)
+ }
+ Int2 <- 2*integrate(integrand2, lower = 0, upper = Inf,
+ rel.tol = .Machine$double.eps^0.5, b = b, a1 = a1,
+ a2 = a2, a3 = a3)$value
+ V2 <- a3^2*Int2
+ return(diag(c(V1, V2)))
+}
+
+
###############################################################################
## optimal IC
###############################################################################
@@ -78,7 +97,9 @@
a1.old <- a1; a2.old <- a2; a3.old <- a3; b.old <- b
a1a2a3 <- .ALrlsGeta1a2a3(b = b, a1 = a1, a2 = a2, a3 = a3)
- a1 <- a1a2a3$a1; a2 <- a1a2a3$a2; a3 <- a1a2a3$a3
+ a1 <- a1a2a3$a1
+ a2 <- a1a2a3$a2
+ a3 <- a1a2a3$a3
b <- uniroot(.ALrlsGetr, lower = 1e-4, upper = bUp,
tol = .Machine$double.eps^0.5, r = r, a1 = a1, a2 = a2,
@@ -120,6 +141,7 @@
cat("MSE equation:\t", ch4, "\n")
}
+ asVar <- sd^2*.ALrlsVar(b = b, a1 = a1, a2 = a2, a3 = a3)
A <- sd^2*diag(c(a1, a3))
a <- sd*c(0, a3*(a2-1))
b <- sd*b
@@ -129,18 +151,58 @@
if(computeIC){
w <- new("HampelWeight")
clip(w) <- b
- cent(w) <- c(0, a2-1)
+ cent(w) <- c(0, a2-1)/sd
stand(w) <- A
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)[2]
+ sdalt <- main(ICL2Fam)[2]
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = neighborRadius(IC)),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ mse <- sum(diag(A))
+ r <- neighborRadius(IC)
+ a1 <- A[1, 1]/sdneu^2
+ a3 <- A[2, 2]/sdneu^2
+ a2 <- a[1]/sd/a3 + 1
+ asVar <- sd^2*.ALrlsVar(b = b/sd, a1 = a1, a2 = a2, a3 = a3)
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = mse, asBias = b, trAsCov = mse - r^2*b^2,
+ asCov = asVar),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+
+ L2Fam <- substitute(NormLocationScaleFamily(mean = m1, sd = s1),
+ list(m1 = mean, s1 = sd))
return(generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationScaleFamily(mean = mean, sd = sd),
+ L2Fam = eval(L2Fam),
res = list(A = as.matrix(A), a = a, b = b, d = NULL,
- risk = list(asMSE = mse, asBias = b, trAsCov = mse - r^2*b^2),
+ risk = list(asMSE = mse, asBias = b, trAsCov = mse - r^2*b^2,
+ asCov = asVar),
info = c("rlOptIC", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType())))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC)))
}else{
return(list(A = A, a = a, b = b))
}
Modified: pkg/RobLox/R/roblox.R
===================================================================
--- pkg/RobLox/R/roblox.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/roblox.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -113,9 +113,7 @@
}
.kstep.sc <- function(x, initial.est, A, a, b, mean, k){
est <- .onestep.sc(x = x, initial.est = initial.est, A = A, a = a, b = b, mean = mean)
- if(k == 1){
- return(est)
- }else{
+ if(k > 1){
for(i in 2:k){
A <- est^2*A/initial.est^2
a <- est*a/initial.est
@@ -123,8 +121,12 @@
initial.est <- est
est <- .onestep.sc(x = x, initial.est = est, A = A, a = a, b = b, mean = mean)
}
- return(est)
}
+ A <- est^2*A/initial.est^2
+ a <- est*a/initial.est
+ b <- est*b/initial.est
+
+ return(list(est = est, A = A, a = a, b = b))
}
.onestep.locsc <- function(x, initial.est, A1, A2, a, b){
mean <- initial.est[1]
@@ -137,9 +139,7 @@
}
.kstep.locsc <- function(x, initial.est, A1, A2, a, b, mean, k){
est <- .onestep.locsc(x = x, initial.est = initial.est, A1 = A1, A2 = A2, a = a, b = b)
- if(k == 1){
- return(est)
- }else{
+ if(k > 1){
for(i in 2:k){
A1 <- est[2]^2*A1/initial.est[2]^2
A2 <- est[2]^2*A2/initial.est[2]^2
@@ -148,8 +148,17 @@
initial.est <- est
est <- .onestep.locsc(x = x, initial.est = est, A1 = A1, A2 = A2, a = a, b = b)
}
- return(est)
}
+ A1 <- est[2]^2*A1/initial.est[2]^2
+ A2 <- est[2]^2*A2/initial.est[2]^2
+ a <- est[2]*a/initial.est[2]
+ b <- est[2]*b/initial.est[2]
+ a1 <- A1/est[2]^2
+ a3 <- A2/est[2]^2
+ a2 <- a[2]/est[2]/a3 + 1
+ asVar <- est[2]^2*.ALrlsVar(b = b, a1 = a1, a2 = a2, a3 = a3)
+
+ return(list(est = est, A1 = A1, A2 = A2, a = a, b = b, asvar = asVar))
}
@@ -158,6 +167,7 @@
###############################################################################
roblox <- function(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1,
returnIC = FALSE){
+ es.call <- match.call()
if(missing(x))
stop("'x' is missing with no default")
if(!is.numeric(x)){
@@ -195,13 +205,14 @@
if((eps < 0) || (eps > 0.5))
stop("'eps' has to be in (0, 0.5]")
}
+ if(!is.integer(k))
+ k <- as.integer(k)
if(k < 1){
- stop("'k' has to be some positive integer value")
+ stop("'k' has to be some positive integer value")
}
if(length(k) != 1){
- stop("'k' has to be of length 1")
+ stop("'k' has to be of length 1")
}
- k <- as.integer(k)
if(missing(mean) && missing(sd)){
if(missing(initial.est)){
@@ -236,30 +247,77 @@
mse <- A1 + A2
}
robEst <- .kstep.locsc(x = x, initial.est = c(mean, sd), A1 = A1, A2 = A2, a = a, b = b, k = k)
- names(robEst) <- c("mean", "sd")
+ names(robEst$est) <- c("mean", "sd")
Info.matrix <- matrix(c("roblox",
paste("optimally robust estimate for contamination 'eps' =", round(eps, 3),
"and 'asMSE'")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
w <- new("HampelWeight")
- clip(w) <- b
- cent(w) <- a/A2
- stand(w) <- diag(c(A1, A2))
+ clip(w) <- robEst$b
+ cent(w) <- robEst$a/robEst$A2
+ stand(w) <- diag(c(robEst$A1, robEst$A2))
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ mse <- robEst$A1 + robEst$A2
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)[2]
+ sdalt <- main(ICL2Fam)[2]
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ a <- sdneu*cent(IC)/sdalt
+ mse <- sum(diag(A))
+ a1 <- A[1, 1]/sdneu^2
+ a3 <- A[2, 2]/sdneu^2
+ a2 <- a[2]/sdneu/a3 + 1
+ asVar <- sdneu^2*.ALrlsVar(b = b/sdneu, a1 = a1, a2 = a2, a3 = a3)
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = mse, asBias = b,
+ trAsCov = mse - r^2*b^2,
+ asCov = asVar), info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormLocationScaleFamily(mean = m1, sd = s1),
+ list(m1 = robEst$est[1], s1 = robEst$est[2]))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationScaleFamily(mean = mean, sd = sd),
- res = list(A = diag(c(A1, A2)), a = a, b = b, d = NULL,
- risk = list(asMSE = mse, asBias = b, asCov = mse - r^2*b^2),
+ L2Fam = eval(L2Fam),
+ res = list(A = diag(c(robEst$A1, robEst$A2)), a = robEst$a,
+ b = robEst$b, d = NULL,
+ risk = list(asMSE = mse, asBias = robEst$b,
+ trAsCov = mse - r^2*robEst$b^2,
+ asCov = robEst$asVar),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
- return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
+ return(new("kStepEstimate", name = "Optimally robust estimate",
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = robEst$asvar,
+ asbias = r*robEst$b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
- return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ return(new("kStepEstimate", name = "Optimally robust estimate",
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = robEst$asvar,
+ asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -296,7 +354,7 @@
}
}
robEst <- .kstep.locsc(x = x, initial.est = c(mean, sd), A1 = A1, A2 = A2, a = a, b = b, k = k)
- names(robEst) <- c("mean", "sd")
+ names(robEst$est) <- c("mean", "sd")
Info.matrix <- matrix(c(rep("roblox", 3),
paste("radius-minimax estimate for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -305,29 +363,76 @@
ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
w <- new("HampelWeight")
- clip(w) <- b
- cent(w) <- a/A2
- stand(w) <- diag(c(A1, A2))
+ clip(w) <- robEst$b
+ cent(w) <- robEst$a/robEst$A2
+ stand(w) <- diag(c(robEst$A1, robEst$A2))
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ mse <- robEst$A1 + robEst$A2
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)[2]
+ sdalt <- main(ICL2Fam)[2]
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ a <- sdneu*cent(IC)/sdalt
+ mse <- sum(diag(A))
+ a1 <- A[1, 1]/sdneu^2
+ a3 <- A[2, 2]/sdneu^2
+ a2 <- a[2]/sdneu/a3 + 1
+ asVar <- sdneu^2*.ALrlsVar(b = b/sdneu, a1 = a1, a2 = a2, a3 = a3)
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = mse, asBias = b,
+ trAsCov = mse - r^2*b^2,
+ asCov = asVar), info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormLocationScaleFamily(mean = m1, sd = s1),
+ list(m1 = robEst$est[1], s1 = robEst$est[2]))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationScaleFamily(mean = mean, sd = sd),
- res = list(A = diag(c(A1, A2)), a = a, b = b, d = NULL,
- risk = list(asMSE = mse, asBias = b, asCov = mse - r^2*b^2),
+ L2Fam = eval(L2Fam),
+ res = list(A = diag(c(robEst$A1, robEst$A2)), a = robEst$a,
+ b = robEst$b, d = NULL,
+ risk = list(asMSE = mse, asBias = robEst$b,
+ trAsCov = mse - r^2*robEst$b^2,
+ asCov = robEst$asvar),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
Infos(IC1) <- matrix(c(rep("roblox", 3),
paste("radius-minimax IC for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
paste("least favorable contamination: ", round(r/sqrtn, 3), sep = ""),
paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
- return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ return(new("kStepEstimate", name = "Optimally robust estimate",
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = robEst$asvar,
+ asbias = r*robEst$b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
- return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ return(new("kStepEstimate", name = "Optimally robust estimate",
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = robEst$asvar,
+ asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}else{
if(missing(mean)){
@@ -364,19 +469,36 @@
cent(w) <- 0
stand(w) <- as.matrix(A)
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
- biastype = symmetricBias(),
- normW = NormType())
+ biastype = symmetricBias(),
+ normW = NormType())
+ modIC <- function(L2Fam, IC){
+ if(is(L2Fam, "L2LocationFamily") && is(distribution(L2Fam), "Norm")){
+ CallL2New <- call("NormLocationFamily",
+ mean = main(L2Fam))
+ CallL2Fam(IC) <- CallL2New
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormLocationFamily(mean = m1, sd = s1),
+ list(m1 = robEst, s1 = sd))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationFamily(mean = mean, sd = sd),
+ L2Fam = eval(L2Fam),
res = list(A = as.matrix(A), a = 0, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = b^2),
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = length(x), asvar = as.matrix(A-r^2*b^2),
+ asbias = r*b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = length(x), asvar = as.matrix(A-r^2*b^2),
+ asbias = r*b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -420,12 +542,25 @@
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ if(is(L2Fam, "L2LocationFamily") && is(distribution(L2Fam), "Norm")){
+ CallL2New <- call("NormLocationFamily",
+ mean = main(L2Fam))
+ CallL2Fam(IC) <- CallL2New
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormLocationFamily(mean = m1, sd = s1),
+ list(m1 = robEst, s1 = sd))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormLocationFamily(mean = mean, sd = sd),
+ L2Fam = eval(L2Fam),
res = list(A = as.matrix(A), a = 0, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = b^2),
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
Infos(IC1) <- matrix(c(rep("roblox", 3),
paste("radius-minimax IC for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -433,10 +568,14 @@
paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = length(x), asvar = as.matrix(A-r^2*b^2),
+ asbias = r*b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = length(x), asvar = as.matrix(A-r^2*b^2),
+ asbias = r*b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}
if(missing(sd)){
@@ -467,30 +606,67 @@
b <- sd*.getb.sc(r)
}
robEst <- .kstep.sc(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
- names(robEst) <- "sd"
+ names(robEst$est) <- "sd"
Info.matrix <- matrix(c("roblox",
paste("optimally robust estimate for contamination 'eps' =", round(eps, 3),
"and 'asMSE'")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
w <- new("HampelWeight")
- clip(w) <- b
- cent(w) <- a/A
- stand(w) <- as.matrix(A)
+ clip(w) <- robEst$b
+ cent(w) <- robEst$a/robEst$A
+ stand(w) <- as.matrix(robEst$A)
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)
+ sdalt <- main(ICL2Fam)
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormScaleFamily(mean = m1, sd = s1),
+ list(m1 = mean, s1 = robEst$est))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormScaleFamily(mean = mean, sd = sd),
- res = list(A = as.matrix(A), a = a, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = b^2),
+ L2Fam = eval(L2Fam),
+ res = list(A = as.matrix(robEst$A), a = robEst$a, b = robEst$b, d = NULL,
+ risk = list(asMSE = robEst$A, asBias = robEst$b,
+ asCov = robEst$A-r^2*robEst$b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = as.matrix(robEst$A-r^2*robEst$b^2),
+ asbias = r*robEst$b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = as.matrix(robEst$A-r^2*robEst$b^2),
+ asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(length(x))
rlo <- sqrtn*eps.lower
@@ -521,7 +697,7 @@
}
}
robEst <- .kstep.sc(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
- names(robEst) <- "sd"
+ names(robEst$est) <- "sd"
Info.matrix <- matrix(c(rep("roblox", 3),
paste("radius-minimax estimate for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -530,18 +706,51 @@
ncol = 2, dimnames = list(NULL, c("method", "message")))
if(returnIC){
w <- new("HampelWeight")
- clip(w) <- b
- cent(w) <- a/A
- stand(w) <- as.matrix(A)
+ clip(w) <- robEst$b
+ cent(w) <- robEst$a/robEst$A
+ stand(w) <- as.matrix(robEst$A)
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)
+ sdalt <- main(ICL2Fam)
+ r <- neighborRadius(IC)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ res <- list(A = A, a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = A, asBias = b, asCov = A-r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = r),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(L2Fam, IC)
+ }
+ }
+ L2Fam <- substitute(NormScaleFamily(mean = m1, sd = s1),
+ list(m1 = mean, s1 = robEst$est))
IC1 <- generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormScaleFamily(mean = mean, sd = sd),
- res = list(A = as.matrix(A), a = a, b = b, d = NULL,
- risk = list(asMSE = A, asBias = b, asCov = b^2),
+ L2Fam = eval(L2Fam),
+ res = list(A = as.matrix(robEst$A), a = robEst$a, b = robEst$b, d = NULL,
+ risk = list(asMSE = robEst$A, asBias = robEst$b,
+ asCov = robEst$A-r^2*robEst$b^2),
info = c("roblox", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType()))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC))
Infos(IC1) <- matrix(c(rep("roblox", 3),
paste("radius-minimax IC for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -549,10 +758,14 @@
paste("maximum MSE-inefficiency: ", round(ineff, 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = IC1, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = as.matrix(robEst$A-r^2*robEst$b^2),
+ asbias = r*robEst$b, steps = k, pIC = IC1, Infos = Info.matrix))
}else
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = length(x), asvar = as.matrix(robEst$A-r^2*robEst$b^2),
+ asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}
}
Modified: pkg/RobLox/R/rowRoblox.R
===================================================================
--- pkg/RobLox/R/rowRoblox.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/rowRoblox.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -22,9 +22,7 @@
}
.kstep.sc.matrix <- function(x, initial.est, A, a, b, mean, k){
est <- .onestep.sc.matrix(x = x, initial.est = initial.est, A = A, a = a, b = b, mean = mean)
- if(k == 1){
- return(est)
- }else{
+ if(k > 1){
for(i in 2:k){
A <- est^2*A/initial.est^2
a <- est*a/initial.est
@@ -32,8 +30,11 @@
initial.est <- est
est <- .onestep.sc.matrix(x = x, initial.est = est, A = A, a = a, b = b, mean = mean)
}
- return(est)
}
+ A <- est^2*A/initial.est^2
+ a <- est*a/initial.est
+ b <- est*b/initial.est
+ return(list(est = est, A = A, a = a, b = b))
}
.onestep.locsc.matrix <- function(x, initial.est, A1, A2, a, b){
mean <- initial.est[,1]
@@ -48,9 +49,7 @@
}
.kstep.locsc.matrix <- function(x, initial.est, A1, A2, a, b, mean, k){
est <- .onestep.locsc.matrix(x = x, initial.est = initial.est, A1 = A1, A2 = A2, a = a, b = b)
- if(k == 1){
- return(est)
- }else{
+ if(k > 1){
for(i in 2:k){
A1 <- est[,2]^2*A1/initial.est[,2]^2
A2 <- est[,2]^2*A2/initial.est[,2]^2
@@ -59,8 +58,13 @@
initial.est <- est
est <- .onestep.locsc.matrix(x = x, initial.est = est, A1 = A1, A2 = A2, a = a, b = b)
}
- return(est)
}
+ A1 <- est[,2]^2*A1/initial.est[,2]^2
+ A2 <- est[,2]^2*A2/initial.est[,2]^2
+ a <- est[,2]*a/initial.est[,2]
+ b <- est[,2]*b/initial.est[,2]
+
+ return(list(est = est, A1 = A1, A2 = A2, a = a, b = b))
}
@@ -68,6 +72,7 @@
## Evaluate roblox on rows of a matrix
###############################################################################
rowRoblox <- function(x, mean, sd, eps, eps.lower, eps.upper, initial.est, k = 1){
+ es.call <- match.call()
if(missing(x))
stop("'x' is missing with no default")
if(is.data.frame(x))
@@ -148,13 +153,19 @@
}
robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
A1 = A1, A2 = A2, a = a, b = b, k = k)
- colnames(robEst) <- c("mean", "sd")
+ colnames(robEst$est) <- c("mean", "sd")
Info.matrix <- matrix(c("roblox",
paste("optimally robust estimates for contamination 'eps' =", round(eps, 3),
"and 'asMSE'")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = NULL,
+# asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(ncol(x))
rlo <- sqrtn*eps.lower
@@ -192,7 +203,7 @@
}
robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd),
A1 = A1, A2 = A2, a = a, b = b, k = k)
- colnames(robEst) <- c("mean", "sd")
+ colnames(robEst$est) <- c("mean", "sd")
Info.matrix <- matrix(c(rep("roblox", 3),
paste("radius-minimax estimates for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -200,7 +211,13 @@
paste("maximum MSE-inefficiency: ", round(ineff[1], 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est, #
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = NULL,
+# asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}else{
if(missing(mean)){
@@ -219,6 +236,8 @@
stop("'initial.est' has wrong dimension")
mean <- initial.est
}
+ if(length(sd) == 1)
+ sd <- rep(sd, length(mean))
if(!missing(eps)){
r <- sqrt(ncol(x))*eps
@@ -236,7 +255,13 @@
"and 'asMSE'")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = as.matrix(A - r^2*b^2),
+# asbias = r*b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(ncol(x))
rlo <- sqrtn*eps.lower
@@ -273,7 +298,13 @@
paste("maximum MSE-inefficiency: ", round(ineff[1], 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst,
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = as.matrix(A - r^2*b^2),
+# asbias = r*b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}
if(missing(sd)){
@@ -308,14 +339,21 @@
a <- sd*.geta.sc(r)
b <- sd*.getb.sc(r)
}
- robEst <- as.matrix(.kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k))
- colnames(robEst) <- "sd"
+ robEst <- .kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ robEst$est <- as.matrix(robEst$est)
+ colnames(robEst$est) <- "sd"
Info.matrix <- matrix(c("roblox",
paste("optimally robust estimates for contamination 'eps' =", round(eps, 3),
"and 'asMSE'")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = as.matrix(robEst$A - r^2*robEst$b^2),
+# asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}else{
sqrtn <- sqrt(ncol(x))
rlo <- sqrtn*eps.lower
@@ -345,8 +383,9 @@
ineff <- (A - b^2*(r^2 - rlo^2))/Alo
}
}
- robEst <- as.matrix(.kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k))
- colnames(robEst) <- "sd"
+ robEst <- .kstep.sc.matrix(x = x, initial.est = sd, A = A, a = a, b = b, mean = mean, k = k)
+ robEst$est <- as.matrix(robEst$est)
+ colnames(robEst$est) <- "sd"
Info.matrix <- matrix(c(rep("roblox", 3),
paste("radius-minimax estimates for contamination interval [",
round(eps.lower, 3), ", ", round(eps.upper, 3), "]", sep = ""),
@@ -354,7 +393,13 @@
paste("maximum MSE-inefficiency: ", round(ineff[1], 3), sep = "")),
ncol = 2, dimnames = list(NULL, c("method", "message")))
return(new("kStepEstimate", name = "Optimally robust estimate",
- estimate = robEst, steps = k, pIC = NULL, Infos = Info.matrix))
+ estimate.call = es.call, estimate = robEst$est,
+ samplesize = ncol(x), steps = k,
+ pIC = NULL, Infos = Info.matrix))
+## we need a class like "list of estimates" to set asvar and asbias consistently ...
+# return(new("kStepEstimate", name = "Optimally robust estimate",
+# estimate = robEst$est, samplesize = ncol(x), asvar = as.matrix(robEst$A - r^2*robEst$b^2),
+# asbias = r*robEst$b, steps = k, pIC = NULL, Infos = Info.matrix))
}
}
}
Modified: pkg/RobLox/R/rsOptIC.R
===================================================================
--- pkg/RobLox/R/rsOptIC.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/R/rsOptIC.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -31,7 +31,7 @@
tol = .Machine$double.eps^0.5, r = r, z = z)$root
iter <- 0
- repeat{
+ repeat{
iter <- iter + 1
if(iter > itmax)
stop("Algorithm did not converge => increase 'itmax'!")
@@ -64,18 +64,50 @@
if(computeIC){
w <- new("HampelWeight")
clip(w) <- b
- cent(w) <- z-1
+ cent(w) <- (z-1)/sd
stand(w) <- as.matrix(A)
weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
biastype = symmetricBias(),
normW = NormType())
+ modIC <- function(L2Fam, IC){
+ ICL2Fam <- eval(CallL2Fam(IC))
+ if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), "Norm")){
+ sdneu <- main(L2Fam)
+ sdalt <- main(ICL2Fam)
+ w <- weight(IC)
+ clip(w) <- sdneu*clip(w)/sdalt
+ cent(w) <- sdalt*cent(w)/sdneu
+ stand(w) <- sdneu^2*stand(w)/sdalt^2
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = neighborRadius(IC)),
+ biastype = biastype(IC),
+ normW = normtype(IC))
+ A <- sdneu^2*stand(IC)/sdalt^2
+ b <- sdneu*clip(IC)/sdalt
+ res <- list(A = as.matrix(A), a = sdneu*cent(IC)/sdalt, b = b, d = NULL,
+ risk = list(asMSE = A, asBias = b, asCov = A - r^2*b^2),
+ info = Infos(IC), w = w,
+ normtype = normtype(IC), biastype = biastype(IC),
+ modifyIC = modifyIC(IC))
+ IC <- generateIC(neighbor = ContNeighborhood(radius = neighborRadius(IC)),
+ L2Fam = L2Fam, res = res)
+ addInfo(IC) <- c("modifyIC", "The IC has been modified")
+ addInfo(IC) <- c("modifyIC", "The entries in 'Infos' may be wrong")
+ return(IC)
+ }else{
+ makeIC(IC, L2Fam)
+ }
+ }
+
+ L2Fam <- substitute(NormLocationFamily(mean = m1, sd = s1),
+ list(m1 = mean, s1 = sd))
return(generateIC(neighbor = ContNeighborhood(radius = r),
- L2Fam = NormScaleFamily(sd = sd, mean = mean),
+ L2Fam = eval(L2Fam),
res = list(A = as.matrix(A), a = a, b = b, d = NULL,
risk = list(asMSE = A, asBias = b, asCov = A - r^2*b^2),
info = c("rlOptIC", "optimally robust IC for AL estimators and 'asMSE'"),
- w = w, biastype = symmetricBias(), normtype = NormType())))
+ w = w, biastype = symmetricBias(), normtype = NormType(),
+ modifyIC = modIC)))
}else{
return(list(A = A, a = a, b = b))
}
Modified: pkg/RobLox/chm/00Index.html
===================================================================
--- pkg/RobLox/chm/00Index.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/00Index.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -15,7 +15,7 @@
<table width="100%">
<tr><td width="25%"><a href="rowRoblox.html">colRoblox</a></td>
-<td>Optimally robust estimator for location and/or scale</td></tr>
+<td>Optimally robust estimation for location and/or scale</td></tr>
<tr><td width="25%"><a href="rlOptIC.html">rlOptIC</a></td>
<td>Computation of the optimally robust IC for AL estimators</td></tr>
<tr><td width="25%"><a href="rlsOptIC.AL.html">rlsOptIC.AL</a></td>
@@ -57,7 +57,7 @@
<tr><td width="25%"><a href="roblox.html">roblox</a></td>
<td>Optimally robust estimator for location and/or scale</td></tr>
<tr><td width="25%"><a href="rowRoblox.html">rowRoblox</a></td>
-<td>Optimally robust estimator for location and/or scale</td></tr>
+<td>Optimally robust estimation for location and/or scale</td></tr>
<tr><td width="25%"><a href="rsOptIC.html">rsOptIC</a></td>
<td>Computation of the optimally robust IC for AL estimators</td></tr>
</table>
Modified: pkg/RobLox/chm/RobLox.chm
===================================================================
(Binary files differ)
Modified: pkg/RobLox/chm/RobLox.toc
===================================================================
--- pkg/RobLox/chm/RobLox.toc 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/RobLox.toc 2008-08-10 16:49:24 UTC (rev 159)
@@ -175,9 +175,13 @@
<param name="Local" value="rlsOptIC.TuMad.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
-<param name="Name" value="Optimally robust estimator for location and/or scale">
+<param name="Name" value="Optimally robust estimation for location and/or scale">
<param name="Local" value="rowRoblox.html">
</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Optimally robust estimator for location and/or scale">
+<param name="Local" value="roblox.html">
+</OBJECT>
</UL>
</UL>
</BODY></HTML>
Modified: pkg/RobLox/chm/rlOptIC.html
===================================================================
--- pkg/RobLox/chm/rlOptIC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlOptIC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -63,7 +63,7 @@
<p>
If 'computeIC' is 'TRUE' an object of class <code>"ContIC"</code> is returned,
-otherwise a list of Lagrane multipliers
+otherwise a list of Lagrange multipliers
</p>
<table summary="R argblock">
<tr valign="top"><td><code>A</code></td>
@@ -98,7 +98,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
+<code><a onclick="findlink('RobAStBase', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.AL.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.AL.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.AL.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -89,7 +89,7 @@
<p>
If 'computeIC' is 'TRUE' an object of class <code>"ContIC"</code> is returned,
-otherwise a list of Lagrane multipliers
+otherwise a list of Lagrange multipliers
</p>
<table summary="R argblock">
<tr valign="top"><td><code>A</code></td>
@@ -124,7 +124,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
+<code><a onclick="findlink('RobAStBase', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
</p>
@@ -142,8 +142,8 @@
plot(IC1)
infoPlot(IC1)
-## one-step estimation
-## see also: ?roblox
+## k-step estimation
+## better use function roblox (see ?roblox)
## 1. data: random sample
ind <- rbinom(100, size=1, prob=0.05)
x <- rnorm(100, mean=0, sd=(1-ind) + ind*9)
@@ -152,19 +152,29 @@
median(x)
mad(x)
-## 2. Kolmogorov(-Smirnov) minimum distance estimator
+## 2. Kolmogorov(-Smirnov) minimum distance estimator (default)
## -> we use it as initial estimate for one-step construction
-(est0 <- MDEstimator(x, ParamFamily = NormLocationScaleFamily(), distance = KolmogorovDist))
+(est0 <- MDEstimator(x, ParamFamily = NormLocationScaleFamily()))
-## 3. one-step estimation: radius known
-IC1 <- rlsOptIC.AL(r = 0.5, mean = est0$estimate[1], sd = est0$estimate[2])
-(est1 <- oneStepEstimator(x, IC1, est0$estimate))
+## 3.1 one-step estimation: radius known
+IC1 <- rlsOptIC.AL(r = 0.5, mean = estimate(est0)[1], sd = estimate(est0)[2])
+(est1 <- oneStepEstimator(x, IC1, est0))
-## 4. one-step estimation: radius unknown
+## 3.2 k-step estimation: radius known
+## Choose k = 3
+(est2 <- kStepEstimator(x, IC1, est0, steps = 3L))
+
+## 4.1 one-step estimation: radius unknown
## take least favorable radius r = 0.579
## cf. Table 8.1 in Kohl(2005)
-IC2 <- rlsOptIC.AL(r = 0.579, mean = est0$estimate[1], sd = est0$estimate[2])
-(est2 <- oneStepEstimator(x, IC2, est0$estimate))
+IC2 <- rlsOptIC.AL(r = 0.579, mean = estimate(est0)[1], sd = estimate(est0)[2])
+(est3 <- oneStepEstimator(x, IC2, est0))
+
+## 4.2 k-step estimation: radius unknown
+## take least favorable radius r = 0.579
+## cf. Table 8.1 in Kohl(2005)
+## choose k = 3
+(est4 <- kStepEstimator(x, IC2, est0, steps = 3L))
</pre>
<script Language="JScript">
Modified: pkg/RobLox/chm/rlsOptIC.An1.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.An1.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.An1.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -81,7 +81,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.An2.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.An2.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.An2.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -90,7 +90,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.AnMad.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.AnMad.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.AnMad.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -82,7 +82,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.BM.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.BM.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.BM.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -93,7 +93,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Ha3.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Ha3.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Ha3.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -89,7 +89,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Ha4.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Ha4.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Ha4.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -96,7 +96,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.HaMad.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.HaMad.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.HaMad.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -95,7 +95,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Hu1.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Hu1.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Hu1.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -81,7 +81,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Hu2.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Hu2.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Hu2.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -89,7 +89,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Hu2a.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Hu2a.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Hu2a.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -91,7 +91,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Hu3.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Hu3.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Hu3.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -92,7 +92,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.HuMad.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.HuMad.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.HuMad.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -82,7 +82,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.M.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.M.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.M.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -101,7 +101,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.MM2.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.MM2.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.MM2.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -90,7 +90,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Tu1.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Tu1.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Tu1.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -81,7 +81,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.Tu2.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.Tu2.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.Tu2.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -90,7 +90,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/rlsOptIC.TuMad.html
===================================================================
--- pkg/RobLox/chm/rlsOptIC.TuMad.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rlsOptIC.TuMad.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -81,7 +81,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
+<code><a onclick="findlink('RobAStBase', 'IC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">IC-class</a></code>
</p>
Modified: pkg/RobLox/chm/roblox.html
===================================================================
--- pkg/RobLox/chm/roblox.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/roblox.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -101,30 +101,14 @@
</p>
<p>
If <code>eps</code> is missing, the radius-minimax estimator in sense of
-Rieder et al. (2001), respectively Section 2.2 of Kohl (2005) is returned.
+Rieder et al. (2001, 2008), respectively Section 2.2 of Kohl (2005) is returned.
</p>
<h3>Value</h3>
<p>
-An object of S3-class <code>"ALEstimate"</code> which inherits from
-class <code>"Estimate"</code>, a list with components
-</p>
-<table summary="R argblock">
-<tr valign="top"><td><code>estimate </code></td>
-<td>
-location and/or scale estimate </td></tr>
-<tr valign="top"><td><code>steps </code></td>
-<td>
-number of k-steps used to compute the estimate </td></tr>
-<tr valign="top"><td><code>Infos </code></td>
-<td>
-additional information about the estimate </td></tr>
-<tr valign="top"><td><code>optIC</code></td>
-<td>
-object of class <code>"ContIC"</code>; optimally robust IC </td></tr>
-</table>
+Object of class <code>"kStepEstimate"</code>.</p>
<h3>Author(s)</h3>
@@ -158,8 +142,10 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="rlOptIC.html">rlOptIC</a></code>,
-<code><a href="rsOptIC.html">rsOptIC</a></code>, <code><a href="rlsOptIC.AL.html">rlsOptIC.AL</a></code>
+<code><a onclick="findlink('RobAStBase', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="rlOptIC.html">rlOptIC</a></code>,
+<code><a href="rsOptIC.html">rsOptIC</a></code>, <code><a href="rlsOptIC.AL.html">rlsOptIC.AL</a></code>,
+<code><a onclick="findlink('RobAStBase', 'kStepEstimate-class.html')" style="text-decoration: underline; color: blue; cursor: hand">kStepEstimate-class</a></code>,
+<code><a onclick="findlink('ROptEst', 'roptest.html')" style="text-decoration: underline; color: blue; cursor: hand">roptest</a></code>
</p>
@@ -171,25 +157,23 @@
## amount of gross errors known
res1 <- roblox(x, eps = 0.05, returnIC = TRUE)
-res1$mean
-res1$sd
-res1$optIC
-checkIC(res1$optIC)
-Risks(res1$optIC)
-Infos(res1$optIC)
-plot(res1$optIC)
-infoPlot(res1$optIC)
+estimate(res1)
+pIC(res1)
+checkIC(pIC(res1))
+Risks(pIC(res1))
+Infos(pIC(res1))
+plot(pIC(res1))
+infoPlot(pIC(res1))
## amount of gross errors unknown
res2 <- roblox(x, eps.lower = 0.01, eps.upper = 0.1, returnIC = TRUE)
-res2$mean
-res2$sd
-res2$optIC
-checkIC(res2$optIC)
-Risks(res2$optIC)
-Infos(res2$optIC)
-plot(res2$optIC)
-infoPlot(res2$optIC)
+estimate(res2)
+pIC(res2)
+checkIC(pIC(res2))
+Risks(pIC(res2))
+Infos(pIC(res2))
+plot(pIC(res2))
+infoPlot(pIC(res2))
## estimator comparison
# classical optimal (non-robust)
@@ -199,22 +183,22 @@
c(median(x), mad(x))
# optimally robust (amount of gross errors known)
-c(res1$mean, res1$sd)
+estimate(res1)
# optimally robust (amount of gross errors unknown)
-c(res2$mean, res2$sd)
+estimate(res2)
# Kolmogorov(-Smirnov) minimum distance estimator (robust)
-(ks.est <- MDEstimator(x, ParamFamily = NormLocationScaleFamily(), distance = KolmogorovDist))
+(ks.est <- MDEstimator(x, ParamFamily = NormLocationScaleFamily()))
# optimally robust (amount of gross errors known)
-roblox(x, eps = 0.05, initial.est = ks.est$estimate)
+roblox(x, eps = 0.05, initial.est = estimate(ks.est))
# Cramer von Mises minimum distance estimator (robust)
(CvM.est <- MDEstimator(x, ParamFamily = NormLocationScaleFamily(), distance = CvMDist))
# optimally robust (amount of gross errors known)
-roblox(x, eps = 0.05, initial.est = CvM.est$estimate)
+roblox(x, eps = 0.05, initial.est = estimate(CvM.est))
</pre>
<script Language="JScript">
Modified: pkg/RobLox/chm/rowRoblox.html
===================================================================
--- pkg/RobLox/chm/rowRoblox.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rowRoblox.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -1,4 +1,4 @@
-<html><head><title>Optimally robust estimator for location and/or scale</title>
+<html><head><title>Optimally robust estimation for location and/or scale</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link rel="stylesheet" type="text/css" href="Rchm.css">
</head>
@@ -7,18 +7,18 @@
<table width="100%"><tr><td>rowRoblox and colRoblox(RobLox)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: rowRoblox">
<param name="keyword" value="R: colRoblox">
-<param name="keyword" value=" Optimally robust estimator for location and/or scale">
+<param name="keyword" value=" Optimally robust estimation for location and/or scale">
</object>
-<h2>Optimally robust estimator for location and/or scale</h2>
+<h2>Optimally robust estimation for location and/or scale</h2>
<h3>Description</h3>
<p>
The functions <code>rowRoblox</code> and <code>colRoblox</code> compute
-the optimally robust estimator for normal location und/or scale and
+optimally robust estimates for normal location und/or scale and
(convex) contamination neighborhoods. The definition of
these estimators can be found in Rieder (1994) or Kohl (2005),
respectively.
@@ -74,8 +74,10 @@
scale with location specified, or both if neither is specified. The computation
uses a k-step construction with an appropriate initial estimate for location
or scale or location and scale, respectively. Valid candidates are e.g.
-median and/or MAD (default) as well as Kolmogorov(-Smirnov) or von Mises minimum
-distance estimators; cf. Rieder (1994) and Kohl (2005).
+median and/or MAD (default) as well as Kolmogorov(-Smirnov) or Cram'er von
+Mises minimum distance estimators; cf. Rieder (1994) and Kohl (2005). In case
+package Biobase from Bioconductor is installed as is suggested,
+median and/or MAD are computed using function <code>rowMedians</code>.
</p>
<p>
These functions are optimized for the situation where one has a matrix
@@ -87,7 +89,7 @@
If the amount of gross errors (contamination) is known, it can be
specified by <code>eps</code>. The radius of the corresponding infinitesimal
contamination neighborhood is obtained by multiplying <code>eps</code>
-by the square root of the sample size.
+by the square root of the sample size.
</p>
<p>
If the amount of gross errors (contamination) is unknown, try to find a
@@ -112,27 +114,15 @@
In case of location, respectively scale one additionally has to specify
<code>sd</code>, respectively <code>mean</code> where <code>sd</code> and <code>mean</code> can
be a single number, i.e., identical for all rows, respectively columns,
-or a vector, i.e., different for all rows, respectively columns.
+or a vector with length identical to the number of rows, respectively
+columns.
</p>
<h3>Value</h3>
<p>
-An object of S3-class <code>"ALEstimate"</code> which inherits from
-class <code>"Estimate"</code>, a list with components
-</p>
-<table summary="R argblock">
-<tr valign="top"><td><code>estimate </code></td>
-<td>
-location and/or scale estimates </td></tr>
-<tr valign="top"><td><code>steps </code></td>
-<td>
-number of k-steps used to compute the estimates </td></tr>
-<tr valign="top"><td><code>Infos </code></td>
-<td>
-additional information about the estimates </td></tr>
-</table>
+Object of class <code>"kStepEstimate"</code>.</p>
<h3>Author(s)</h3>
@@ -166,7 +156,7 @@
<h3>See Also</h3>
<p>
-<code><a href="roblox.html">roblox</a></code>
+<code><a href="roblox.html">roblox</a></code>, <code><a onclick="findlink('RobAStBase', 'kStepEstimate-class.html')" style="text-decoration: underline; color: blue; cursor: hand">kStepEstimate-class</a></code>
</p>
@@ -199,6 +189,15 @@
colRoblox(X3, eps = 0.02, mean = c(-2, 1), k = 4)
</pre>
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
<hr><div align="center">[Package <em>RobLox</em> version 0.6.0 <a href="00Index.html">Index]</a></div>
Modified: pkg/RobLox/chm/rsOptIC.html
===================================================================
--- pkg/RobLox/chm/rsOptIC.html 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/chm/rsOptIC.html 2008-08-10 16:49:24 UTC (rev 159)
@@ -69,7 +69,7 @@
<p>
If 'computeIC' is 'TRUE' an object of class <code>"ContIC"</code> is returned,
-otherwise a list of Lagrane multipliers
+otherwise a list of Lagrange multipliers
</p>
<table summary="R argblock">
<tr valign="top"><td><code>A</code></td>
@@ -104,7 +104,7 @@
<h3>See Also</h3>
<p>
-<code><a onclick="findlink('ROptEst', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
+<code><a onclick="findlink('RobAStBase', 'ContIC-class.html')" style="text-decoration: underline; color: blue; cursor: hand">ContIC-class</a></code>, <code><a href="roblox.html">roblox</a></code>
</p>
Modified: pkg/RobLox/inst/tests/tests.R
===================================================================
--- pkg/RobLox/inst/tests/tests.R 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/inst/tests/tests.R 2008-08-10 16:49:24 UTC (rev 159)
@@ -212,6 +212,7 @@
## some timings
X <- matrix(rnorm(1e5, mean = -1, sd = 3), ncol = 100)
system.time(apply(X, 1, roblox, eps = 0.02))
+## uses rowMedians of package Biobase if available
system.time(rowRoblox(X, eps = 0.02))
system.time(apply(X, 1, roblox))
Modified: pkg/RobLox/man/rlOptIC.Rd
===================================================================
--- pkg/RobLox/man/rlOptIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/man/rlOptIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -24,7 +24,7 @@
}
\value{
If 'computeIC' is 'TRUE' an object of class \code{"ContIC"} is returned,
- otherwise a list of Lagrane multipliers
+ otherwise a list of Lagrange multipliers
\item{A}{ standardizing constant }
\item{a}{ centering constant; always '= 0' is this symmetric setup }
\item{b}{ optimal clipping bound }
Modified: pkg/RobLox/man/rlsOptIC.AL.Rd
===================================================================
--- pkg/RobLox/man/rlsOptIC.AL.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/man/rlsOptIC.AL.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -37,7 +37,7 @@
}
\value{
If 'computeIC' is 'TRUE' an object of class \code{"ContIC"} is returned,
- otherwise a list of Lagrane multipliers
+ otherwise a list of Lagrange multipliers
\item{A}{ standardizing matrix }
\item{a}{ centering vector }
\item{b}{ optimal clipping bound }
@@ -63,8 +63,8 @@
plot(IC1)
infoPlot(IC1)
-## one-step estimation
-## see also: ?roblox
+## k-step estimation
+## better use function roblox (see ?roblox)
## 1. data: random sample
ind <- rbinom(100, size=1, prob=0.05)
x <- rnorm(100, mean=0, sd=(1-ind) + ind*9)
@@ -73,19 +73,29 @@
median(x)
mad(x)
-## 2. Kolmogorov(-Smirnov) minimum distance estimator
+## 2. Kolmogorov(-Smirnov) minimum distance estimator (default)
## -> we use it as initial estimate for one-step construction
-(est0 <- MDEstimator(x, ParamFamily = NormLocationScaleFamily(), distance = KolmogorovDist))
+(est0 <- MDEstimator(x, ParamFamily = NormLocationScaleFamily()))
-## 3. one-step estimation: radius known
+## 3.1 one-step estimation: radius known
IC1 <- rlsOptIC.AL(r = 0.5, mean = estimate(est0)[1], sd = estimate(est0)[2])
(est1 <- oneStepEstimator(x, IC1, est0))
-## 4. one-step estimation: radius unknown
+## 3.2 k-step estimation: radius known
+## Choose k = 3
+(est2 <- kStepEstimator(x, IC1, est0, steps = 3L))
+
+## 4.1 one-step estimation: radius unknown
## take least favorable radius r = 0.579
## cf. Table 8.1 in Kohl(2005)
IC2 <- rlsOptIC.AL(r = 0.579, mean = estimate(est0)[1], sd = estimate(est0)[2])
-(est2 <- oneStepEstimator(x, IC2, est0))
+(est3 <- oneStepEstimator(x, IC2, est0))
+
+## 4.2 k-step estimation: radius unknown
+## take least favorable radius r = 0.579
+## cf. Table 8.1 in Kohl(2005)
+## choose k = 3
+(est4 <- kStepEstimator(x, IC2, est0, steps = 3L))
}
\concept{normal location and scale}
\concept{influence curve}
Modified: pkg/RobLox/man/roblox.Rd
===================================================================
--- pkg/RobLox/man/roblox.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/man/roblox.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -53,7 +53,7 @@
respectively.
If \code{eps} is missing, the radius-minimax estimator in sense of
- Rieder et al. (2001), respectively Section 2.2 of Kohl (2005) is returned.
+ Rieder et al. (2001, 2008), respectively Section 2.2 of Kohl (2005) is returned.
}
\value{Object of class \code{"kStepEstimate"}. }
\references{
@@ -75,7 +75,8 @@
%\note{}
\seealso{\code{\link[RobAStBase]{ContIC-class}}, \code{\link{rlOptIC}},
\code{\link{rsOptIC}}, \code{\link{rlsOptIC.AL}},
- \code{\link[RobAStBase]{kStepEstimate-class}} }
+ \code{\link[RobAStBase]{kStepEstimate-class}},
+ \code{\link[ROptEst]{roptest}} }
\examples{
ind <- rbinom(100, size=1, prob=0.05)
x <- rnorm(100, mean=ind*3, sd=(1-ind) + ind*9)
Modified: pkg/RobLox/man/rsOptIC.Rd
===================================================================
--- pkg/RobLox/man/rsOptIC.Rd 2008-08-10 16:39:02 UTC (rev 158)
+++ pkg/RobLox/man/rsOptIC.Rd 2008-08-10 16:49:24 UTC (rev 159)
@@ -26,7 +26,7 @@
}
\value{
If 'computeIC' is 'TRUE' an object of class \code{"ContIC"} is returned,
- otherwise a list of Lagrane multipliers
+ otherwise a list of Lagrange multipliers
\item{A}{ standardizing constant }
\item{a}{ centering constant }
\item{b}{ optimal clipping bound }
More information about the Robast-commits
mailing list