[Robast-commits] r1284 - branches/robast-1.3/pkg/ROptEst/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Feb 6 22:55:50 CET 2024


Author: ruckdeschel
Date: 2024-02-06 22:55:50 +0100 (Tue, 06 Feb 2024)
New Revision: 1284

Modified:
   branches/robast-1.3/pkg/ROptEst/R/LowerCaseMultivariate.R
   branches/robast-1.3/pkg/ROptEst/R/getAsRisk.R
   branches/robast-1.3/pkg/ROptEst/R/getInfRobIC_asBias.R
   branches/robast-1.3/pkg/ROptEst/R/getMaxIneff.R
   branches/robast-1.3/pkg/ROptEst/R/leastFavorableRadius.R
   branches/robast-1.3/pkg/ROptEst/R/lowerCaseRadius.R
   branches/robast-1.3/pkg/ROptEst/R/optIC.R
   branches/robast-1.3/pkg/ROptEst/R/optRisk.R
   branches/robast-1.3/pkg/ROptEst/R/radiusMinimaxIC.R
Log:
[ROptEst] branch 1.3 ported changes from trunk 

Modified: branches/robast-1.3/pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/LowerCaseMultivariate.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/LowerCaseMultivariate.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -19,8 +19,14 @@
            z.comp <- rep(TRUE, nrow(trafo))
 
         force(normtype)
+        A.symm <- (nrow(trafo)==ncol(trafo)) && isTRUE(all.equal(trafo,t(trafo)))
+		
+		if(A.symm){
+		   A.comp.s <- t(A.comp)|A.comp
+		   A.comp <- A.comp.s[col(A.comp.s)>=row(A.comp.s)]
+		}
         lA.comp <- sum(A.comp)
-        
+			        
         abs.fct <- function(x, L2, stand, cent, normtype.0){
             X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
             Y <- stand %*% X
@@ -28,13 +34,14 @@
         }
 
         itermin <- 0
-        bmin.fct <- function(param, L2deriv, Distr, trafo){
+        bmin.fct <- function(param, L2deriv, Distr, trafo, A.symm = TRUE){
             itermin <<- itermin + 1
             p <- nrow(trafo)
             k <- ncol(trafo)
             A <- matrix(0, ncol = k, nrow = p)
             
-            A[A.comp] <- param[1:lA.comp]
+  	        A[A.comp] <- param[1:lA.comp]
+            if(A.symm) A[col(A)>row(A)] <- t(A)[col(A)>row(A)]
             A.max <- max(abs(A.comp))
             A <- A/A.max
             z <- numeric(k)

Modified: branches/robast-1.3/pkg/ROptEst/R/getAsRisk.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/getAsRisk.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/getAsRisk.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -81,8 +81,12 @@
         comp <- .getComp(L2deriv, DistrSymm, L2derivSymm, L2derivDistrSymm)
         z.comp <- comp$"z.comp"
         A.comp <- comp$"A.comp"
-        DA.comp <- abs(trafo) %*% A.comp != 0
         
+		DA.comp <- matrix(TRUE, nrow=nrow(trafo), ncol=ncol(trafo))
+        DA.symm <- (nrow(trafo)==ncol(trafo)) && isTRUE(all.equal(trafo,t(trafo)))
+        if(DA.symm) DA.comp <- A.comp
+		
+        
         eerg <- .LowerCaseMultivariate(L2deriv = L2deriv, neighbor = neighbor, 
              biastype = biastype, normtype = normtype, Distr = Distr,  Finfo = Finfo,
              trafo = trafo, z.start = z.start, A.start = A.start, z.comp = z.comp,
@@ -92,6 +96,7 @@
         
         return(list(asBias = bias, normtype = eerg$normtype))
     })
+
 setMethod("getAsRisk", signature(risk = "asBias",
                                  L2deriv = "RealRandVariable",
                                  neighbor = "TotalVarNeighborhood",
@@ -294,17 +299,15 @@
             return(list(asBias = 0, warn = gettext("not attained by IC")))
 
         sign <- sign(biastype)
-        w0 <- options("warn")
-        on.exit(options(w0))
-        options(warn = -1)
         
-        l <- length(support(L2deriv))
-        if (sign>0)
-           {z0 <- support(L2deriv)[1]; deltahat <- support(L2deriv)[2]-z0}
-        else
-           {z0 <- support(L2deriv)[l]; deltahat <- z0-support(L2deriv)[l-1]}
-
-        bias <- abs(as.vector(trafo))/abs(z0)
+		if(missing(trafo)) trafo <- 1
+		if(length(trafo)>1) stop("Matrix/vector-valued 'trafo' is not (yet) supported.")
+        trafo <- c( trafo )
+		sign <- sign*sign(trafo)
+		
+        z0 <- if (sign>0) min(support(L2deriv))  else max(support(L2deriv))
+        
+        bias <- abs(trafo)/abs(z0)
         return(list(asBias = bias))
     })
 

Modified: branches/robast-1.3/pkg/ROptEst/R/getInfRobIC_asBias.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/getInfRobIC_asBias.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/getInfRobIC_asBias.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -202,8 +202,16 @@
 
         if(missing(verbose)|| is.null(verbose))
            verbose <- getRobAStBaseOption("all.verbose")
-        DA.comp <- abs(trafo) %*% A.comp != 0
-        eerg <- .LowerCaseMultivariate(L2deriv = L2deriv, neighbor = neighbor,
+        
+        A.test <- trafo * A.comp
+		A.symm <- (nrow(A.test)==ncol(A.test)) && isTRUE(all.equal(A.test,t(A.test)))
+
+		DA.comp <- (abs(A.test) >= 1e-8 * max(abs(A.test)))
+
+        if(A.symm) DA.comp[col(DA.comp)>row(DA.comp)] <- FALSE
+
+		
+		eerg <- .LowerCaseMultivariate(L2deriv = L2deriv, neighbor = neighbor,
              biastype = biastype, normtype = normtype, Distr = Distr,
              Finfo = Finfo, trafo, z.start, A.start = A.start, z.comp = z.comp,
              A.comp = DA.comp, maxiter = maxiter, tol = tol, verbose = verbose, ...)
@@ -216,8 +224,9 @@
         p <- nrow(trafo)
         k <- ncol(trafo)
         A <- matrix(0, ncol=k, nrow=p)
-        A[DA.comp] <- matrix(param[1:lA.comp], ncol=k, nrow=p)
-        A.max <- max(abs(A))
+        A[DA.comp] <- param[1:lA.comp]
+        if(A.symm) A[col(A)>row(A)] <- t(A)[col(A)>row(A)]
+		A.max <- max(abs(A))
         A <- A/A.max
         z <- numeric(k)
         z[z.comp] <- param[(lA.comp+1):length(param)]
@@ -394,28 +403,24 @@
            { if(is.finite(lowerCaseRadius(L2deriv, neighbor, risk = asMSE(), biastype)))
                 {
                  sign <- sign(biastype)
-                 w0 <- options("warn")
-                 on.exit(options(w0))
-                 options(warn = -1)
         
-                 l <- length(support(L2deriv))
-                 if (sign>0)
-                      {z0 <- support(L2deriv)[1] 
-                       deltahat <- support(L2deriv)[2]-z0
-                 }else{
-                       z0 <- support(L2deriv)[l]
-                       deltahat <- z0-support(L2deriv)[l-1]
-                 }
+                 supp.s <- sort(support(L2deriv))
+				 if(sign < 0) supp.s <- rev(supp.s)
+				 l <- length(supp.s)
+                 
+				 z0 <- supp.s[1]
+                 z1 <- supp.s[2]
+					   
                  p0 <- d(L2deriv)(z0)   
-                 v1 <- (1-p0)/p0/z0
-                 v2 <- -1/z0
-                 c0 <- deltahat*p0/2
-                 A0 <- abs(1/z0/c0)
-                 zc <- z0+sign(biastype)*deltahat*(1-p0)/2
+                 v0 <- (1-p0)/p0/z0
+                 v1 <- -1/z0
+                 
+				 zc <- p0*z0+(1-p0)*z1 
+				 A0 <- (v1-v0)/(z1-z0)
                  a0 <- A0*zc
                  b0 <- abs(1/z0)
                  d0  <- 0 
-                 asCov <- v1^2*(1-p0)+v2^2*p0
+                 asCov <- v0^2*p0+v1^2*(1-p0)
                  Risk0 <- list(asBias = list(value = b0, biastype = biastype, 
                                normtype = NormType(), 
                                neighbortype = class(neighbor)), 
@@ -423,7 +428,7 @@
                  A0 <- matrix(A0,1,1)
 
                  w <- new("HampelWeight")
-                 cent(w) <- z0
+                 cent(w) <- zc
                  stand(w) <- A0
                  clip(w) <- b0
                  weight(w) <- minbiasweight(w, neighbor = neighbor, 

Modified: branches/robast-1.3/pkg/ROptEst/R/getMaxIneff.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/getMaxIneff.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/getMaxIneff.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -6,9 +6,6 @@
             if(!is(IC,"IC")) 
                stop("Argument IC must be of class 'IC'.")
 
-            ow <- options("warn")
-            on.exit(options(ow))
-
             sb <- .getSB(IC,neighbor)
             si <- sb$s^2
             bi <- sb$b^2
@@ -55,9 +52,10 @@
                         L2derivDistrSymm <- new("DistrSymmList", L2)
                     }
                 }
-                if(!warn) options(warn = -1)
+                suppWarning <- if(!warn) suppressWarnings else function(x) return(x)
 
-                b0 <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor,
+                b0 <- suppWarning(
+				      getInfRobIC(L2deriv = L2deriv, neighbor = neighbor,
                             risk = risk,  Distr = L2Fam at distribution, 
                             DistrSymm = L2Fam at distrSymm, L2derivSymm = L2derivSymm,
                             L2derivDistrSymm = L2derivDistrSymm, 
@@ -65,6 +63,8 @@
                             maxiter = maxiter, tol = tol, warn = warn, 
                             Finfo = Finfo,
                             verbose = verbose,...)$risk$asBias$value^2
+					  )		
+							
               }else{
                 stop("not yet implemented")
               }

Modified: branches/robast-1.3/pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/leastFavorableRadius.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/leastFavorableRadius.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -38,9 +38,6 @@
                 upRad <- r/rho
                 lower <- ifelse(identical(all.equal(loRad, 0), TRUE), 1e-4, loRad)
                 upper <- ifelse(upRad == Inf, 10, upRad)
-                ow <- options("warn")
-                on.exit(options(ow))
-                options(warn = -1)
                 .getRisk <- function(rad, fac = 1){
                     neighbor at radius <- rad
                     res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]],
@@ -101,10 +98,12 @@
                      if(loRad>0){
                         args.Ie$loRad <- lower; args.Ie$loRisk <- .getRisk(lower)
                      }
-                     leastFavR <- try(
+                     suppressWarnings(
+					 leastFavR <- try(
                          uniroot(fct.Ie, lower = lower, upper = upper,
                          tol = .Machine$double.eps^0.25)$root, silent = TRUE)
-                     isE <- is(leastFavR, "try-error")
+                     )
+					 isE <- is(leastFavR, "try-error")
                      if(isE) print(conditionMessage(attr(leastFavR,"condition")))
                    }
                    if(isE)
@@ -113,7 +112,6 @@
                         upper, "] after", warnRund, "iterations."))
                 }
 
-                options(ow)
                 cat("current radius:\t", r, "\tinefficiency:\t", ineff, "\n")
                 return(ineff)
             }
@@ -159,10 +157,7 @@
                     upRad <- r/rho
                     lower <- ifelse(identical(all.equal(loRad, 0), TRUE), 1e-4, loRad)
                     upper <- ifelse(upRad == Inf, 10, upRad)
-                    ow <- options("warn")
-                    on.exit(options(ow))
-                    options(warn = -1)
-
+                    
                     .getRisk <- function(rad, fac = 1){
                         neighbor at radius <- rad
                         getInfRobICArgs <- c(list(L2deriv = L2deriv, neighbor = neighbor,
@@ -253,9 +248,10 @@
                             args.Ie$upRad <- upper; rL <- .getRisk(upper)
                             args.Ie$upRisk <- rL$Risk; args.Ie$upNorm <- rL$Norm
                          }
-                         leastFavR <- try(
+                         suppressWarnings(
+						 leastFavR <- try(
                              uniroot(fct.Ie, lower = lower, upper = upper,
-                             tol = .Machine$double.eps^0.25)$root, silent = TRUE)
+                             tol = .Machine$double.eps^0.25)$root, silent = TRUE))
                          isE <- is(leastFavR, "try-error")
                          if(isE) print(conditionMessage(attr(leastFavR,"condition")))
                        }
@@ -264,8 +260,7 @@
                        else warning(paste("Had to modify radius bounds to [", lower,
                             upper, "] after", warnRund, "iterations."))
                     }
-                    options(ow)
-
+                    
                     if(verbose)
                        cat(paste(rep("-",75), sep = "", collapse = ""),"\n")
                     cat("current radius:   ", round(r,4),

Modified: branches/robast-1.3/pkg/ROptEst/R/lowerCaseRadius.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/lowerCaseRadius.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/lowerCaseRadius.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -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: branches/robast-1.3/pkg/ROptEst/R/optIC.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/optIC.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/optIC.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -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: branches/robast-1.3/pkg/ROptEst/R/optRisk.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/optRisk.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/optRisk.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -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: branches/robast-1.3/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-1.3/pkg/ROptEst/R/radiusMinimaxIC.R	2024-02-06 21:54:09 UTC (rev 1283)
+++ branches/robast-1.3/pkg/ROptEst/R/radiusMinimaxIC.R	2024-02-06 21:55:50 UTC (rev 1284)
@@ -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