[Robast-commits] r83 - in pkg: ROptEst/R ROptEst/chm ROptEst/inst/scripts ROptEst/man RobAStBase/R RobAStBase/chm RobAStBase/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 30 14:21:37 CEST 2008
Author: ruckdeschel
Date: 2008-03-30 14:21:31 +0200 (Sun, 30 Mar 2008)
New Revision: 83
Modified:
pkg/ROptEst/R/AllGeneric.R
pkg/ROptEst/R/getAsRisk.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/getRiskIC.R
pkg/ROptEst/R/leastFavorableRadius.R
pkg/ROptEst/R/optIC.R
pkg/ROptEst/R/optRisk.R
pkg/ROptEst/R/radiusMinimaxIC.R
pkg/ROptEst/chm/ROptEst.chm
pkg/ROptEst/chm/getAsRisk.html
pkg/ROptEst/chm/getIneffDiff.html
pkg/ROptEst/chm/getInfRobIC.html
pkg/ROptEst/chm/minmaxBias.html
pkg/ROptEst/chm/optIC.html
pkg/ROptEst/chm/optRisk.html
pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
pkg/ROptEst/man/getAsRisk.Rd
pkg/ROptEst/man/getIneffDiff.Rd
pkg/ROptEst/man/getInfRobIC.Rd
pkg/ROptEst/man/minmaxBias.Rd
pkg/ROptEst/man/optIC.Rd
pkg/ROptEst/man/optRisk.Rd
pkg/RobAStBase/R/ContIC.R
pkg/RobAStBase/R/TotalVarIC.R
pkg/RobAStBase/R/getBiasIC.R
pkg/RobAStBase/R/infoPlot.R
pkg/RobAStBase/chm/RobAStBase.chm
pkg/RobAStBase/chm/getBiasIC.html
pkg/RobAStBase/man/getBiasIC.Rd
Log:
+some changes in Risk-output slots of optimal ICs
(at which model evaluated etc)
+radiusMinimaxIC.R and leastFavorableRadius.R now also
work for self-standardized ICs
(changes in rel risk there; evaluates bias at another norm)
+correct results for minmaxBias in onesided case (if sup_P / inf_P are finite)
+infoPlot now uses different norms if normtype requires it
+NormalLocationScaleModel.R now has SelfNorm example for
radiusMinimaxIC.R
Modified: pkg/ROptEst/R/AllGeneric.R
===================================================================
--- pkg/ROptEst/R/AllGeneric.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/AllGeneric.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -71,7 +71,3 @@
if(!isGeneric("updateNorm")){
setGeneric("updateNorm", function(normtype, ...) standardGeneric("updateNorm"))
}
-if(!isGeneric("getBiasIC")){
- setGeneric("getBiasIC",
- function(L2deriv, neighbor, biastype, ...) standardGeneric("minmaxBias"))
-}
Modified: pkg/ROptEst/R/getAsRisk.R
===================================================================
--- pkg/ROptEst/R/getAsRisk.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getAsRisk.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -58,22 +58,32 @@
neighbor = "ContNeighborhood",
biastype = "ANY"),
function(risk, L2deriv, neighbor, biastype, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, trafo, z.start, A.start, maxiter, tol){
+ L2derivDistrSymm, trafo, z.start, A.start, maxiter, tol, warn){
normtype <- normtype(risk)
biastype <- biastype(risk)
+ if(is(normtype,"SelfNorm")){
+ warntxt <- paste(gettext(
+ "Using self-standardization, there are problems with the existence\n"
+ ),gettext(
+ "of a minmax Bias IC. Instead we return a lower bound.\n"
+ ))
+ if(warn) cat(warntxt)
+ return(list(asBias = sqrt(nrow(trafo))))
+ }
comp <- .getComp(L2deriv, DistrSymm, L2derivSymm, L2derivDistrSymm)
z.comp <- comp$"z.comp"
A.comp <- comp$"A.comp"
- eerg <- .LowerCaseMultivariate(L2deriv, neighbor, biastype,
- normtype, Distr, trafo, z.start,
- A.start, z.comp = z.comp, A.comp = A.comp, maxiter, tol)
+ eerg <- .LowerCaseMultivariate(L2deriv = L2deriv, neighbor = neighbor,
+ biastype = biastype, normtype = normtype, Distr = Distr,
+ trafo = trafo, z.start = z.start, A.start, z.comp = z.comp,
+ A.comp = A.comp, maxiter = maxiter, tol = tol)
erg <- eerg$erg
bias <- 1/erg$value
- return(list(asBias = bias))
+ return(list(asBias = bias, normtype = eerg$normtype))
})
@@ -158,12 +168,15 @@
L2deriv = "RealRandVariable",
neighbor = "ContNeighborhood",
biastype = "ANY"),
- function(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand){
+ function(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, normtype){
Cov <- getAsRisk(risk = asCov(), L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype(risk), Distr = Distr, clip = clip,
cent = cent, stand = stand)$asCov
- return(list(trAsCov = sum(diag(Cov))))
+ p <- nrow(stand)
+ std <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(p)
+
+ return(list(trAsCov = sum(diag(std%*%Cov))))
})
###############################################################################
Modified: pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- pkg/ROptEst/R/getIneffDiff.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getIneffDiff.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -6,7 +6,8 @@
neighbor = "UncondNeighborhood",
risk = "asMSE"),
function(radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk,
- z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn){
+ z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
+ loNorm = NULL, upNorm = NULL){
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
if(L2derivDim == 1){
neighbor at radius <- radius
@@ -53,16 +54,33 @@
A.start = A.start, upper = upper.b, maxiter = MaxIter,
tol = eps, warn = warn)
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
+
+ if(is(normtype(risk),"SelfNorm")){
+ IC <- generateIC(neighbor = neighbor, L2Fam = L2Fam, res = res)
+ biasLoE <- getBiasIC(IC = as(IC, "IC"), neighbor = neighbor, L2Fam = L2Fam,
+ biastype = symmetricBias(),
+ normtype = loNorm, tol = eps,
+ numbeval = 1e4)
+ biasLo <- biasLoE$asBias$value
+ biasUpE <- getBiasIC(IC = as(IC, "IC"), neighbor = neighbor, L2Fam = L2Fam,
+ biastype = symmetricBias(),
+ normtype = upNorm, tol = eps,
+ numbeval = 1e4)
+ biasUp <- biasUpE$asBias$value
+ ineffLo <- (p+biasLo^2*loRad^2)/loRisk
+ ineffUp <- if(upRad == Inf) biasUp^2/upRisk else
+ (p+biasUp^2*upRad^2)/upRisk
+ }else{
ineffLo <- (sum(diag(std%*%res$A%*%t(trafo))) -
- res$b^2*(radius^2-loRad^2))/loRisk
+ biasLo^2*(radius^2-loRad^2))/loRisk
if(upRad == Inf)
- ineffUp <- res$b^2/upRisk
+ ineffUp <- biasUp^2/upRisk
else
ineffUp <- (sum(diag(std%*%res$A%*%t(trafo))) -
- res$b^2*(radius^2-upRad^2))/upRisk
+ 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")
Modified: pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asBias.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getInfRobIC_asBias.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -5,21 +5,57 @@
risk = "asBias",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, trafo, maxiter,
- tol, ...){
- minmaxBias(L2deriv, neighbor, biastype(risk), symm,
- trafo, maxiter, tol)
+ tol, warn, Finfo, ...){
+ erg <- minmaxBias(L2deriv = L2deriv, neighbor = neighbor,
+ biastype = biastype(risk), symm = symm,
+ trafo = trafo, maxiter = maxiter,
+ tol = tol, warn = warn, Finfo = Finfo)
+ asCov <- erg$risk$asCov
+ b <- erg$risk$asBias$value
+ r <- neighbor at radius^2
+ erg$risk <- c(erg$risk,
+ list(trAsCov = list(value = asCov, normtype = NormType()),
+ asMSE = list(value = asCov + r^2*b^2,
+ r = r,
+ at = neighbor)))
+ 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, ...){
+ A.start, Finfo, trafo, maxiter, tol, warn, ...){
normtype <- normtype(risk)
+ if(is(normtype,"SelfNorm")){
+ warntxt <- paste(gettext(
+ "Using self-standardization, there are problems with the existence\n"
+ ),gettext(
+ "of a minmax Bias IC. Instead we compute the optimal MSE-solution\n"
+ ),gettext(
+ "to a large radius (r = 10)\n"
+ ))
+ if(warn) cat(warntxt)
+ neighbor at radius <- 10
+ res <- getInfRobIC(L2deriv = L2deriv,
+ risk = asMSE(normtype = normtype),
+ neighbor = neighbor, Distr = Distr,
+ DistrSymm = DistrSymm, L2derivSymm = L2derivSymm,
+ L2derivDistrSymm = L2derivDistrSymm, Finfo = Finfo,
+ trafo = trafo, onesetLM = FALSE, z.start = z.start,
+ A.start = A.start, upper = 1e4, maxiter = maxiter,
+ tol = tol, warn = warn)
+ res$risk$asBias <- list(value = sqrt(nrow(trafo)),
+ biastype = symmetricBias(),
+ normtype = normtype,
+ neighbortype = class(neighbor),
+ remark = gettext("value is only a bound"))
+ return(res)
+ }
FI <- solve(trafo%*%solve(Finfo)%*%t(trafo))
- if(is(normtype,"InfoNorm") || is(normtype,"SelfNorm") )
+ if(is(normtype,"InfoNorm"))
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
normtype(risk) <- normtype}
@@ -37,11 +73,15 @@
})
+###############################################################################
+## helper function minmaxBias
+###############################################################################
+
setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution",
neighbor = "ContNeighborhood",
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, symm,
- trafo, maxiter, tol){
+ trafo, maxiter, tol, warn, Finfo){
zi <- sign(as.vector(trafo))
A <- as.matrix(zi)
z <- q(L2deriv)(0.5)
@@ -58,14 +98,17 @@
info <- c("minimum asymptotic bias (lower case) solution")
asCov <- b^2*(1-ws0) + b^2*d^2*ws0
- Risk <- list(asBias = b, asCov = asCov)
+ Risk <- list(asBias = list(value = b, biastype = biastype,
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ asCov = asCov)
w <- new("HampelWeight")
cent(w) <- z
stand(w) <- A
clip(w) <- b
weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype,
- normW= NormType())
+ normW = NormType())
return(list(A = A, a = zi*z, b = b, d = d, risk = Risk, info = info,
w = w, biastype = biastype, normtype = NormType()))
@@ -74,9 +117,8 @@
setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution",
neighbor = "TotalVarNeighborhood",
biastype = "BiasType"),
- function(L2deriv, neighbor, biastype,
- symm, trafo,
- maxiter, tol){
+ function(L2deriv, neighbor, biastype, symm, trafo,
+ maxiter, tol, warn, Finfo){
zi <- sign(as.vector(trafo))
A <- as.matrix(zi)
b <- zi*as.vector(trafo)/(-m1df(L2deriv, 0))
@@ -92,7 +134,11 @@
a <- -b*(p0-ws0)/(1-ws0)
info <- c("minimum asymptotic bias (lower case) solution")
- Risk <- list(asCov = a^2*(p0-ws0) + (zi*a+b)^2*(1-p0), asBias = b)
+ asCov <- a^2*(p0-ws0) + (zi*a+b)^2*(1-p0)
+ Risk <- list(asBias = list(value = b, biastype = biastype,
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ asCov = asCov)
w <- new("BdStWeight")
stand(w) <- A
@@ -126,14 +172,32 @@
z[z.comp] <- param[(lA.comp+1):length(param)]
a <- as.vector(A %*% z)
d <- numeric(p)
+
+ # to be done:
# computation of 'd', in case 'L2derivDistr' not abs. cont.
- info <- c("minimum asymptotic bias (lower case) solution")
- Risk <- list(asBias = b)
-
w <- eerg$w
normtype <- eerg$normtype
-
+
+ Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
+ biastype = biastype, Distr = Distr,
+ V.comp = A.comp, cent = a,
+ stand = A, w = w)
+
+ std <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(p)
+
+ info <- c("minimum asymptotic bias (lower case) solution")
+ trAsCov <- sum(diag(std%*%Cov))
+ r <- neighbor at radius
+ asMSE <- r^2 * b^2 + trAsCov
+ Risk <- list(asBias = list(value = b, biastype = biastype,
+ normtype = normtype,
+ neighbortype = class(neighbor)),
+ asCov = Cov,
+ trAsCov = list(value = trAsCov, normtype = normtype),
+ asMSE = list(value = r^2 * b^2 + trAsCov,
+ r = r,
+ at = neighbor))
return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info,
w = w, biastype = biastype, normtype = normtype))
})
@@ -142,7 +206,7 @@
neighbor = "ContNeighborhood",
biastype = "asymmetricBias"),
function(L2deriv, neighbor, biastype, symm,
- trafo, maxiter, tol){
+ trafo, maxiter, tol, warn, Finfo){
nu1 <- nu(biastype)[1]
nu2 <- nu(biastype)[2]
zi <- sign(as.vector(trafo))
@@ -167,7 +231,10 @@
info <- c("minimum asymptotic bias (lower case) solution")
asCov <- b2^2*(1-p)+b1^2*(p-ws0) + b^2*d^2*ws0
- Risk <- list(asBias = b, asCov = asCov)
+ Risk <- list(asBias = list(value = b, biastype = biastype,
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ asCov = asCov)
w <- new("HampelWeight")
cent(w) <- z
@@ -183,15 +250,26 @@
neighbor = "ContNeighborhood",
biastype = "onesidedBias"),
function(L2deriv, neighbor, biastype, symm,
- trafo, maxiter, tol){
+ trafo, maxiter, tol, warn, Finfo){
infotxt <- c("minimum asymptotic bias (lower case) solution")
noIC <- function(){
- warntxt <- gettext("There exists no IC attaining the infimal maxBias.")
- warning(warntxt)
- return(list(A = matrix(1), a = 1, d = 0, b = 0,
- Risk = list(asBias = 0, asCov = 0, warning = warntxt),
- info = infotxt, w = NULL, biastype = biastype,
- normtype = NormType()))}
+ warntxt <- paste(gettext(
+ "There exists no IC attaining the infimal maxBias.\n"),
+ gettext(
+ "Instead we issue an IC with a very small Bias bound (starting with\n"),
+ gettext(
+ "'tol'+ w_inf, w_inf = -1/inf_P psi or 1/sup_P psi).\n"
+ ))
+ w <- if(sign(biastype)>0) -1/q(L2deriv)(0) else 1/q(L2deriv)(1)
+ if(warn) cat(warntxt)
+ bd <- tol + w
+ while (!is.list(try(
+ 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
+ return(res)}
if(is(L2deriv, "DiscreteDistribution"))
{ if(is.finite(lowerCaseRadius(L2deriv, neighbor, risk = asMSE(), biastype)))
{
@@ -217,7 +295,10 @@
b0 <- abs(1/z0)
d0 <- 0
asCov <- v1^2*(1-p0)+v2^2*p0
- Risk0 <- list(asBias = b0, asCov = asCov)
+ Risk0 <- list(asBias = list(value = b0, biastype = biastype,
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ asCov = asCov)
A0 <- matrix(A0,1,1)
w <- new("HampelWeight")
Modified: pkg/ROptEst/R/getInfRobIC_asCov.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asCov.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getInfRobIC_asCov.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -7,8 +7,19 @@
function(L2deriv, risk, neighbor, Finfo, trafo){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
+
b <- abs(as.vector(A))*max(abs(q(L2deriv)(1)),abs(q(L2deriv)(0)))
- Risk <- list(asCov = A %*% t(trafo), asBias = b)
+
+ asCov <- A %*% t(trafo)
+ r <- neighbor at radius
+ Risk <- list(asCov = asCov,
+ asBias = list(value = b, biastype = symmetricBias(),
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = asCov, normtype = NormType()),
+ asMSE = list(value = asCov + r^2*b^2,
+ r = r,
+ at = neighbor))
return(list(A = A, a = 0, b = b, d = NULL, risk = Risk, info = info))
})
@@ -20,7 +31,16 @@
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))
- Risk <- list(asCov = A %*% t(trafo), asBias = b)
+ asCov <- A %*% t(trafo)
+ r <- neighbor at radius
+ Risk <- list(asCov = asCov,
+ asBias = list(value = b, biastype = symmetricBias(),
+ normtype = NormType(),
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = asCov, normtype = NormType()),
+ asMSE = list(value = asCov + r^2*b^2,
+ r = r,
+ at = neighbor))
return(list(A = A, a = -b/2, b = b, d = NULL, risk = Risk, info = info))
})
@@ -28,7 +48,7 @@
risk = "asCov",
neighbor = "ContNeighborhood"),
function(L2deriv, risk, neighbor,
- Distr, Finfo, trafo){
+ Distr, Finfo, trafo, QuadForm = diag(nrow(trafo))){
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
IC <- A %*% L2deriv
@@ -42,8 +62,19 @@
}else{
b <- Inf # not yet implemented
}
+
asCov <- A %*% t(trafo)
- Risk <- list(asCov = asCov, asBias = b, trAsCov = sum(diag(asCov)))
-
+ trAsCov <- sum(diag(QuadForm%*%asCov))
+ r <- neighbor at radius
+ nt <- if(identical(QuadForm,diag(nrow(trafo)))) NormType() else
+ QFNorm(QuadForm = PosSemDefSymmMatrix(QuadForm))
+ Risk <- list(asCov = asCov,
+ asBias = list(value = b, biastype = symmetricBias(),
+ normtype = nt,
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = trAsCov, normtype = nt),
+ asMSE = list(value = trAsCov + r^2*b^2,
+ r = r,
+ at = neighbor))
return(list(A = A, a = numeric(nrow(trafo)), b = b, d = NULL, risk = Risk, info = info))
})
Modified: pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -12,10 +12,18 @@
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
neighbor = neighbor, Finfo = Finfo, trafo = trafo)
+ res <- c(res, list(biastype = biastype, normtype = NormType()))
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)
+ Cov <- res$risk$asCov
+ res$risk$asBias <- list(value = b, biastype = biastype,
+ normtype = NormType(),
+ neighbortype = class(neighbor))
+ res$risk$asMSE <- list(value = Cov + radius^2*b^2,
+ r = radius,
+ at = neighbor)
return(res)
}
z <- 0
@@ -82,7 +90,14 @@
Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = c0, cent = z, stand = A)
- Risk <- c(Risk, list(asBias = b, asCov = Cov))
+ Risk <- c(Risk, list(asCov = Cov,
+ asBias = list(value = b, biastype = biastype,
+ normtype = normtype(risk),
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = Cov, normtype = normtype(risk)),
+ asMSE = list(value = Cov + radius^2*b^2,
+ r = radius,
+ at = neighbor)))
if(is(neighbor,"ContNeighborhood"))
{w <- new("HampelWeight")
@@ -121,6 +136,7 @@
if(is(normtype,"InfoNorm") || is(normtype,"SelfNorm") )
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
normtype(risk) <- normtype}
+ QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A))
if(is.null(z.start)) z.start <- numeric(ncol(trafo))
if(is.null(A.start)) A.start <- trafo %*% solve(Finfo)
@@ -130,11 +146,22 @@
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,
- Distr = Distr, Finfo = Finfo, trafo = trafo)
+ Distr = Distr, Finfo = Finfo, trafo = trafo,
+ QuadForm = QF)
+ res <- c(res, list(biastype = biastype, normtype = normtype))
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, cent = res$a,
stand = res$A, trafo = trafo)
res$risk <- c(Risk, res$risk)
+ trAsCov <- sum(diag(QF%*%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))
+ res$risk$asMSE <- list(value = trAsCov + r^2*b^2,
+ r = r,
+ at = neighbor)
return(res)
}
@@ -161,9 +188,11 @@
## new
lower0 <- getL1normL2deriv(L2deriv = L2deriv, cent = z, stand = A,
Distr = Distr, normtype = normtype)/(1+neighbor at radius^2)
+
QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A))
upper0 <- sqrt( (sum( diag(QF%*%A%*%Finfo%*%t(A))) + t(A%*%z)%*%QF%*%(A%*%z)) /
((1 + neighbor at radius^2)^2-1))
+
if (!is.null(upper)|(iter == 1))
{lower <- .Machine$double.eps^0.75;
if(is.null(upper)) upper <- 10*upper0
@@ -187,9 +216,10 @@
res <- getInfRobIC(L2deriv = L2deriv,
risk = asBias(biastype = biastype(risk),
normtype = normtype(risk)),
- neighbor = neighbor, Distr = Distr, L2derivDistrSymm = L2derivDistrSymm,
- z.start = z.start, A.start = A.start, trafo = trafo,
- maxiter = maxiter, tol = tol)
+ 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)
normtype(risk) <- res$normtype
Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype, clip = NULL,
@@ -216,7 +246,8 @@
if (is(normtype,"SelfNorm"))
{normtype(risk) <- normtype <- updateNorm(normtype = normtype,
L2 = L2deriv, neighbor = neighbor, biastype = biastype,
- Distr = Distr, V.comp = A.comp, cent = z, stand = A, w = w)}
+ Distr = Distr, V.comp = A.comp, cent = as.vector(A %*% z),
+ 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")
@@ -242,8 +273,20 @@
biastype = biastype, Distr = Distr,
V.comp = A.comp, cent = a,
stand = A, w = w)
- Risk <- c(Risk, list(asBias = b, asCov = Cov))
+
+ QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A))
+ trAsCov <- sum(diag(QF%*%Cov))
+ Risk <- c(Risk, list(asCov = Cov,
+ asBias = list(value = b, biastype = biastype,
+ normtype = normtype,
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = trAsCov,
+ normtype = normtype),
+ asMSE = list(value = trAsCov + radius^2*b^2,
+ r = radius,
+ 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_asHampel.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getInfRobIC_asHampel.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -5,7 +5,7 @@
risk = "asHampel",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn){
+ upper, maxiter, tol, warn, noLow = FALSE){
biastype <- biastype(risk)
normtype <- normtype(risk)
@@ -18,22 +18,51 @@
"in sense of Cramer-Rao bound is returned\n")
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
neighbor = neighbor, Finfo = Finfo, trafo = trafo)
+ 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))
+ res$risk$asMSE <- list(value = Cov + r^2*b^2,
+ r = r,
+ at = neighbor)
return(res)
}
- bmin <- getAsRisk(risk = asBias(biastype = biastype, normtype = normtype),
- L2deriv = L2deriv, neighbor = neighbor,
- biastype = biastype, trafo = trafo)$asBias
+ 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")
+
+ } 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")
- res <- getInfRobIC(L2deriv = L2deriv, risk = asBias(biastype = biastype),
- neighbor = neighbor, symm = symm,
- trafo = trafo, maxiter = maxiter, tol = tol)
Risk <- list(asMSE = res$risk$asCov + neighbor at radius^2*bmin^2)
res$risk <- c(Risk, res$risk)
return(res)
}
+# bmin <- getAsRisk(risk = asBias(biastype = biastype, normtype = normtype),
+# L2deriv = L2deriv, neighbor = neighbor,
+# biastype = biastype, trafo = trafo, Finfo = Finfo,
+# warn = warn)$asBias
+# if(b <= bmin){
+# if(warn) cat("'b <= minimum asymptotic bias'\n",
+# "=> the minimum asymptotic bias (lower case) solution is returned\n")
+# res <- getInfRobIC(L2deriv = L2deriv, risk = asBias(biastype = biastype),
+# neighbor = neighbor, symm = symm,
+# trafo = trafo, maxiter = maxiter, tol = tol, Finfo = Finfo,
+# warn = warn)
+# Risk <- list(asMSE = res$risk$asCov + neighbor at radius^2*bmin^2)
+# res$risk <- c(Risk, res$risk)
+# return(res)
+# }
c0 <- b/as.vector(A)
if(is(symm, "SphericalSymmetry"))
S <- symm at SymmCenter == 0
@@ -68,8 +97,17 @@
# getAsRisk(risk = asHampel(), L2deriv = L2deriv, neighbor = neighbor,
# biastype = biastype, clip = b, cent = a, stand = A)$asCov
- Risk <- list(asCov = Cov, asBias = b, asMSE = Cov + neighbor at radius^2*b^2)
+ r <- neighbor at radius
+ Risk <- list(asCov = Cov,
+ asBias = list(value = b, biastype = biastype,
+ normtype = normtype,
+ neighbortype = class(neighbor)),
+ trAsCov = list(value = Cov, normtype = normtype),
+ asMSE = list(value = Cov + r^2*b^2,
+ r = r,
+ at = neighbor))
+
if(is(neighbor,"ContNeighborhood"))
{w <- new("HampelWeight")
clip(w) <- b
@@ -82,7 +120,6 @@
}
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = NormType())
-
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info,
w = w, biastype = biastype, normtype = NormType()))
})
@@ -119,20 +156,38 @@
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,
- Distr = Distr, Finfo = Finfo, trafo = trafo)
+ Distr = Distr, Finfo = Finfo, trafo = trafo,
+ QuadForm = std)
+ 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))
+ res$risk$asMSE <- list(value = trAsCov + r^2*b^2,
+ r = r,
+ at = neighbor)
return(res)
}
+
res <- getInfRobIC(L2deriv = L2deriv,
- risk = asBias(biastype = biastype, normtype = normtype),
- 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)
+ risk = asBias(biastype = biastype, normtype = normtype),
+ 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)
bmin <- res$b
+
cat("minimal bound:\t", bmin, "\n")
if(b <= bmin){
if(warn) cat("'b <= minimum asymptotic bias'\n",
"=> the minimum asymptotic bias (lower case) solution is returned\n")
+
+ asMSE <- sum(diag(std%*%res$risk$asCov)) + neighbor at radius^2*bmin^2
+ if(!is.null(res$risk$asMSE)) res$risk$asMSE <- asMSE
+ else res$risk <- c(list(asMSE = asMSE), res$risk)
+
return(res)
}
@@ -199,9 +254,17 @@
#getAsRisk(risk = asCov(), L2deriv = L2deriv, neighbor = neighbor,
# biastype = biastype, Distr = Distr, clip = b, cent = a,
# stand = A)$asCov
- Risk <- list(trAsCov = sum(diag(std%*%Cov)), asCov = Cov, asBias = b,
- asMSE = sum(diag(std%*%Cov)) + neighbor at radius^2*b^2)
-
+ trAsCov <- sum(diag(std%*%Cov)); r <- neighbor at radius
+ Risk <- list(trAsCov = list(value = trAsCov,
+ normtype = normtype),
+ asCov = Cov,
+ asBias = list(value = b, biastype = biastype,
+ normtype = normtype,
+ 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-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -14,6 +14,13 @@
res <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
neighbor = TotalVarNeighborhood(radius = neighbor at radius),
Finfo = Finfo, trafo = trafo)
+ if(is(neighbor, "ContNeighborhoood"))
+ {
+ res.c <- getInfRobIC(L2deriv = L2deriv, risk = asCov(),
+ neighbor = ContNeighborhood(radius = neighbor at radius),
+ Finfo = Finfo, trafo = trafo)
+ 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)
Modified: pkg/ROptEst/R/getRiskIC.R
===================================================================
--- pkg/ROptEst/R/getRiskIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/getRiskIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -31,7 +31,7 @@
L2Fam <- eval(IC at CallL2Fam)}
print(L2Fam)
return(list(asBias = list(distribution = .getDistr(L2Fam),
- neighborhood = neighbor at type, value = IC at Risks[["asBias"]])))
+ neighborhood = neighbor at type, value = IC at Risks$asBias$value)))
})
Modified: pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- pkg/ROptEst/R/leastFavorableRadius.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/leastFavorableRadius.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -51,7 +51,8 @@
bmin <- getAsRisk(risk = asBias(biastype = biastype),
L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
- trafo = L2Fam at param@trafo, symm = L2Fam at L2derivSymm[[1]])
+ trafo = L2Fam at param@trafo, symm = L2Fam at L2derivSymm[[1]],
+ Finfo = L2Fam at FisherInfo, warn = warn)
upRisk <- bmin^2
}else{
neighbor at radius <- upRad
@@ -64,12 +65,14 @@
clip = resUp$b, cent = resUp$a,
stand = resUp$A, trafo = L2Fam at param@trafo)[[1]]
}
+ loNorm<- upNorm <- NormType()
leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
risk = risk, loRad = loRad, upRad = upRad, loRisk = loRisk,
upRisk = upRisk, upper.b = upper.b, eps = eps, MaxIter = MaxIter,
- warn = warn)$root
- options(ow)
+ warn = warn,
+ loNorm = loNorm, upNorm = upNorm)$root
+ options(ow)
cat("current radius:\t", r, "\tinefficiency:\t", ineff, "\n")
return(ineff)
}
@@ -120,6 +123,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
loRisk <- sum(diag(std%*%FI0))
+ loNorm <- normtype
}else{
neighbor at radius <- loRad
resLo <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
@@ -133,10 +137,11 @@
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
}
if(upRad == Inf){
- bmin <- getAsRisk(risk = asBias(biastype = biastype(risk),
+ biasR <- getAsRisk(risk = asBias(biastype = biastype(risk),
normtype = normtype), L2deriv = L2deriv,
neighbor = neighbor, biastype = biastype,
Distr = L2Fam at distribution,
@@ -145,8 +150,11 @@
L2derivDistrSymm= L2derivDistrSymm,
trafo = trafo, z.start = z.start,
A.start = A.start,
- maxiter = maxiter, tol = tol)$asBias
+ maxiter = maxiter, tol = tol,
+ Finfo = L2Fam at FisherInfo, warn = warn)
+ bmin <- biasR$asBias
upRisk <- bmin^2
+ upNorm <- biasR$normtype
}else{
neighbor at radius <- upRad
resUp <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
@@ -160,13 +168,15 @@
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
}
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 = eps, MaxIter = MaxIter, warn = warn)$root
+ eps = eps, MaxIter = MaxIter, warn = warn,
+ loNorm = loNorm, upNorm = upNorm)$root
options(ow)
cat("current radius:\t", r, "\tinefficiency:\t", ineff, "\n")
return(ineff)
Modified: pkg/ROptEst/R/optIC.R
===================================================================
--- pkg/ROptEst/R/optIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/optIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -3,7 +3,7 @@
###############################################################################
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){
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE){
L2derivDim <- numberOfMaps(model at center@L2deriv)
if(L2derivDim == 1){
ow <- options("warn")
@@ -12,7 +12,8 @@
neighbor = model at neighbor, risk = risk,
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)
+ upper = upper, maxiter = maxiter, tol = tol, warn = warn,
+ noLow = noLow)
options(ow)
res$info <- c("optIC", res$info)
return(generateIC(model at neighbor, model at center, res))
Modified: pkg/ROptEst/R/optRisk.R
===================================================================
--- pkg/ROptEst/R/optRisk.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/optRisk.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -12,7 +12,7 @@
setMethod("optRisk", 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){
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE){
L2derivDim <- numberOfMaps(model at center@L2deriv)
if(L2derivDim == 1){
ow <- options("warn")
@@ -21,7 +21,8 @@
neighbor = model at neighbor, risk = risk,
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)
+ upper = upper, maxiter = maxiter, tol = tol, warn = warn,
+ noLow = noLow)
options(ow)
return(res$risk)
}else{
Modified: pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptEst/R/radiusMinimaxIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/R/radiusMinimaxIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -45,7 +45,9 @@
bmin <- getAsRisk(risk = asBias(biastype = biastype),
L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
- trafo = L2Fam at param@trafo)$asBias
+ trafo = L2Fam at param@trafo,
+ Finfo = L2Fam at FisherInfo,
+ warn = warn)$asBias
upRisk <- bmin^2
}else{
neighbor at radius <- upRad
@@ -59,11 +61,13 @@
stand = resUp$A, trafo = L2Fam at param@trafo)[[1]]
}
+ loNorm<- upNorm <- NormType()
leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
upper.b = upper.b, risk = risk, loRad = loRad, upRad = upRad,
loRisk = loRisk, upRisk = upRisk, eps = tol,
- MaxIter = maxiter, warn = warn)$root
+ MaxIter = maxiter, warn = warn,
+ loNorm = loNorm, upNorm = upNorm)$root
neighbor at radius <- leastFavR
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivSymm[[1]],
@@ -123,6 +127,7 @@
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
loRisk <- sum(diag(std%*%FI0))
+ loNorm <- normtype
}else{
neighbor at radius <- loRad
resLo <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
@@ -137,10 +142,11 @@
neighbor = neighbor, biastype = biastype,
clip = resLo$b, cent = resLo$a,
stand = resLo$A, trafo = trafo)[[1]]
+ loNorm <- resLo$normtype
}
if(upRad == Inf){
- bmin <- getAsRisk(risk = asBias(biastype = biastype(risk),
+ biasR <- getAsRisk(risk = asBias(biastype = biastype(risk),
normtype = normtype), L2deriv = L2deriv,
neighbor = neighbor, biastype = biastype,
Distr = L2Fam at distribution,
@@ -149,7 +155,10 @@
L2derivDistrSymm= L2derivDistrSymm,
trafo = trafo, z.start = z.start,
A.start = A.start,
- maxiter = maxiter, tol = tol)$asBias
+ maxiter = maxiter, tol = tol,
+ Finfo = L2Fam at FisherInfo, warn = warn)
+ bmin <- biasR$asBias
+ upNorm <- biasR$normtype
upRisk <- bmin^2
}else{
neighbor at radius <- upRad
@@ -163,12 +172,14 @@
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
}
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)$root
+ eps = tol, MaxIter = maxiter, warn = warn,
+ loNorm = loNorm, upNorm = upNorm)$root
neighbor at radius <- leastFavR
res <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk,
Distr = L2Fam at distribution, DistrSymm = L2Fam at distrSymm,
Modified: pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: pkg/ROptEst/chm/getAsRisk.html
===================================================================
--- pkg/ROptEst/chm/getAsRisk.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/getAsRisk.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -48,7 +48,7 @@
## S4 method for signature 'asMSE, EuclRandVariable,
## Neighborhood, ANY':
-getAsRisk(risk, L2deriv, neighbor, biastype, clip, cent, stand, trafo, norm = EuclideanNorm)
+getAsRisk(risk, L2deriv, neighbor, biastype, clip, cent, stand, trafo)
## S4 method for signature 'asBias, UnivariateDistribution,
## ContNeighborhood, ANY':
@@ -69,7 +69,7 @@
## S4 method for signature 'asBias, RealRandVariable,
## ContNeighborhood, ANY':
getAsRisk(risk, L2deriv, neighbor, biastype, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, trafo, z.start, A.start, maxiter, tol, norm = EuclideanNorm)
+ L2derivDistrSymm, trafo, z.start, A.start, maxiter, tol, warn)
## S4 method for signature 'asCov, UnivariateDistribution,
## ContNeighborhood, ANY':
@@ -81,7 +81,7 @@
## S4 method for signature 'asCov, RealRandVariable,
## ContNeighborhood, ANY':
-getAsRisk(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, norm = EuclideanNorm)
+getAsRisk(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand)
## S4 method for signature 'trAsCov,
## UnivariateDistribution, UncondNeighborhood, ANY':
@@ -89,7 +89,7 @@
## S4 method for signature 'trAsCov, RealRandVariable,
## ContNeighborhood, ANY':
-getAsRisk(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, norm = EuclideanNorm)
+getAsRisk(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, normtype)
## S4 method for signature 'asUnOvShoot,
## UnivariateDistribution, UncondNeighborhood, ANY':
@@ -157,9 +157,12 @@
<tr valign="top"><td><code>tol</code></td>
<td>
the desired accuracy (convergence tolerance).</td></tr>
-<tr valign="top"><td><code>norm</code></td>
+<tr valign="top"><td><code>warn</code></td>
<td>
-function; norm for the parameter space</td></tr>
+logical: print warnings. </td></tr>
+<tr valign="top"><td><code>normtype</code></td>
+<td>
+object of class <code>"NormType"</code>. </td></tr>
</table>
<h3>Value</h3>
Modified: pkg/ROptEst/chm/getIneffDiff.html
===================================================================
--- pkg/ROptEst/chm/getIneffDiff.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/getIneffDiff.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -33,7 +33,8 @@
## UncondNeighborhood, asMSE':
getIneffDiff(
radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk,
- z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn)
+ z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
+ loNorm = NULL, upNorm = NULL)
</pre>
@@ -85,6 +86,16 @@
<tr valign="top"><td><code>warn</code></td>
<td>
logical: print warnings. </td></tr>
+<tr valign="top"><td><code>loNorm</code></td>
+<td>
+object of class <code>"NormType"</code>; used in selfstandardization
+to evaluate the bias of the current IC in the norm of the lower
+bound</td></tr>
+<tr valign="top"><td><code>upNorm</code></td>
+<td>
+object of class <code>"NormType"</code>; used in selfstandardization
+to evaluate the bias of the current IC in the norm of the upper
+bound</td></tr>
</table>
<h3>Value</h3>
Modified: pkg/ROptEst/chm/getInfRobIC.html
===================================================================
--- pkg/ROptEst/chm/getInfRobIC.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/getInfRobIC.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -48,22 +48,23 @@
## S4 method for signature 'RealRandVariable, asCov,
## ContNeighborhood':
-getInfRobIC(L2deriv, risk, neighbor, Distr, Finfo, trafo)
+getInfRobIC(L2deriv, risk, neighbor, Distr, Finfo, trafo,
+ QuadForm = diag(nrow(trafo)))
## S4 method for signature 'UnivariateDistribution, asBias,
## UncondNeighborhood':
getInfRobIC(L2deriv, risk, neighbor, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
## S4 method for signature 'RealRandVariable, asBias,
## ContNeighborhood':
getInfRobIC(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol)
+ L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol, warn)
## S4 method for signature 'UnivariateDistribution,
## asHampel, UncondNeighborhood':
getInfRobIC(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn)
+ upper, maxiter, tol, warn, noLow = FALSE)
## S4 method for signature 'RealRandVariable, asHampel,
## ContNeighborhood':
@@ -142,6 +143,14 @@
<tr valign="top"><td><code>warn</code></td>
<td>
logical: print warnings. </td></tr>
+<tr valign="top"><td><code>noLow</code></td>
+<td>
+logical: is lower case to be computed? </td></tr>
+<tr valign="top"><td><code>QuadForm</code></td>
+<td>
+matrix of (or which may coerced to) class
+<code>PosSemDefSymmMatrix</code> for use of different
+(standardizing) norm </td></tr>
</table>
<h3>Value</h3>
Modified: pkg/ROptEst/chm/minmaxBias.html
===================================================================
--- pkg/ROptEst/chm/minmaxBias.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/minmaxBias.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -36,27 +36,27 @@
## S4 method for signature 'UnivariateDistribution,
## ContNeighborhood, BiasType':
minmaxBias(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, Finfo)
## S4 method for signature 'UnivariateDistribution,
## ContNeighborhood, asymmetricBias':
minmaxBias(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
## S4 method for signature 'UnivariateDistribution,
## ContNeighborhood, onesidedBias':
minmaxBias(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
## S4 method for signature 'UnivariateDistribution,
## TotalVarNeighborhood, BiasType':
minmaxBias(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
## S4 method for signature 'RealRandVariable,
## ContNeighborhood, BiasType':
minmaxBias(L2deriv, neighbor, biastype, Distr,
- L2derivDistrSymm, z.start, A.start, z.comp, A.comp, trafo, maxiter, tol)
+ L2derivDistrSymm, z.start, A.start, z.comp, A.comp, trafo, maxiter, tol, warn)
</pre>
@@ -107,6 +107,12 @@
<tr valign="top"><td><code>tol</code></td>
<td>
the desired accuracy (convergence tolerance).</td></tr>
+<tr valign="top"><td><code>warn</code></td>
+<td>
+logical: print warnings. </td></tr>
+<tr valign="top"><td><code>Finfo</code></td>
+<td>
+Fisher information matrix. </td></tr>
</table>
<h3>Value</h3>
Modified: pkg/ROptEst/chm/optIC.html
===================================================================
--- pkg/ROptEst/chm/optIC.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/optIC.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -32,7 +32,7 @@
## S4 method for signature 'InfRobModel, asRisk':
optIC(model, risk,
z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE)
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE)
## S4 method for signature 'InfRobModel, asUnOvShoot':
optIC(model, risk,
@@ -84,6 +84,9 @@
<tr valign="top"><td><code>cont</code></td>
<td>
"left" or "right". </td></tr>
+<tr valign="top"><td><code>noLow</code></td>
+<td>
+logical: is lower case to be computed? </td></tr>
</table>
<h3>Details</h3>
Modified: pkg/ROptEst/chm/optRisk.html
===================================================================
--- pkg/ROptEst/chm/optRisk.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/chm/optRisk.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -36,7 +36,7 @@
## S4 method for signature 'InfRobModel, asRisk':
optRisk(model, risk,
z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE)
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE)
## S4 method for signature 'FixRobModel, fiUnOvShoot':
optRisk(model, risk, sampleSize, upper = 1e4, maxiter = 50,
@@ -83,6 +83,9 @@
<tr valign="top"><td><code>cont</code></td>
<td>
"left" or "right". </td></tr>
+<tr valign="top"><td><code>noLow</code></td>
+<td>
+logical: is lower case to be computed? </td></tr>
</table>
<h3>Details</h3>
Modified: pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
===================================================================
--- pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -75,6 +75,15 @@
plot(N0.IC4.i)
infoPlot(N0.IC4.i)
+## takes extremely long time:
+(N0.IC4.s <- radiusMinimaxIC(L2Fam=N0, neighbor=ContNeighborhood(),
+ risk=asMSE(normtype=SelfNorm()), loRad=0, upRad=Inf))
+checkIC(N0.IC4.s)
+Risks(N0.IC4.s)
+plot(N0.IC4.s)
+infoPlot(N0.IC4.s)
+
+
# least favorable radius
# (may take quite some time!)
#N0.r.rho1 <- leastFavorableRadius(L2Fam=N0, neighbor=ContNeighborhood(),
Modified: pkg/ROptEst/man/getAsRisk.Rd
===================================================================
--- pkg/ROptEst/man/getAsRisk.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/getAsRisk.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -27,7 +27,7 @@
\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, norm = EuclideanNorm)
+\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)
@@ -38,17 +38,17 @@
\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, norm = EuclideanNorm)
+ 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,TotalVarNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, clip, cent, stand)
-\S4method{getAsRisk}{asCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, Distr, clip, cent, stand, norm = EuclideanNorm)
+\S4method{getAsRisk}{asCov,RealRandVariable,ContNeighborhood,ANY}(risk, L2deriv, neighbor, biastype, Distr, 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, norm = EuclideanNorm)
+\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)
@@ -74,7 +74,8 @@
\item{A.start}{ initial value for the standardizing matrix. }
\item{maxiter}{ the maximum number of iterations }
\item{tol}{ the desired accuracy (convergence tolerance).}
- \item{norm}{function; norm for the parameter space}
+ \item{warn}{ logical: print warnings. }
+ \item{normtype}{ object of class \code{"NormType"}. }
}
%\details{}
\value{The asymptotic risk is computed.}
Modified: pkg/ROptEst/man/getIneffDiff.Rd
===================================================================
--- pkg/ROptEst/man/getIneffDiff.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/getIneffDiff.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -14,7 +14,8 @@
\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)
+ z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
+ loNorm = NULL, upNorm = NULL)
}
\arguments{
\item{radius}{ neighborhood radius. }
@@ -32,6 +33,12 @@
\item{MaxIter}{ the maximum number of iterations }
\item{eps}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
+ \item{loNorm}{object of class \code{"NormType"}; used in selfstandardization
+ to evaluate the bias of the current IC in the norm of the lower
+ bound}
+ \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}
}
%\details{}
\value{The inefficieny difference between the left and
Modified: pkg/ROptEst/man/getInfRobIC.Rd
===================================================================
--- pkg/ROptEst/man/getInfRobIC.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/getInfRobIC.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -25,16 +25,17 @@
\S4method{getInfRobIC}{UnivariateDistribution,asCov,TotalVarNeighborhood}(L2deriv, risk, neighbor, Finfo, trafo)
-\S4method{getInfRobIC}{RealRandVariable,asCov,ContNeighborhood}(L2deriv, risk, neighbor, Distr, Finfo, trafo)
+\S4method{getInfRobIC}{RealRandVariable,asCov,ContNeighborhood}(L2deriv, risk, neighbor, Distr, Finfo, trafo,
+ QuadForm = diag(nrow(trafo)))
\S4method{getInfRobIC}{UnivariateDistribution,asBias,UncondNeighborhood}(L2deriv, risk, neighbor, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
\S4method{getInfRobIC}{RealRandVariable,asBias,ContNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
- L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol)
+ L2derivDistrSymm, z.start, A.start, Finfo, trafo, maxiter, tol, warn)
\S4method{getInfRobIC}{UnivariateDistribution,asHampel,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, maxiter, tol, warn)
+ upper, maxiter, tol, warn, noLow = FALSE)
\S4method{getInfRobIC}{RealRandVariable,asHampel,ContNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, Finfo, z.start, A.start, trafo, upper, maxiter, tol, warn)
@@ -67,6 +68,10 @@
\item{maxiter}{ the maximum number of iterations. }
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{warn}{ logical: print warnings. }
+ \item{noLow}{ logical: is lower case to be computed? }
+ \item{QuadForm}{ matrix of (or which may coerced to) class
+ \code{PosSemDefSymmMatrix} for use of different
+ (standardizing) norm }
}
%\details{}
\value{The optimally robust IC is computed.}
Modified: pkg/ROptEst/man/minmaxBias.Rd
===================================================================
--- pkg/ROptEst/man/minmaxBias.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/minmaxBias.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -17,19 +17,19 @@
minmaxBias(L2deriv, neighbor, biastype, ...)
\S4method{minmaxBias}{UnivariateDistribution,ContNeighborhood,BiasType}(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, Finfo)
\S4method{minmaxBias}{UnivariateDistribution,ContNeighborhood,asymmetricBias}(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
\S4method{minmaxBias}{UnivariateDistribution,ContNeighborhood,onesidedBias}(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ maxiter, tol, warn, Finfo)
\S4method{minmaxBias}{UnivariateDistribution,TotalVarNeighborhood,BiasType}(L2deriv, neighbor, biastype, symm, trafo,
- maxiter, tol)
+ 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)
+ L2derivDistrSymm, z.start, A.start, z.comp, A.comp, trafo, maxiter, tol, warn)
}
\arguments{
@@ -48,6 +48,8 @@
\item{trafo}{ matrix: transformation of the parameter. }
\item{maxiter}{ the maximum number of iterations. }
\item{tol}{ the desired accuracy (convergence tolerance).}
+ \item{warn}{ logical: print warnings. }
+ \item{Finfo}{ Fisher information matrix. }
}
%\details{}
\value{The bias-optimally robust IC is computed.}
Modified: pkg/ROptEst/man/optIC.Rd
===================================================================
--- pkg/ROptEst/man/optIC.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/optIC.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -14,7 +14,7 @@
\S4method{optIC}{InfRobModel,asRisk}(model, risk,
z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE)
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE)
\S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk,
upper = 1e4, maxiter = 50,
@@ -36,6 +36,7 @@
\item{sampleSize}{ integer: sample size. }
\item{Algo}{ "A" or "B". }
\item{cont}{ "left" or "right". }
+ \item{noLow}{ logical: is lower case to be computed? }
}
\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: pkg/ROptEst/man/optRisk.Rd
===================================================================
--- pkg/ROptEst/man/optRisk.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/ROptEst/man/optRisk.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -17,7 +17,7 @@
\S4method{optRisk}{InfRobModel,asRisk}(model, risk,
z.start = NULL, A.start = NULL, upper = 1e4,
- maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE)
+ maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE)
\S4method{optRisk}{FixRobModel,fiUnOvShoot}(model, risk, sampleSize, upper = 1e4, maxiter = 50,
tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A", cont = "left")
@@ -35,6 +35,7 @@
\item{sampleSize}{ integer: sample size. }
\item{Algo}{ "A" or "B". }
\item{cont}{ "left" or "right". }
+ \item{noLow}{ logical: is lower case to be computed? }
}
\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: pkg/RobAStBase/R/ContIC.R
===================================================================
--- pkg/RobAStBase/R/ContIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/R/ContIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -58,6 +58,7 @@
d <- res$d
normtype <- res$normtype
biastype <- res$biastype
+ if(is.null(res$w)) res$w <- new("HampelWeight")
w <- res$w
return(ContIC(
name = "IC of contamination type",
Modified: pkg/RobAStBase/R/TotalVarIC.R
===================================================================
--- pkg/RobAStBase/R/TotalVarIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/R/TotalVarIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -44,7 +44,8 @@
A <- res$A
clipLo <- sign(as.vector(A))*res$a
b <- res$b
- w <- res$w
+ 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")
if((clipLo == -Inf) & (b == Inf))
Modified: pkg/RobAStBase/R/getBiasIC.R
===================================================================
--- pkg/RobAStBase/R/getBiasIC.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/R/getBiasIC.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -4,14 +4,17 @@
setMethod("getBiasIC", signature(IC = "IC",
neighbor = "UncondNeighborhood"),
function(IC, neighbor, L2Fam, biastype = symmetricBias(),
- normtype = NormType(), tol = .Machine$double.eps^0.25){
+ normtype = NormType(), tol = .Machine$double.eps^0.25,
+ numbeval = 1e5){
+
+ misF <- FALSE
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'")
- x <- as.matrix(r(D1)(1e5))
+ x <- as.matrix(r(D1)(numbeval))
x <- as.matrix(x[!duplicated(x),])
Bias <- .evalBiasIC(IC = IC, neighbor = neighbor, biastype = biastype,
@@ -23,7 +26,6 @@
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),
neighborhood = neighbor at type, value = Bias)))
})
@@ -36,8 +38,7 @@
biastype = "BiasType"),
function(IC, neighbor, biastype, normtype, x, trafo){
ICx <- evalRandVar(as(diag(dimension(IC at Curve)) %*% IC at Curve,
- "EuclRandVariable"),x)
-
+ "EuclRandVariable"),x)[,,1]
return(max(fct(normtype)(ICx)))}
)
Modified: pkg/RobAStBase/R/infoPlot.R
===================================================================
--- pkg/RobAStBase/R/infoPlot.R 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/R/infoPlot.R 2008-03-30 12:21:31 UTC (rev 83)
@@ -30,9 +30,7 @@
if (is(normtype(object),"SelfNorm")|is(normtype(object),"InfoNorm"))
QFc <- QFc0
}
- print(QFc)
QFc.5 <- sqrt(PosSemDefSymmMatrix(QFc))
- print(QFc.5)
classIC <- as(trafo %*% solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
absInfoClass <- t(classIC) %*% QFc %*% classIC
@@ -41,9 +39,7 @@
QF <- diag(dims)
if(is(object,"ContIC") & dims>1 )
{if (is(normtype(object),"QFNorm")) QF <- QuadForm(normtype(object))}
- print(QF)
QF.5 <- sqrt(PosSemDefSymmMatrix(QF))
- print(QF.5)
IC1 <- as(diag(dims) %*% object at Curve, "EuclRandVariable")
absInfo <- t(IC1) %*% QF %*% IC1
Modified: pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/chm/getBiasIC.html
===================================================================
--- pkg/RobAStBase/chm/getBiasIC.html 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/chm/getBiasIC.html 2008-03-30 12:21:31 UTC (rev 83)
@@ -29,7 +29,7 @@
## S4 method for signature 'IC, UncondNeighborhood':
getBiasIC(IC, neighbor, L2Fam, biastype = symmetricBias(),
- normtype = NormType(), tol = .Machine$double.eps^0.25)
+ normtype = NormType(), tol = .Machine$double.eps^0.25, numbeval = 1e5)
</pre>
@@ -57,6 +57,9 @@
<tr valign="top"><td><code>tol</code></td>
<td>
the desired accuracy (convergence tolerance).</td></tr>
+<tr valign="top"><td><code>numbeval</code></td>
+<td>
+number of evalation points.</td></tr>
</table>
<h3>Details</h3>
Modified: pkg/RobAStBase/man/getBiasIC.Rd
===================================================================
--- pkg/RobAStBase/man/getBiasIC.Rd 2008-03-29 04:54:44 UTC (rev 82)
+++ pkg/RobAStBase/man/getBiasIC.Rd 2008-03-30 12:21:31 UTC (rev 83)
@@ -11,7 +11,7 @@
getBiasIC(IC, neighbor, ...)
\S4method{getBiasIC}{IC,UncondNeighborhood}(IC, neighbor, L2Fam, biastype = symmetricBias(),
- normtype = NormType(), tol = .Machine$double.eps^0.25)
+ normtype = NormType(), tol = .Machine$double.eps^0.25, numbeval = 1e5)
}
\arguments{
\item{IC}{ object of class \code{"InfluenceCurve"} }
@@ -21,6 +21,7 @@
\item{biastype}{object of class \code{"BiasType"}}
\item{normtype}{object of class \code{"NormType"}}
\item{tol}{ the desired accuracy (convergence tolerance).}
+ \item{numbeval}{number of evalation points.}
}
\details{}
\value{The bias of the IC is computed.}
More information about the Robast-commits
mailing list