[Robast-commits] r357 - in branches/robast-0.7/pkg/ROptEst: R chm man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 28 14:34:38 CEST 2009
Author: ruckdeschel
Date: 2009-08-28 14:34:38 +0200 (Fri, 28 Aug 2009)
New Revision: 357
Modified:
branches/robast-0.7/pkg/ROptEst/R/LowerCaseMultivariate.R
branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R
branches/robast-0.7/pkg/ROptEst/R/getInfCent.R
branches/robast-0.7/pkg/ROptEst/R/getInfGamma.R
branches/robast-0.7/pkg/ROptEst/R/getInfLM.R
branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asBias.R
branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asCov.R
branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R
branches/robast-0.7/pkg/ROptEst/R/getInfV.R
branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R
branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R
branches/robast-0.7/pkg/ROptEst/R/optIC.R
branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R
branches/robast-0.7/pkg/ROptEst/R/roptest.R
branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
branches/robast-0.7/pkg/ROptEst/chm/getIneffDiff.html
branches/robast-0.7/pkg/ROptEst/chm/getInfRobIC.html
branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html
branches/robast-0.7/pkg/ROptEst/chm/internals.html
branches/robast-0.7/pkg/ROptEst/chm/leastFavorableRadius.html
branches/robast-0.7/pkg/ROptEst/chm/minmaxBias.html
branches/robast-0.7/pkg/ROptEst/chm/optIC.html
branches/robast-0.7/pkg/ROptEst/chm/radiusMinimaxIC.html
branches/robast-0.7/pkg/ROptEst/chm/roptest.html
branches/robast-0.7/pkg/ROptEst/man/getIneffDiff.Rd
branches/robast-0.7/pkg/ROptEst/man/getInfRobIC.Rd
branches/robast-0.7/pkg/ROptEst/man/getinfLM.Rd
branches/robast-0.7/pkg/ROptEst/man/internals.Rd
branches/robast-0.7/pkg/ROptEst/man/leastFavorableRadius.Rd
branches/robast-0.7/pkg/ROptEst/man/minmaxBias.Rd
branches/robast-0.7/pkg/ROptEst/man/optIC.Rd
branches/robast-0.7/pkg/ROptEst/man/radiusMinimaxIC.Rd
branches/robast-0.7/pkg/ROptEst/man/roptest.Rd
Log:
++ noticed several errors when trying to get the scripts in /inst running ...
ROptEst again:
+setting of default for argument verbose moved in the function
+changed search interval for getInfCent Totalvariation one-dim
+use of lower.tail = FALSE instead of 1-p in getInfGamma.R
+changed default search interval for b in getInfRobIC_asGRisk (one-dim)
+corrected a simple bug in scaleUpdateIC for UncondNeighborhoods
+changed detault search interval for r in radiusMinimaxIC.R
Modified: branches/robast-0.7/pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/LowerCaseMultivariate.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/LowerCaseMultivariate.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -1,8 +1,11 @@
.LowerCaseMultivariate <- function(L2deriv, neighbor, biastype,
normtype, Distr, Finfo, trafo, z.start,
A.start, z.comp, A.comp, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose")){
+ verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
w <- new("HampelWeight")
if(is.null(z.start)) z.start <- numeric(ncol(trafo))
@@ -76,8 +79,11 @@
.LowerCaseMultivariateTV <- function(L2deriv, neighbor, biastype,
normtype, Distr, Finfo, trafo,
A.start, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose")){
+ verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
w <- new("BdStWeight")
k <- ncol(trafo)
Modified: branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getIneffDiff.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -9,9 +9,13 @@
z.start = NULL, A.start = NULL, upper.b = NULL, lower.b = NULL,
MaxIter, eps, warn,
loNorm = NULL, upNorm = NULL,
- verbose = getRobAStBaseOption("all.verbose"), ...){
+ verbose = NULL, ...){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
if(L2derivDim == 1){
+ ##print(radius)
neighbor at radius <- radius
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
@@ -20,11 +24,18 @@
warn = warn, verbose = verbose)
trafo <- as.vector(trafo(L2Fam at param))
ineffLo <- (as.vector(res$A)*trafo - res$b^2*(radius^2-loRad^2))/loRisk
+ ####cat("---------------\n")
+ ##res00=res;res00$w <- NULL; res00$biastype <- NULL; res00$d <- NULL
+ ##res00$normtype <- NULL;res00$info <- NULL;res00$risk <- NULL;
+ ##print(res00)
+ ##print(c(lower.b,upper.b,loRisk,"upR"=upRisk))
+ ####cat("---------------\n")
if(upRad == Inf)
ineffUp <- res$b^2/upRisk
else
ineffUp <- (as.vector(res$A)*trafo - res$b^2*(radius^2-upRad^2))/upRisk
assign("ineff", ineffUp, envir = sys.frame(which = -4))
+ ##print(c(ineffUp,ineffLo,ineffUp - ineffLo))
return(ineffUp - ineffLo)
}else{
if(is(L2Fam at distribution, "UnivariateDistribution")){
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfCent.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfCent.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfCent.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -28,10 +28,9 @@
g.fct <- function(g, c0, D1){
return(g*p(D1)(g) + (g+c0)*(p(D1)(g+c0, lower.tail = FALSE)) - m1df(D1, g) + m1df(D1, g+c0))
}
- lower <- getLow(L2deriv)
- upper <- getUp(L2deriv)
-
- return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
+ lower <- -clip
+ upper <- 0
+ return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
c0 = clip, D1 = D1)$root)
})
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfGamma.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfGamma.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfGamma.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -9,7 +9,7 @@
c1 <- cent - clip
c2 <- cent + clip
return(m1df(L2deriv, c2) + m1df(L2deriv, c1)
- - c1*p(L2deriv)(c1) + c2*(1-p(L2deriv)(c2)))
+ - c1*p(L2deriv)(c1) + c2*p(L2deriv)(c2, lower.tail = FALSE))
})
###############################################################################
## r^2 b = E(c - A Lambda)_+ Probleme mit Startwerten!!!
@@ -20,7 +20,8 @@
neighbor = "TotalVarNeighborhood",
biastype = "BiasType"),
function(L2deriv, risk, neighbor, biastype, cent, clip){
- return(m1df(L2deriv, cent+clip) + (cent+clip)*(1-p(L2deriv)(cent+clip)))
+ return(m1df(L2deriv, cent+clip) + (cent+clip)*p(L2deriv)(cent+clip,
+ lower.tail = FALSE))
})
setMethod("getInfGamma", signature(L2deriv = "RealRandVariable",
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfLM.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfLM.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfLM.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -6,8 +6,9 @@
neighbor, biastype, normtype, Distr,
a.start, z.start, A.start, w.start, std,
z.comp, A.comp, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose"),
- warnit = TRUE){
+ verbose = NULL, warnit = TRUE){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
LMcall <- match.call()
## initialization
@@ -100,9 +101,10 @@
getLagrangeMultByOptim <- function(b, L2deriv, risk, FI, trafo,
neighbor, biastype, normtype, Distr,
a.start, z.start, A.start, w.start, std, z.comp,
- A.comp, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose"), ...){
+ A.comp, maxiter, tol, verbose = NULL, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
LMcall <- match.call()
### manipulate dots in call -> set control argument for optim
dots <- list(...)
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asBias.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asBias.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -6,8 +6,11 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, trafo, maxiter,
tol, warn, Finfo,
- verbose = getRobAStBaseOption("all.verbose"), ...){
- erg <- minmaxBias(L2deriv = L2deriv, neighbor = neighbor,
+ verbose = NULL, ...){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+ erg <- minmaxBias(L2deriv = L2deriv, neighbor = neighbor,
biastype = biastype(risk), symm = symm,
trafo = trafo, maxiter = maxiter,
tol = tol, warn = warn, Finfo = Finfo)
@@ -27,8 +30,11 @@
function(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, z.start,
A.start, Finfo, trafo, maxiter, tol, warn,
- verbose = getRobAStBaseOption("all.verbose"), ...){
+ verbose = NULL, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
k <- ncol(trafo); p <- nrow(trafo)
if(is(neighbor,"TotalVarNeighborhood") && p>1)
stop("Not yet implemented.")
@@ -157,8 +163,7 @@
stand(w) <- A
clip(w) <- c(a, a+b)
weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype)
-
- return(list(A = A, a = a, b = b, d = 0, risk = Risk, info = info,
+ return(list(A = A, a = a, b = b, d = 0, risk = Risk, info = info,
w = w, biastype = biastype, normtype = NormType()))
})
@@ -167,8 +172,10 @@
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, normtype, Distr,
z.start, A.start, z.comp, A.comp, Finfo, trafo, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose")){
+ verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
DA.comp <- abs(trafo) %*% A.comp != 0
eerg <- .LowerCaseMultivariate(L2deriv, neighbor, biastype,
normtype, Distr, Finfo, trafo, z.start,
@@ -228,7 +235,9 @@
biastype = "BiasType"),
function(L2deriv, neighbor, biastype, normtype, Distr,
z.start, A.start, z.comp, A.comp, Finfo, trafo, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose")){
+ verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
eerg <- .LowerCaseMultivariateTV(L2deriv = L2deriv,
neighbor = neighbor, biastype = biastype,
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asCov.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asCov.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asCov.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -4,7 +4,11 @@
setMethod("getInfRobIC", signature(L2deriv = "UnivariateDistribution",
risk = "asCov",
neighbor = "ContNeighborhood"),
- function(L2deriv, risk, neighbor, Finfo, trafo, verbose = getRobAStBaseOption("all.verbose")){
+ function(L2deriv, risk, neighbor, Finfo, trafo, verbose = NULL){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
info <- c("optimal IC in sense of Cramer-Rao bound")
A <- trafo %*% solve(Finfo)
@@ -33,7 +37,11 @@
setMethod("getInfRobIC", signature(L2deriv = "UnivariateDistribution",
risk = "asCov",
neighbor = "TotalVarNeighborhood"),
- function(L2deriv, risk, neighbor, Finfo, trafo, verbose = getRobAStBaseOption("all.verbose")){
+ function(L2deriv, risk, neighbor, Finfo, trafo, verbose = NULL){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
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))
@@ -62,8 +70,11 @@
risk = "asCov",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, Distr, Finfo, trafo,
- QuadForm = diag(nrow(trafo)), verbose = getRobAStBaseOption("all.verbose")){
+ QuadForm = diag(nrow(trafo)), verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
Cont <- is(neighbor,"ContNeighborhood")
p <- nrow(trafo)
if(! Cont && p>1)
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -6,9 +6,14 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower = NULL, maxiter, tol,
- warn, noLow = FALSE, verbose = getRobAStBaseOption("all.verbose")){
+ warn, noLow = FALSE, verbose = NULL){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
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")
@@ -34,11 +39,13 @@
z <- 0
c0 <- 0
iter <- 0
- if(is(symm, "SphericalSymmetry"))
+ if(is(symm, "SphericalSymmetry"))
S <- symm at SymmCenter == 0
else
S <- FALSE
-
+### print ---
+## assign("l2D",L2deriv,.GlobalEnv)
+###
prec <- 1
repeat{
iter <- iter + 1
@@ -47,16 +54,18 @@
## new
L1n <- getL1normL2deriv(L2deriv = L2deriv, cent = z)
lower0 <- L1n/(1 + radius^2)
- if(is(neighbor,"TotalVarNeighborhood")) {
- lower0 <- (L1n-z)/(1 + radius^2)/2}
+# if(is(neighbor,"TotalVarNeighborhood")) {
+# lower0 <- (L1n-z)/(1 + radius^2)/2}
upper0 <- max(L1n/radius,
sqrt( as.numeric( Finfo + z^2 )/(( 1 + radius^2)^2 - 1) ))
- if (is.null(lower)|(iter == 1))
- lower <- .Machine$double.eps^0.6
- else {if(iter>1) lower <- max(lower0,lower)}
- if (is.null(upper)|(iter == 1))
- upper <- 5* max(abs(trafo))*max(Finfo)
- else {if(iter>1) upper <- min(upper,upper0)}
+ if (is.null(lower))
+ lower <- .Machine$double.eps^0.75
+ else {if(iter>1) lower <- min(lower0,2*lower)}
+ if (is.null(upper))#|(iter == 1))
+ upper <- getUp(L2deriv)
+ else {if(iter>1) upper <- max(0.5*upper,3*upper0)}
+## print(c(lower,upper))
+ #lower <- 0; upper <- 100
##
c0 <- try(uniroot(getInfClip,
## new
@@ -66,6 +75,7 @@
neighbor = neighbor, biastype = biastype,
cent = z, symm = S,
trafo = trafo)$root, silent = TRUE)
+
if(!is.numeric(c0)){
if(warn) cat("The IC algorithm did not converge!\n",
"'radius >= maximum radius' for the given risk?\n",
@@ -84,10 +94,12 @@
}
z <- getInfCent(L2deriv = L2deriv, neighbor = neighbor, biastype = biastype,
clip = c0, cent = z, symm = S, trafo = trafo, tol.z = tol)
-# cat("c0:\t", c0, "c0.old:\t", c0.old, "z:\t", z, "z.old:\t", z.old, "\n")
+## cat("c0:\t", c0, "c0.old:\t", c0.old, "z:\t", z, "z.old:\t", z.old, "\n")
+
if(S) break
prec.old <- prec
+## print(c(c0,z))
prec <- max(abs(z - z.old), abs(c0-c0.old))
if(iter>1){
if(verbose)
@@ -142,7 +154,7 @@
weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
normW = NormType())
-
+## print(list(A = A, a = a, b = b))
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info, w = w,
biastype = biastype, normtype = normtype(risk)))
})
@@ -160,9 +172,12 @@
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE,
z.start, A.start, upper = NULL, lower = NULL,
OptOrIter = "iterate",
- maxiter, tol, warn, verbose = getRobAStBaseOption("all.verbose"),
+ maxiter, tol, warn, verbose = NULL,
...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
mc <- match.call()
## some abbreviations / checks
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -6,8 +6,11 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = getRobAStBaseOption("all.verbose"),
- checkBounds = TRUE){
+ verbose = NULL, checkBounds = TRUE){
+
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
biastype <- biastype(risk)
normtype <- normtype(risk)
@@ -140,9 +143,11 @@
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE,
z.start, A.start, upper = NULL, lower = NULL,
OptOrIter = "iterate", maxiter, tol, warn,
- verbose = getRobAStBaseOption("all.verbose"),
- checkBounds = TRUE, ...){
+ verbose = NULL, checkBounds = TRUE, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
+
mc <- match.call()
## some abbreviations / checks
Modified: branches/robast-0.7/pkg/ROptEst/R/getInfV.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfV.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfV.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -10,7 +10,7 @@
return(stand^2*(m2df(L2deriv, c2) - m2df(L2deriv, c1)
+ 2 * cent *(m1df(L2deriv, c1) - m1df(L2deriv, c2))
+ cent^2 * (p(L2deriv)(c2) -p(L2deriv)(c1))
- + clip^2 * (p(L2deriv)(c2, lower.tail=FALSE) +p(L2deriv)(c1))
+ + clip^2 * (p(L2deriv)(c2, lower.tail = FALSE) +p(L2deriv)(c1))
))
})
@@ -22,7 +22,7 @@
c1 <- cent
c2 <- clip+clip
return(stand^2*(m2df(L2deriv, c2) - m2df(L2deriv, c1)
- + c2^2 * (p(L2deriv)(c2, lower.tail=FALSE))
+ + c2^2 * (p(L2deriv)(c2, lower.tail = FALSE))
+ c1^2* p(L2deriv)(c1)
))
})
Modified: branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/getModifyIC.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -44,7 +44,7 @@
w <- weight(IC)
clip(w) <- sdneu*clip(w)/sdalt
stand(w) <- sdneu^2*stand(w)/sdalt^2
- weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = r),
+ weight(w) <- getweight(w, neighbor = neighbor,
biastype = biastype(IC),
normW = normtype(IC))
A <- sdneu^2*stand(IC)/sdalt^2
Modified: branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/leastFavorableRadius.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -7,7 +7,9 @@
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, verbose = getRobAStBaseOption("all.verbose")){
+ tol = .Machine$double.eps^0.4, warn = FALSE, verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
if(length(rho) != 1)
stop("'rho' is not of length == 1")
if((rho <= 0)||(rho >= 1))
Modified: branches/robast-0.7/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/optIC.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -4,7 +4,9 @@
setMethod("optIC", signature(model = "InfRobModel", risk = "asRisk"),
function(model, risk, z.start = NULL, A.start = NULL, upper = 1e4,
lower = 1e-4, maxiter = 50, tol = .Machine$double.eps^0.4,
- warn = TRUE, noLow = FALSE, verbose = getRobAStBaseOption("all.verbose"), ...){
+ warn = TRUE, noLow = FALSE, verbose = NULL, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
L2derivDim <- numberOfMaps(model at center@L2deriv)
ow <- options("warn")
on.exit(options(ow))
@@ -105,7 +107,9 @@
setMethod("optIC", signature(model = "FixRobModel", risk = "fiUnOvShoot"),
function(model, risk, sampleSize, upper = 1e4, lower = 1e-4, maxiter = 50,
tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A",
- cont = "left", verbose = getRobAStBaseOption("all.verbose")){
+ cont = "left", verbose = NULL){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
ow <- options("warn")
on.exit(options(ow))
if(!identical(all.equal(sampleSize, trunc(sampleSize)), TRUE))
Modified: branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/radiusMinimaxIC.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -5,10 +5,12 @@
setMethod("radiusMinimaxIC", signature(L2Fam = "L2ParamFamily",
neighbor = "UncondNeighborhood",
risk = "asGRisk"),
- function(L2Fam, neighbor, risk, loRad, upRad, z.start = NULL,
- A.start = NULL, upper = 1e5, lower=NULL, maxiter = 50,
+ function(L2Fam, neighbor, risk, loRad = 0, upRad = Inf, z.start = NULL,
+ A.start = NULL, upper = NULL, lower = NULL, maxiter = 50,
tol = .Machine$double.eps^0.4, warn = FALSE,
- verbose = getRobAStBaseOption("all.verbose"), ...){
+ verbose = NULL, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
ow <- options("warn")
on.exit(options(ow))
if(length(loRad) != 1)
@@ -28,9 +30,9 @@
options(warn = -1)
upper.b <- upper
lower.b <- lower
- lower <- ifelse(identical(all.equal(loRad, 0), TRUE), 1e-4, loRad)
- upper <- ifelse(upRad == Inf, max(loRad+1, 2), upRad)
-
+ lower <- if(identical(all.equal(loRad, 0), TRUE)) 1e-4 else loRad
+ upper <- if(upRad == Inf) max(lower+2, 4) else upRad
+ if(is(neighbor,"TotalVarNeighborhood")) {upper <- upper/2}
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
loRisk <- 1/as.vector(L2Fam at FisherInfo)
@@ -39,7 +41,7 @@
resLo <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivDistrSymm[[1]],
Finfo = L2Fam at FisherInfo, upper = upper.b, lower = lower.b,
- trafo = trafo, maxiter = maxiter, tol = tol,
+ trafo = trafo, maxiter = maxiter*6, tol = tol,
warn = warn, verbose = verbose)
loRisk <- getAsRisk(risk = risk, L2deriv = L2Fam at L2derivDistr[[1]],
neighbor = neighbor, biastype = biastype,
@@ -66,13 +68,14 @@
stand = resUp$A, trafo = trafo)[[1]]
}
+# print(c(loRad,loRisk,lower,lower.b,upRad,upRisk,upper,upper.b))
loNorm<- upNorm <- NormType()
leastFavR <- uniroot(getIneffDiff, lower = lower, upper = upper,
tol = .Machine$double.eps^0.25, L2Fam = L2Fam, neighbor = neighbor,
upper.b = upper.b, lower.b = lower.b, risk = risk, loRad = loRad, upRad = upRad,
loRisk = loRisk, upRisk = upRisk, eps = tol,
MaxIter = maxiter, warn = warn,
- loNorm = loNorm, upNorm = upNorm)$root
+ loNorm = loNorm, upNorm = upNorm, verbose=verbose)$root
neighbor at radius <- leastFavR
res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor,
risk = risk, symm = L2Fam at L2derivSymm[[1]],
Modified: branches/robast-0.7/pkg/ROptEst/R/roptest.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/roptest.R 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/R/roptest.R 2009-08-28 12:34:38 UTC (rev 357)
@@ -3,11 +3,13 @@
###############################################################################
roptest <- function(x, L2Fam, eps, eps.lower, eps.upper, fsCor = 1, initial.est,
neighbor = ContNeighborhood(), risk = asMSE(), steps = 1L,
- distance = CvMDist, startPar = NULL, verbose = FALSE,
+ distance = CvMDist, startPar = NULL, verbose = NULL,
useLast = getRobAStBaseOption("kStepUseLast"),
withUpdateInKer = getRobAStBaseOption("withUpdateInKer"),
IC.UpdateInKer = getRobAStBaseOption("IC.UpdateInKer"),
na.rm = TRUE, initial.est.ArgList, ...){
+ if(missing(verbose)|| is.null(verbose))
+ verbose <- getRobAStBaseOption("all.verbose")
es.call <- match.call()
if(missing(x))
stop("'x' is missing with no default")
Modified: branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/ROptEst/chm/getIneffDiff.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/getIneffDiff.html 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/chm/getIneffDiff.html 2009-08-28 12:34:38 UTC (rev 357)
@@ -33,9 +33,8 @@
getIneffDiff(
radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk,
z.start = NULL, A.start = NULL, upper.b = NULL, lower.b = NULL,
- MaxIter, eps, warn,
- loNorm = NULL, upNorm = NULL,
- verbose = getRobAStBaseOption("all.verbose"), ...)
+ MaxIter, eps, warn, loNorm = NULL, upNorm = NULL,
+ verbose = NULL, ...)
</pre>
Modified: branches/robast-0.7/pkg/ROptEst/chm/getInfRobIC.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/getInfRobIC.html 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/chm/getInfRobIC.html 2009-08-28 12:34:38 UTC (rev 357)
@@ -40,39 +40,33 @@
## S4 method for signature 'UnivariateDistribution,asCov,ContNeighborhood':
getInfRobIC(L2deriv,
- risk, neighbor, Finfo, trafo,
- verbose = getRobAStBaseOption("all.verbose"))
+ risk, neighbor, Finfo, trafo, verbose = NULL)
## S4 method for signature 'UnivariateDistribution,asCov,TotalVarNeighborhood':
getInfRobIC(L2deriv,
- risk, neighbor, Finfo, trafo,
- verbose = getRobAStBaseOption("all.verbose"))
+ risk, neighbor, Finfo, trafo, verbose = NULL)
## S4 method for signature 'RealRandVariable,asCov,UncondNeighborhood':
getInfRobIC(L2deriv, risk,
- neighbor, Distr, Finfo, trafo,
- QuadForm = diag(nrow(trafo)),
- verbose = getRobAStBaseOption("all.verbose"))
+ neighbor, Distr, Finfo, trafo, QuadForm = diag(nrow(trafo)),
+ verbose = NULL)
## S4 method for signature 'UnivariateDistribution,asBias,UncondNeighborhood':
getInfRobIC(L2deriv,
- risk, neighbor, symm, trafo,
- maxiter, tol, warn, Finfo,
- verbose = getRobAStBaseOption("all.verbose"), ...)
+ risk, neighbor, symm, trafo, maxiter, tol, warn, Finfo,
+ verbose = NULL, ...)
## S4 method for signature 'RealRandVariable,asBias,UncondNeighborhood':
getInfRobIC(L2deriv, risk,
neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, z.start, A.start, Finfo, trafo,
- maxiter, tol, warn,
- verbose = getRobAStBaseOption("all.verbose"), ...)
+ maxiter, tol, warn, verbose = NULL, ...)
## S4 method for signature 'UnivariateDistribution,asHampel,UncondNeighborhood':
getInfRobIC(L2deriv,
risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower=NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = getRobAStBaseOption("all.verbose"),
- checkBounds = TRUE)
+ verbose = NULL, checkBounds = TRUE)
## S4 method for signature 'RealRandVariable,asHampel,UncondNeighborhood':
getInfRobIC(L2deriv, risk,
@@ -80,23 +74,20 @@
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE,
z.start, A.start, upper = NULL, lower=NULL,
OptOrIter = "iterate", maxiter, tol, warn,
- verbose = getRobAStBaseOption("all.verbose"),
- checkBounds = TRUE, ...)
+ verbose = NULL, checkBounds = TRUE, ...)
## S4 method for signature 'UnivariateDistribution,asGRisk,UncondNeighborhood':
getInfRobIC(L2deriv,
- risk, neighbor, symm, Finfo, trafo,
- upper = NULL, lower = NULL,
- maxiter, tol, warn, noLow = FALSE,
- verbose = getRobAStBaseOption("all.verbose"))
+ risk, neighbor, symm, Finfo, trafo, upper = NULL,
+ lower = NULL, maxiter, tol, warn, noLow = FALSE,
+ verbose = NULL)
## S4 method for signature 'RealRandVariable,asGRisk,UncondNeighborhood':
getInfRobIC(L2deriv, risk,
neighbor, Distr, DistrSymm, L2derivSymm,
L2derivDistrSymm, Finfo, trafo, onesetLM = FALSE, z.start,
A.start, upper = NULL, lower = NULL, OptOrIter = "iterate",
- maxiter, tol, warn,
- verbose = getRobAStBaseOption("all.verbose"), ...)
+ maxiter, tol, warn, verbose = NULL, ...)
## S4 method for signature 'UnivariateDistribution,asUnOvShoot,UncondNeighborhood':
getInfRobIC(
Modified: branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html 2009-08-28 12:34:38 UTC (rev 357)
@@ -31,14 +31,12 @@
getLagrangeMultByIter(b, L2deriv, risk, trafo,
neighbor, biastype, normtype, Distr,
a.start, z.start, A.start, w.start, std, z.comp,
- A.comp, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose"),
+ A.comp, maxiter, tol, verbose = NULL,
warnit = TRUE)
getLagrangeMultByOptim(b, L2deriv, risk, FI, trafo,
neighbor, biastype, normtype, Distr,
a.start, z.start, A.start, w.start, std, z.comp,
- A.comp, maxiter, tol,
- verbose = getRobAStBaseOption("all.verbose"), ...)
+ A.comp, maxiter, tol, verbose = NULL, ...)
</pre>
Modified: branches/robast-0.7/pkg/ROptEst/chm/internals.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/internals.html 2009-08-27 20:04:40 UTC (rev 356)
+++ branches/robast-0.7/pkg/ROptEst/chm/internals.html 2009-08-28 12:34:38 UTC (rev 357)
@@ -61,12 +61,12 @@
.LowerCaseMultivariate(L2deriv, neighbor, biastype,
normtype, Distr, Finfo, trafo, z.start,
A.start, z.comp, A.comp, maxiter, tol,
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 357
More information about the Robast-commits
mailing list