[Robast-commits] r144 - in branches/robast-0.6/pkg: ROptEst/R ROptEst/man RandVar/inst/doc
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 5 07:18:00 CEST 2008
Author: stamats
Date: 2008-08-05 07:18:00 +0200 (Tue, 05 Aug 2008)
New Revision: 144
Modified:
branches/robast-0.6/pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
branches/robast-0.6/pkg/ROptEst/R/getIneffDiff.R
branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asBias.R
branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asCov.R
branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asGRisk.R
branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asHampel.R
branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
branches/robast-0.6/pkg/ROptEst/R/leastFavorableRadius.R
branches/robast-0.6/pkg/ROptEst/R/optIC.R
branches/robast-0.6/pkg/ROptEst/R/radiusMinimaxIC.R
branches/robast-0.6/pkg/ROptEst/R/roptest.R
branches/robast-0.6/pkg/ROptEst/man/getFixRobIC.Rd
branches/robast-0.6/pkg/ROptEst/man/getIneffDiff.Rd
branches/robast-0.6/pkg/ROptEst/man/getInfRobIC.Rd
branches/robast-0.6/pkg/ROptEst/man/optIC.Rd
branches/robast-0.6/pkg/ROptEst/man/radiusMinimaxIC.Rd
branches/robast-0.6/pkg/ROptEst/man/roptest.Rd
branches/robast-0.6/pkg/RandVar/inst/doc/RandVar.pdf
Log:
introduced argument verbose, made some minor changes
Modified: branches/robast-0.6/pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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: branches/robast-0.6/pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getIneffDiff.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getIneffDiff.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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
@@ -82,7 +83,8 @@
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: branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asBias.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asBias.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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: branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asCov.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asCov.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asCov.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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: branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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)
@@ -63,7 +64,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)
@@ -90,7 +92,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 +102,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 +130,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 +139,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 +149,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 +160,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"
@@ -199,7 +199,6 @@
if(is.null(upper)) upper <- 10*upper0
}else{ lower <- lower0; upper <- upper0}
-
##
b <- try(uniroot(getInfClip,
## new
@@ -220,7 +219,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 +233,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,
@@ -251,7 +250,8 @@
stand = A, w = w)}
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(iter > maxiter){
cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
@@ -263,8 +263,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,
@@ -289,5 +289,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: branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asHampel.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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: branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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
Modified: branches/robast-0.6/pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/leastFavorableRadius.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/leastFavorableRadius.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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: branches/robast-0.6/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/optIC.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/optIC.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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,7 +14,7 @@
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)
+ noLow = noLow, verbose = verbose)
options(ow)
res$info <- c("optIC", res$info)
modIC <- function(L2Fam, IC){
@@ -50,7 +51,8 @@
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)
+ upper = upper, maxiter = maxiter, tol = tol, warn = warn,
+ verbose = verbose)
options(ow)
res$info <- c("optIC", res$info)
modIC <- function(L2Fam, IC){
@@ -103,7 +105,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")){
Modified: branches/robast-0.6/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/radiusMinimaxIC.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/radiusMinimaxIC.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -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 = 100,
+ 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)
@@ -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,7 +73,8 @@
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)
+ 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=""))
@@ -137,7 +141,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)
riskLo <- risk
normtype(riskLo) <- resLo$normtype
loRisk <- getAsRisk(risk = riskLo, L2deriv = L2deriv,
@@ -169,7 +173,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,
@@ -188,7 +192,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)
options(ow)
res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [",
round(loRad, 3), ", ", round(upRad, 3), "]", sep=""))
Modified: branches/robast-0.6/pkg/ROptEst/R/roptest.R
===================================================================
--- branches/robast-0.6/pkg/ROptEst/R/roptest.R 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/R/roptest.R 2008-08-05 05:18:00 UTC (rev 144)
@@ -3,7 +3,9 @@
###############################################################################
roptest <- function(x, L2Fam, eps, eps.lower, eps.upper, initial.est,
neighbor = ContNeighborhood(), risk = asMSE(), steps = 1,
- distance = CvMDist, interval, par, ...){
+ distance = CvMDist, interval, par, verbose = FALSE,
+ useLast = getRobAStBaseOption("kStepUseLast"), ...){
+ es.call <- match.call()
if(missing(x))
stop("'x' is missing with no default")
if(missing(L2Fam))
@@ -49,9 +51,12 @@
}
if(missing(initial.est)){
- initial.est <- MDEstimator(x = x, ParamFamily = L2Fam, distance = distance,
- interval = interval, par = par, ...)
+ initial.est <- estimate(MDEstimator(x = x, ParamFamily = L2Fam, distance = distance,
+ interval = interval, par = par, ...))
}
+ newParam <- param(L2Fam)
+ main(newParam) <- initial.est
+ L2FamStart <- modifyModel(L2Fam, newParam)
if(is.matrix(x))
sqrtn <- sqrt(ncol(x))
else
@@ -59,19 +64,22 @@
if(missing(eps)){
r.lower <- sqrtn*eps.lower
r.upper <- sqrtn*eps.upper
- newParam <- param(L2Fam)
- main(newParam) <- estimate(initial.est)
- L2FamStart <- modifyModel(L2Fam, newParam)
- ICstart <- radiusMinimaxIC(L2Fam=L2FamStart, neighbor=neighbor, risk=risk,
- loRad=r.lower, upRad=r.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
- newParam <- param(L2Fam)
- main(newParam) <- estimate(initial.est)
- L2FamStart <- modifyModel(L2Fam, newParam)
- infMod <- InfRobModel(center = L2FamStart, neighbor=neighbor)
- ICstart <- optIC(model=infMod, risk=risk)
+ infMod <- InfRobModel(center = L2FamStart, neighbor = neighbor)
+ ICstart <- optIC(model = infMod, risk = risk, verbose = verbose)
}
- kStepEstimator(x, IC=ICstart, start=initial.est, steps = steps)
+ 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: branches/robast-0.6/pkg/ROptEst/man/getFixRobIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getFixRobIC.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/getFixRobIC.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -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.
}
Modified: branches/robast-0.6/pkg/ROptEst/man/getIneffDiff.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getIneffDiff.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/getIneffDiff.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -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),
Modified: branches/robast-0.6/pkg/ROptEst/man/getInfRobIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/getInfRobIC.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/getInfRobIC.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -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, z.start, A.start, trafo, 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, z.start, A.start, trafo, onesetLM = FALSE, 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.}
Modified: branches/robast-0.6/pkg/ROptEst/man/optIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/optIC.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/optIC.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -12,16 +12,17 @@
\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")
}
\arguments{
\item{model}{ probability model. }
@@ -37,6 +38,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
Modified: branches/robast-0.6/pkg/ROptEst/man/radiusMinimaxIC.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/radiusMinimaxIC.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/radiusMinimaxIC.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -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,8 +61,9 @@
\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}
Modified: branches/robast-0.6/pkg/ROptEst/man/roptest.Rd
===================================================================
--- branches/robast-0.6/pkg/ROptEst/man/roptest.Rd 2008-08-04 10:39:21 UTC (rev 143)
+++ branches/robast-0.6/pkg/ROptEst/man/roptest.Rd 2008-08-05 05:18:00 UTC (rev 144)
@@ -8,7 +8,8 @@
\usage{
roptest(x, L2Fam, eps, eps.lower, eps.upper, initial.est,
neighbor = ContNeighborhood(), risk = asMSE(), steps = 1,
- distance = CvMDist, interval, par, ...)
+ distance = CvMDist, interval, par, verbose = FALSE,
+ useLast = getRobAStBaseOption("kStepUseLast"), ...)
}
\arguments{
\item{x}{ sample }
@@ -28,13 +29,18 @@
\item{interval}{ parameter interval for univariate parameters }
\item{par}{ initial parameter value for multivariate parameters.
If missing, the parameters of \code{L2Fam} are 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. Valid candidates are e.g. Kolmogorov(-Smirnov)
- or von Mises minimum distance estimators (default); cf. Rieder (1994) and Kohl (2005).
+ 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
@@ -55,6 +61,21 @@
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{
@@ -67,7 +88,7 @@
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}
@@ -108,7 +129,7 @@
MLEstimator(x, PoisFamily(), interval = c(0, 10))
## compute optimally robust estimator (unknown contamination)
-roptest(x, PoisFamily(), eps.upper = 0.05, interval = c(0, 10), steps = 3)
+#roptest(x, PoisFamily(), eps.upper = 0.05, interval = c(0, 10), steps = 3)
#############################
## 3. Normal (Gaussian) location and scale
Modified: branches/robast-0.6/pkg/RandVar/inst/doc/RandVar.pdf
===================================================================
(Binary files differ)
More information about the Robast-commits
mailing list