[Robast-commits] r1281 - pkg/ROptEst/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 6 21:27:32 CET 2024
Author: ruckdeschel
Date: 2024-02-06 21:27:32 +0100 (Tue, 06 Feb 2024)
New Revision: 1281
Modified:
pkg/ROptEst/R/lowerCaseRadius.R
pkg/ROptEst/R/optIC.R
pkg/ROptEst/R/optRisk.R
pkg/ROptEst/R/radiusMinimaxIC.R
Log:
[ROptEst] trunk removed local settings of options$warn to -1
Modified: pkg/ROptEst/R/lowerCaseRadius.R
===================================================================
--- pkg/ROptEst/R/lowerCaseRadius.R 2024-02-06 20:21:54 UTC (rev 1280)
+++ pkg/ROptEst/R/lowerCaseRadius.R 2024-02-06 20:27:32 UTC (rev 1281)
@@ -11,9 +11,6 @@
D1 <- L2Fam at distribution
if(!is(D1, "DiscreteDistribution")) stop("not yet implemented")
- w0 <- options("warn")
- on.exit(options(w0))
- options(warn = -1)
L2deriv <- L2Fam at L2derivDistr[[1]]
m <- q.l(L2deriv)(0.5)
wsm <- d(L2deriv)(m)
@@ -60,9 +57,6 @@
if(!is(D1, "DiscreteDistribution")) stop("not yet implemented")
L2deriv <- L2Fam at L2derivDistr[[1]]
- w0 <- options("warn")
- on.exit(options(w0))
- options(warn = -1)
supp <- support(L2deriv)
gg <- min(abs(supp[supp != 0]))
if(gg > 0){
@@ -75,13 +69,11 @@
rad <- sqrt(M*(-m1df(L2deriv, 0)) - ws1*ws2/ws0)
names(rad) <- "lower case radius"
- options(w0)
return(rad)
}else{
rad <- Inf
names(rad) <- "lower case radius"
- options(w0)
return(rad)
}
})
@@ -99,9 +91,6 @@
if(!is(D1, "DiscreteDistribution")) stop("not yet implemented")
sign <- sign(biastype)
- w0 <- options("warn")
- on.exit(options(w0))
- options(warn = -1)
L2deriv <- L2Fam at L2derivDistr[[1]]
l <- length(support(L2deriv))
@@ -114,7 +103,6 @@
rad <- sqrt((abs(z0)/deltahat-(1-p0))/p0)
names(rad) <- "lower case radius"
- options(w0)
return(rad)
})
@@ -129,9 +117,6 @@
if(!is(D1, "DiscreteDistribution")) stop("not yet implemented")
sign <- sign(biastype)
- w0 <- options("warn")
- on.exit(options(w0))
- options(warn = -1)
l <- length(support(L2deriv))
if (sign>0)
@@ -143,7 +128,6 @@
rad <- sqrt((abs(z0)/deltahat-(1-p0))/p0)
names(rad) <- "lower case radius"
- options(w0)
return(rad)
})
@@ -161,8 +145,6 @@
nu1 <- nu(biastype)[1]
nu2 <- nu(biastype)[2]
- w0 <- options("warn")
- options(warn = -1)
L2deriv <- L2Fam at L2derivDistr[[1]]
supp <- support(L2deriv)
@@ -209,7 +191,6 @@
Int2 <- 1/nu1/nu2
}else{
- options(w0)
rad <- Inf
names(rad) <- "lower case radius"
return(rad)
@@ -222,7 +203,6 @@
rad <- sqrt(M/omega- Int2)
names(rad) <- "lower case radius"
- options(w0)
return(rad)
})
Modified: pkg/ROptEst/R/optIC.R
===================================================================
--- pkg/ROptEst/R/optIC.R 2024-02-06 20:21:54 UTC (rev 1280)
+++ pkg/ROptEst/R/optIC.R 2024-02-06 20:27:32 UTC (rev 1281)
@@ -11,13 +11,10 @@
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
L2derivDim <- numberOfMaps(model at center@L2deriv)
- ow <- options("warn")
- on.exit(options(ow))
if(missing(warn)|| is.null(warn)) warn <- TRUE
#L2Fam <- model at center
#model at center <- moveL2Fam2RefParam(L2Fam)
if(L2derivDim == 1){
- options(warn = -1)
res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
@@ -52,7 +49,6 @@
L2derivDistrSymm <- new("DistrSymmList", L2)
}
}
- options(warn = -1)
res <- getInfRobIC(L2deriv = L2deriv, neighbor = model at neighbor,
risk = risk, Distr = model at center@distribution,
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
@@ -61,7 +57,6 @@
upper = upper, lower = lower, OptOrIter = OptOrIter,
maxiter = maxiter, tol = tol, warn = warn,
verbose = verbose, ...,.withEvalAsVar = .withEvalAsVar)
- options(ow)
if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA)
linfo <- length(res$info)
res$info <- if(linfo>1) c(rep("optIC",linfo),res$info) else c("optIC", res$info)
@@ -87,20 +82,16 @@
tol = .Machine$double.eps^0.4, withMakeIC = FALSE,
warn = TRUE, verbose = NULL, modifyICwarn = NULL, ...){
L2derivDistr <- model at center@L2derivDistr[[1]]
- ow <- options("warn")
- on.exit(options(ow))
if(missing(warn)|| is.null(warn)) warn <- TRUE
if((length(model at center@L2derivDistr) == 1) & is(L2derivDistr, "UnivariateDistribution")){
if(identical(all.equal(model at neighbor@radius, 0), TRUE)){
return(optIC(model at center, risk = asCov(), withMakeIC = withMakeIC))
}else{
- options(warn = -1)
res <- getInfRobIC(L2deriv = L2derivDistr,
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
linfo <- length(res$info)
if(is(model at neighbor, "ContNeighborhood")){
res$info <- c(rep("optIC",linfo+1),res$info,
@@ -131,18 +122,14 @@
cont = "left", verbose = NULL, modifyICwarn = NULL, ...){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
- ow <- options("warn")
- on.exit(options(ow))
if(missing(warn)|| is.null(warn)) warn <- TRUE
if(!identical(all.equal(sampleSize, trunc(sampleSize)), TRUE))
stop("'sampleSize' has to be an integer > 0")
if(is(model at center@distribution, "UnivariateDistribution")){
- options(warn = -1)
res <- getFixRobIC(Distr = model at center@distribution,
neighbor = model at neighbor, risk = risk,
sampleSize = sampleSize, upper = upper, maxiter = maxiter,
tol = tol, warn = warn, Algo = Algo, cont = cont)
- options(ow)
linfo <- length(res$info)
if(is(model at neighbor, "ContNeighborhood")){
res$info <- c(rep("optIC",linfo+1),res$info,
Modified: pkg/ROptEst/R/optRisk.R
===================================================================
--- pkg/ROptEst/R/optRisk.R 2024-02-06 20:21:54 UTC (rev 1280)
+++ pkg/ROptEst/R/optRisk.R 2024-02-06 20:27:32 UTC (rev 1281)
@@ -14,10 +14,7 @@
z.start = NULL, A.start = NULL, upper = 1e4,
maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE){
L2derivDim <- numberOfMaps(model at center@L2deriv)
- ow <- options("warn")
- on.exit(options(ow))
if(L2derivDim == 1){
- options(warn = -1)
res <- getInfRobIC(L2deriv = model at center@L2derivDistr[[1]],
neighbor = model at neighbor, risk = risk,
symm = model at center@L2derivDistrSymm[[1]],
@@ -24,7 +21,6 @@
Finfo = model at center@FisherInfo, trafo = trafo(model at center@param),
upper = upper, maxiter = maxiter, tol = tol, warn = warn,
noLow = noLow)
- options(ow)
return(res$risk)
}else{
if(is(model at center@distribution, "UnivariateDistribution")){
@@ -48,7 +44,6 @@
}
}
- options(warn = -1)
res <- getInfRobIC(L2deriv = L2deriv, neighbor = model at neighbor,
risk = risk, Distr = model at center@distribution,
DistrSymm = model at center@distrSymm, L2derivSymm = L2derivSymm,
@@ -55,7 +50,6 @@
L2derivDistrSymm = L2derivDistrSymm, Finfo = model at center@FisherInfo,
trafo = trafo(model at center@param), z.start = z.start, A.start = A.start,
upper = upper, maxiter = maxiter, tol = tol, warn = warn)
- options(ow)
return(res$risk)
}else{
stop("not yet implemented")
@@ -69,17 +63,13 @@
setMethod("optRisk", signature(model = "FixRobModel", risk = "fiUnOvShoot"),
function(model, risk, sampleSize, upper = 1e4, maxiter = 50,
tol = .Machine$double.eps^0.4, warn = TRUE, Algo = "A", cont = "left"){
- ow <- options("warn")
- on.exit(options(ow))
if(!identical(all.equal(sampleSize, trunc(sampleSize)), TRUE))
stop("'sampleSize' has to be an integer > 0")
if(is(model at center@distribution, "UnivariateDistribution")){
- options(warn = -1)
res <- getFixRobIC(Distr = model at center@distribution,
neighbor = model at neighbor, risk = risk,
sampleSize = sampleSize, upper = upper, maxiter = maxiter,
tol = tol, warn = warn, Algo = Algo, cont = cont)
- options(ow)
res$info <- c("optIC", res$info)
return(res$risk)
}else{
Modified: pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- pkg/ROptEst/R/radiusMinimaxIC.R 2024-02-06 20:21:54 UTC (rev 1280)
+++ pkg/ROptEst/R/radiusMinimaxIC.R 2024-02-06 20:27:32 UTC (rev 1281)
@@ -17,8 +17,6 @@
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
- ow <- options("warn")
- on.exit(options(ow))
if(missing(warn)|| is.null(warn)) warn <- FALSE
if(length(loRad) != 1)
stop("'loRad' is not of length == 1")
@@ -79,7 +77,6 @@
}
if(L2derivDim == 1){
- options(warn = -1)
args.R$L2deriv <- args.IC$L2deriv <- L2Fam at L2derivDistr[[1]]
args.IC$symm <- L2Fam at L2derivDistrSymm[[1]]
@@ -139,7 +136,6 @@
std <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(p)
loRisk <- sum(diag(std%*%FI0))
- options(warn = -1)
if(identical(all.equal(loRad, 0), TRUE)){
loRad <- 0
@@ -208,7 +204,6 @@
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=""))
res$info <- rbind(res$info, c("radiusMinimaxIC",
More information about the Robast-commits
mailing list