[Robast-commits] r634 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man RobExtremesBuffer
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 15 08:53:46 CET 2013
Author: ruckdeschel
Date: 2013-03-15 08:53:46 +0100 (Fri, 15 Mar 2013)
New Revision: 634
Modified:
branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R
branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R
branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R
branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R
branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R
branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
branches/robast-0.9/pkg/ROptEst/R/optIC.R
branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd
branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd
branches/robast-0.9/pkg/ROptEst/man/optIC.Rd
branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd
branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R
Log:
(1) introduced a helper function .dynScopeEval for evaluation acc. to dynamical scoping for use in roptest -- otherwise arguments of roptest could not get evaluated correctly when used in nested expressions like print(system.time({re1<-roptest(dat0,PFam,risk=RMXRRisk())})) .
(2) took up Matthias' suggestion to allow for NA return values in optIC and radiusMinimaxIC in case of convergence problems; this is controlled now by argument returnNAifProblem; internally, getInfRobIC - methods now have a logical variable problem (TRUE in case of problems) which is returned as item of the return list. Technically, all getInfRobIC methods now had to be supplemented with a ... argument, because they might get passed on argument returnNAifProblem.
(3) enhanced documentation for getLMinterpol, plotInterpol
(4) increased precision in calling tuning parameters of optIC and radiusMinimaxIC in the generation of the grids
Modified: branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -86,13 +86,15 @@
erg <- optim(p.vec, bmin.fct, method = "Nelder-Mead",
control = list(reltol = tol, maxit = 100*maxiter),
L2deriv = L2deriv, Distr = Distr, trafo = trafo)
+ problem <- (erg$convergence > 0)
A.max <- max(abs(stand(w)))
stand(w) <- stand(w)/A.max
weight(w) <- minbiasweight(w, neighbor = neighbor,
biastype = biastype,
normW = normtype)
- return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin))
+ return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin,
+ problem = problem ))
}
@@ -132,6 +134,7 @@
control = list(reltol = tol, maxit = 100*maxiter),
L2deriv = L2deriv, Distr = Distr, trafo = trafo)
+ problem <- (erg$convergence > 0)
A <- matrix(erg$par, ncol = k, nrow = 1)
b <- 1/erg$value
stand(w) <- A
@@ -153,6 +156,6 @@
weight(w) <- minbiasweight(w, neighbor = neighbor,
biastype = biastype,
normW = normtype)
- return(list(A=A,b=b, w=w, a=a, itermin = itermin))
+ return(list(A=A,b=b, w=w, a=a, itermin = itermin, problem = problem))
}
Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -6,7 +6,7 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = NULL, checkBounds = TRUE){
+ verbose = NULL, checkBounds = TRUE, ...){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -145,7 +145,8 @@
weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype,
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(),
+ problem = FALSE))
})
setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution",
@@ -179,7 +180,8 @@
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,
- w = w, biastype = biastype, normtype = NormType()))
+ w = w, biastype = biastype, normtype = NormType(),
+ problem = FALSE))
})
setMethod("minmaxBias", signature(L2deriv = "RealRandVariable",
@@ -218,6 +220,7 @@
w <- eerg$w
normtype <- eerg$normtype
+ problem <- eerg$problem
if(verbose)
.checkPIC(L2deriv, neighbor, Distr, trafo, z, A, w, z.comp, A.comp)
@@ -243,7 +246,8 @@
r = r,
at = neighbor))
return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info,
- w = w, biastype = biastype, normtype = normtype))
+ w = w, biastype = biastype, normtype = normtype,
+ problem = problem))
})
@@ -301,7 +305,8 @@
r = r,
at = neighbor))
return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info,
- w = w, biastype = biastype, normtype = normtype))
+ w = w, biastype = biastype, normtype = normtype,
+ problem = problem))
})
@@ -346,7 +351,8 @@
weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype)
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(),
+ problem = FALSE))
})
setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution",
@@ -417,5 +423,6 @@
}else{return(noIC())}
return(list(A = A0, a = a0, b = b0, d = d0, risk = Risk0,
info = infotxt, w = w, biastype = biastype,
- normtype = NormType()))
+ normtype = NormType(),
+ problem = FALSE))
})
Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -6,7 +6,7 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower = NULL, maxiter, tol,
- warn, noLow = FALSE, verbose = NULL){
+ warn, noLow = FALSE, verbose = NULL, ...){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
@@ -62,6 +62,7 @@
## assign("l2D",L2deriv,.GlobalEnv)
###
prec <- 1
+ problem <- FALSE
repeat{
iter <- iter + 1
z.old <- z
@@ -131,11 +132,13 @@
if(prec < tol) break
if(abs(prec.old - prec) < 1e-10){
if(iter>1)
+ problem <- TRUE
cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
break
}
if(iter > maxiter){
if(iter>1)
+ problem <- TRUE
cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
break
}
@@ -180,7 +183,7 @@
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)))
+ biastype = biastype, normtype = normtype(risk), problem = problem ))
})
@@ -267,8 +270,8 @@
iter <- 0
prec <- 1
iter.In <- 0
+ problem <- FALSE
-
## determining A,a,b with either optimization of iteration:
if(OptOrIter == 1){
if(is.null(lower)){
@@ -401,10 +404,12 @@
}
if(prec < tol) break
if(abs(prec.old - prec) < 1e-10){
+ problem <- TRUE
cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
break
}
if(iter > maxiter){
+ problem <- TRUE
cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
break
}
@@ -486,7 +491,7 @@
return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info, w = w,
biastype = biastype, normtype = normtype,
call = mc, iter = iter, prec = prec, OIcall = OptIterCall,
- iter.In = iter.In, prec.In = prec.In))
+ iter.In = iter.In, prec.In = prec.In, problem = problem ))
})
### helper function to recursively evaluate list
Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -6,7 +6,7 @@
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = NULL, checkBounds = TRUE){
+ verbose = NULL, checkBounds = TRUE, ...){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -5,7 +5,7 @@
risk = "asUnOvShoot",
neighbor = "UncondNeighborhood"),
function(L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, lower, maxiter, tol, warn){
+ upper, lower, maxiter, tol, warn, ...){
biastype <- biastype(risk)
radius <- neighbor at radius
if(identical(all.equal(radius, 0), TRUE)){
Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -9,8 +9,9 @@
A.start = A.start, upper = upper, lower = lower,
OptOrIter = OptOrIter, maxiter = maxiter,
tol = tol, warn = FALSE,
- loRad0 = loRad0)
- return(c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
+ loRad0 = loRad0, returnNAifProblem = TRUE)
+ if(is.na(IC)) return(NA)
+ return(list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
A=stand(IC), A.w = stand(weight(IC))))
}
@@ -24,10 +25,11 @@
z.start = z.start, A.start = A.start, upper = upper,
lower = lower, OptOrIter = OptOrIter,
maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE,
- .withEvalAsVar = FALSE)
+ .withEvalAsVar = FALSE, returnNAifProblem = TRUE)
+ if(is.na(IC)) return(NA)
mA <- max(stand(IC))
mAw <- max(stand(weight(IC)))
- return(c(b=clip(IC), a=cent(IC), aw=cent(weight(IC)),
+ return(list(b=clip(IC), a=cent(IC), aw=cent(weight(IC)),
A=stand(IC)/mA, Aw=stand(weight(IC))/mAw))
}
@@ -42,8 +44,9 @@
z.start = z.start, A.start = A.start, upper = upper,
lower = lower, OptOrIter = OptOrIter,
maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE,
- .withEvalAsVar = FALSE)
- res=c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
+ .withEvalAsVar = FALSE, returnNAifProblem = TRUE)
+ if(is.na(IC)) return(NA)
+ res=list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
A=stand(IC), A.w = stand(weight(IC)))
return(res)
}
@@ -71,16 +74,20 @@
maxiter = maxiter, tol = tol,
loRad = loRad, upRad = upRad, loRad0 = loRad0),
silent=TRUE)
- if(is(a,"try-error")){ a <- rep(NA,13)}else{
+ print(a)
+ print(A.start)
+ print(z.start)
+ if(is(a,"try-error")|any(is.na(a))){ a <- rep(NA,13)}else{
if(withStartLM){
pdim <- length(a[["a"]])
kdim <- length(a[["a.w"]])
z.start <<- a[["a.w"]]
A.start <<- matrix(a[["A"]],pdim,kdim)
+ a <- c(a[["b"]],a[["a"]],a[["a.w"]],a[["A"]],a[["A.w"]])
}
}
return(a)
- }
+ }
distroptions.old <- distroptions()
distrExOptions.old <- distrExOptions()
Modified: branches/robast-0.9/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/optIC.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/optIC.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -6,7 +6,7 @@
lower = 1e-4, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
warn = TRUE, noLow = FALSE, verbose = NULL, ...,
- .withEvalAsVar = TRUE){
+ .withEvalAsVar = TRUE, returnNAifProblem = FALSE){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
L2derivDim <- numberOfMaps(model at center@L2deriv)
@@ -26,6 +26,7 @@
res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
neighbor = model at neighbor,
risk = risk))
+ if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA)
IC.o <- generateIC(model at neighbor, model at center, res)
}else{
if(is(model at center@distribution, "UnivariateDistribution")){
@@ -58,6 +59,7 @@
maxiter = maxiter, tol = tol, warn = warn,
verbose = verbose, ...,.withEvalAsVar = .withEvalAsVar)
options(ow)
+ if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA)
res$info <- c("optIC", res$info)
res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center,
neighbor = model at neighbor,
Modified: branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -9,7 +9,7 @@
A.start = NULL, upper = NULL, lower = NULL,
OptOrIter = "iterate", maxiter = 50,
tol = .Machine$double.eps^0.4, warn = FALSE,
- verbose = NULL, loRad0 = 1e-3, ...){
+ verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
ow <- options("warn")
@@ -167,6 +167,7 @@
tol = .Machine$double.eps^0.25)$root , silent = TRUE)
if(is(leastFavR, "try-error")){
+ if(returnNAifProblem) return(NA)
warnRund <- 1; isE <- TRUE
fl <- (0.2/lower)^(1/6); fu <- (0.5/upper)^(1/6)
while(warnRund < 7 && isE ){
@@ -192,8 +193,9 @@
}
neighbor at radius <- leastFavR
args.IC$neighbor <- args.R$neighbor <- neighbor
-
+ args.IC$returnNAifProblem <- returnNAifProblem
res <- do.call(getInfRobIC, args.IC)
+ if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA)
options(ow)
res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [",
round(loRad, 3), ", ", round(upRad, 3), "]", sep=""))
Modified: branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -1,6 +1,16 @@
###############################################################################
## Optimally robust estimation
###############################################################################
+.dynScopeEval <- function(expr){
+ le <- length(sys.calls())
+ i <- 1
+ while(i< le){
+ a <- try(eval(expr,envir=sys.frame(-i)),silent=TRUE)
+ if(!is(a,"try-error")) return(a)
+ i <- i + 1
+ }
+ stop("Could not evaluate expression.")
+}
roptest <- function(x, L2Fam, eps, eps.lower, eps.upper, fsCor = 1, initial.est,
neighbor = ContNeighborhood(), risk = asMSE(), steps = 1L,
@@ -15,14 +25,16 @@
withLogScale = TRUE,..withCheck=FALSE,
withTimings = FALSE, withMDE = NULL,
withEvalAsVar = NULL){
- es.call <- match.call()
+ es.call <- es.call.e <- match.call()
+ es.call.e <- (as.list(es.call.e))
+ es.call.e[["..."]] <- NULL
+ for(i in seq(along.with=es.call.e))
+ es.call.e[[i]] <- .dynScopeEval(es.call.e[[i]])
es.call0 <- match.call(expand.dots=FALSE)
mwt <- !is.null(es.call$withTimings)
es.call$withTimings <- NULL
- es.call0$withTimings <- NULL
dots <- es.call0[["..."]]
- es.call0$"..." <- NULL
- es.call1 <- .constructArg.list(roptest,es.call0, onlyFormal=FALSE,
+ es.call1 <- .constructArg.list(roptest,es.call.e, onlyFormal=FALSE,
debug = ..withCheck)$mc
res <- .constructArg.list(gennbCtrl,es.call1, onlyFormal=TRUE,
Modified: branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd 2013-03-15 07:53:46 UTC (rev 634)
@@ -45,7 +45,7 @@
\S4method{getInfRobIC}{UnivariateDistribution,asHampel,UncondNeighborhood}(L2deriv,
risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower=NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = NULL, checkBounds = TRUE)
+ verbose = NULL, checkBounds = TRUE, ...)
\S4method{getInfRobIC}{RealRandVariable,asHampel,UncondNeighborhood}(L2deriv, risk,
neighbor, Distr, DistrSymm, L2derivSymm,
@@ -58,7 +58,7 @@
\S4method{getInfRobIC}{UnivariateDistribution,asAnscombe,UncondNeighborhood}(
L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower=NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = NULL, checkBounds = TRUE)
+ verbose = NULL, checkBounds = TRUE, ...)
\S4method{getInfRobIC}{RealRandVariable,asAnscombe,UncondNeighborhood}(L2deriv,
risk, neighbor, Distr, DistrSymm, L2derivSymm,
@@ -70,7 +70,7 @@
\S4method{getInfRobIC}{UnivariateDistribution,asGRisk,UncondNeighborhood}(L2deriv,
risk, neighbor, symm, Finfo, trafo, upper = NULL,
lower = NULL, maxiter, tol, warn, noLow = FALSE,
- verbose = NULL)
+ verbose = NULL, ...)
\S4method{getInfRobIC}{RealRandVariable,asGRisk,UncondNeighborhood}(L2deriv, risk,
neighbor, Distr, DistrSymm, L2derivSymm,
@@ -81,7 +81,7 @@
\S4method{getInfRobIC}{UnivariateDistribution,asUnOvShoot,UncondNeighborhood}(
L2deriv, risk, neighbor, symm, Finfo, trafo,
- upper, lower, maxiter, tol, warn)
+ upper, lower, maxiter, tol, warn, ...)
}
\arguments{
\item{L2deriv}{ L2-derivative of some L2-differentiable family
Modified: branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd 2013-03-15 07:53:46 UTC (rev 634)
@@ -4,6 +4,7 @@
\alias{.plotRescaledAxis}
\alias{.legendCoord}
\alias{.SelectOrderData}
+\alias{.dynScopeEval}
\title{Internal / Helper functions of package ROptEst for function robest}
@@ -12,6 +13,7 @@
in package \pkg{ROptEst}.}
\usage{
+.dynScopeEval(expr)
.constructArg.list(fun,matchCall, onlyFormal=FALSE, debug =FALSE)
.fix.in.defaults(call.list, fun, withEval=TRUE)
.pretreat(x, na.rm = TRUE)
@@ -20,24 +22,28 @@
.isOKfsCor(fsCor)
}
\arguments{
- \item{fun}{function, a matched call of which is manipulated}
- \item{matchCall}{a return value of a call to \code{match.call}}
+ \item{expr}{an expression. }
+ \item{fun}{function, a matched call of which is manipulated. }
+ \item{matchCall}{a return value of a call to \code{match.call}. }
\item{onlyFormal}{logical; shall arguments not explicitely contained in
- the formals of \code{fun} be kept in the matched call?}
- \item{debug}{logical: if switched on, issues information for debugging.}
+ the formals of \code{fun} be kept in the matched call? }
+ \item{debug}{logical: if switched on, issues information for debugging. }
\item{call.list}{a list of matched arguments drawn from a call to \code{match.call}
applied to \code{fun} which is to be supplemented by defaults of
- not-yet-matched formals}
- \item{withEval}{logical: shall arguments be evaluated?}
- \item{x}{input data \code{x} of \code{robest} or \code{roptest}.}
+ not-yet-matched formals. }
+ \item{withEval}{logical: shall arguments be evaluated? }
+ \item{x}{input data \code{x} of \code{robest} or \code{roptest}. }
\item{na.rm}{logical: if \code{TRUE}, the estimator is evaluated at
- \code{complete.cases(x)}.}
+ \code{complete.cases(x)}. }
\item{\dots}{input from \code{robest} or \code{roptest} from which to conclude
- on radiuses}
- \item{steps}{number of steps to be used in kStep estimator in \code{robest}}
- \item{fsCor}{argument \code{fsCor} of \code{robest}}
+ on radiuses. }
+ \item{steps}{number of steps to be used in kStep estimator in \code{robest}. }
+ \item{fsCor}{argument \code{fsCor} of \code{robest}. }
}
\details{
+\code{.dynScopeEval} marches up the stack of calls to evaluate an expression,
+ hence realizes dynamical scoping.
+
\code{.constructArg.list} takes a function \code{fun} and the return value
of \code{match.call} and, as return value, produces a list of arguments where
the formal arguments of \code{fun} are set to their default values and
Modified: branches/robast-0.9/pkg/ROptEst/man/optIC.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/optIC.Rd 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/man/optIC.Rd 2013-03-15 07:53:46 UTC (rev 634)
@@ -17,7 +17,8 @@
OptOrIter = "iterate", maxiter = 50,
tol = .Machine$double.eps^0.4, warn = TRUE,
noLow = FALSE, verbose = NULL, ...,
- .withEvalAsVar = TRUE)
+ .withEvalAsVar = TRUE,
+ returnNAifProblem = FALSE)
\S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk, upper = 1e4,
lower = 1e-4, maxiter = 50,
@@ -51,11 +52,14 @@
when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of
class \code{"asGRisk"}, by default and if matched to \code{"iterate"}
we use only one (inner) iteration, if matched to \code{"doubleiterate"}
- we use up to \code{Maxiter} (inner) iterations.}
- \item{verbose}{ logical: if \code{TRUE}, some messages are printed }
+ we use up to \code{Maxiter} (inner) iterations. }
+ \item{verbose}{ logical: if \code{TRUE}, some messages are printed. }
\item{.withEvalAsVar}{logical (of length 1):
if \code{TRUE}, risks based on covariances are to be
- evaluated (default), otherwise just a call is returned.}
+ evaluated (default), otherwise just a call is returned. }
+ \item{returnNAifProblem}{logical (of length 1):
+ if \code{TRUE} (not the default), in case of convergence problems in
+ the algorithm, returns \code{NA}. }
}
\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.9/pkg/ROptEst/man/radiusMinimaxIC.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 07:53:46 UTC (rev 634)
@@ -14,7 +14,8 @@
L2Fam, neighbor, risk, loRad = 0, upRad = Inf, z.start = NULL, A.start = NULL,
upper = NULL, lower = NULL, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
- warn = FALSE, verbose = NULL, loRad0 = 1e-3, ...)
+ warn = FALSE, verbose = NULL, loRad0 = 1e-3, ...,
+ returnNAifProblem = FALSE)
}
\arguments{
\item{L2Fam}{ L2-differentiable family of probability measures. }
@@ -42,6 +43,9 @@
\item{loRad0}{ for numerical reasons: the effective lower bound for the zero search;
internally set to \code{max(loRad,loRad0)}.}
\item{\dots}{further arguments to be passed on to \code{getInfRobIC}}
+ \item{returnNAifProblem}{logical (of length 1):
+ if \code{TRUE} (not the default), in case of convergence problems in
+ the algorithm, returns \code{NA}. }
}
\details{
In case the neighborhood radius is unknown, Rieder et al. (2001, 2008)
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -31,11 +31,11 @@
withPrint = withPrint)}
-.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
+.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(700, cutoff.at.0=0.005),
#.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005),
PFam = GParetoFamily(shape=1,scale=2), radius = 0.5,
upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
- maxiter = 50, tol = .Machine$double.eps^0.4,
+ maxiter = 150, tol = .Machine$double.eps^0.5,
loRad = 0, upRad = Inf, loRad0 = 1e-3,
withStartLM = TRUE){
namF <- gsub("\\.th$","",paste(deparse(substitute(optF))))
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -1,9 +1,9 @@
getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE){
- ## Gridnam in (Sn,OMSE,RMXE,MBRE)
+ ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!!
## Famnam in "Generalized Pareto Family",
## "GEV Family",
## "Gamma family",
- ## "Weibull Family"
+ ## "Weibull Family" ## uses partial matching!!
## xi Scaleparameter (can be vector)
## basedir: Oberverzeichnis des r-forge svn checkouts
file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda")
@@ -15,6 +15,8 @@
"GEV Family",
"Gamma family",
"Weibull Family")
+ Gridnam <- Gnams[pmatch(Gridnam, Gnams)]
+ Famnam <- Fnams[pmatch(Famnam, Fnams)]
if(! Gridnam %in% Gnams) stop("Falscher Gittername")
if(! Famnam %in% Fnams) stop("Falscher Familienname")
Famnam0 <- gsub(" ","",Famnam)
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -15,9 +15,9 @@
.RMXE.th <- ROptEst:::.RMXE.th
.modify.xi.PFam.call <- RobExtremes:::.modify.xi.PFam.call
#
-PF <- GParetoFamily()
+#PF <- GParetoFamily()
#PF <- GEVFamily()
-#PF <- GammaFamily()
+PF <- GammaFamily()
#PF <- WeibullFamily()
###
.svInt <- RobExtremes:::.svInt
@@ -25,7 +25,7 @@
RobExtremes:::.generateInterpGridSn(PFam = PF)}
## to make this parallel, start this on several processors
#.svInt1()
-#.svInt(.OMSE.th, PFam=PF)
+.svInt(.OMSE.th, PFam=PF)
.svInt(.MBRE.th, PFam=PF)
.svInt(.RMXE.th, PFam=PF)
setwd(oldwd)
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-15 07:53:46 UTC (rev 634)
@@ -1,18 +1,26 @@
plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast",
withSmooth=FALSE, gridRestriction = NULL, prehook={}, posthook={}, ...){
- ## Gridnam in (Sn,OMSE,RMXE,MBRE)
- ## Famnam in "Generalized Pareto Family",
+ ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!!
+ ## Famnam in "Generalized Pareto Family", ## uses partial matching!!
## "GEV Family",
## "Gamma family",
## "Weibull Family"
- ## whichLM ignoriert für Gridnam == Sn
+ ## whichLM is ignored for Gridnam == Sn
# in 1:13 (clip=b, cent.a=a1.a,a2.a, cent.i=a1.i,a2.i,
## stand.a=A.a=matrix(c(A11.a,(A12.a+A21.a)/2,
# (A12.a+A21.a)/2,A.22.a), 2, 2),
## stand.i=A.i=matrix(c(A11.i,(A12.i+A21.i)/2,
# (A12.i+A21.i)/2,A.22.i), 2, 2),
- ## und optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.*
+ ## and optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.*
+ ## or "all" then all LMs are plotted
## basedir: Oberverzeichnis des r-forge svn checkouts
+ ## gridRestriction: an expression that can be used as index in xi[gridRestriction]
+ ## to restrict the plotted grid-values
+ ## prehook: an expression to be evaluated before plotting --- typically something
+ ## like pdf("myfile.pdf")
+ ## posthook: an expression to be evaluated after plotting --- typically something
+ ## like dev.off()
+ ## withSmooth: logical shall item grid or gridS be used for plotting
file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda")
if(!file.exists(file)) stop("Fehler mit Checkout")
nE <- new.env()
Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634)
@@ -32,10 +32,10 @@
.getLMGrid(xiGrid = getShapeGrid(), PFam = GParetoFamily(scale=1,shape=2),
optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE)
-.svInt(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
+.svInt(optF = .RMXE.th, xiGrid = getShapeGrid(700, cutoff.at.0=0.005),
PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4,
- lower = 1e-4, OptOrIter = "iterate", maxiter = 50,
- tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ lower = 1e-4, OptOrIter = "iterate", maxiter = 150,
+ tol = .Machine$double.eps^0.5, loRad = 0, upRad = Inf, loRad0 = 1e-3,
withStartLM = TRUE)
.generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
Modified: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R
===================================================================
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 634
More information about the Robast-commits
mailing list