[Robast-commits] r550 - in branches/robast-0.9/pkg: ROptEst/R RobExtremes/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2013-01-23 17:24:43 +0100 (Wed, 23 Jan 2013)
New Revision: 550

Modified:
   branches/robast-0.9/pkg/ROptEst/R/leastFavorableRadius.R
   branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
   branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
Log:
ROptEst: fixed a bug and modified interval search in leastFavorableRadius and radiusMinimaxIC in case uniroot fails to find zeroes; minor changes in interpolLM.R (RobExtremes)

Modified: branches/robast-0.9/pkg/ROptEst/R/leastFavorableRadius.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/leastFavorableRadius.R	2013-01-23 15:17:13 UTC (rev 549)
+++ branches/robast-0.9/pkg/ROptEst/R/leastFavorableRadius.R	2013-01-23 16:24:43 UTC (rev 550)
@@ -234,9 +234,10 @@
                                  tol = .Machine$double.eps^0.25)$root, silent =TRUE)
                     if(is(leastFavR, "try-error")){
                        warnRund <- 1; isE <- TRUE
+                       fl <- (0.2/lower)^(1/6); fu <- (0.5/upper)^(1/6)
                        while(warnRund < 7 && isE ){
                          warnRund <- warnRund + 1
-                         lower <- lower * 2;  upper <- upper / 2
+                         lower <- lower * fl;  upper <- upper *fr
                          if( warnRund == 4 ) min(upper, 1.5)
                          if(is.finite(upRad)){
                             args.Ie$upRad <- upper; rL <- .getRisk(upper)

Modified: branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R	2013-01-23 15:17:13 UTC (rev 549)
+++ branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R	2013-01-23 16:24:43 UTC (rev 550)
@@ -139,12 +139,13 @@
                    args.Ie$loRisk <- rL$Risk; args.Ie$loNorm <- rL$Norm
                }
                if(upRad == Inf){
-                   args.lR <- list(risk = asBias(biastype = biastype(risk),
+                   args.lR <- c(list(risk = asBias(biastype = biastype(risk),
                                                  normtype = normtype),
                                 L2deriv = L2deriv, neighbor = neighbor,
-                                biastype = biastype, normtype = normtype(risk),
-                                li.1, list(Finfo = Finfo, z.start = z.start,
-                                A.start = A.start, maxiter = maxiter, tol = tol,
+                                biastype = biastype, normtype = normtype(risk)),
+                                li.1, list(Finfo = Finfo, trafo = trafo,
+                                z.start = z.start, A.start = A.start,
+                                maxiter = maxiter, tol = tol,
                                 warn = warn, verbose = verbose))
                    biasR <- do.call(getAsRisk, args.lR)
                    args.Ie$upNorm <- biasR$normtype
@@ -167,10 +168,10 @@
 
         if(is(leastFavR, "try-error")){
            warnRund <- 1; isE <- TRUE
+           fl <- (0.2/lower)^(1/6); fu <- (0.5/upper)^(1/6)
            while(warnRund < 7 && isE ){
               warnRund <- warnRund + 1
-              lower <- lower * 2;  upper <- upper / 2
-              if( warnRund == 4 ) min(upper, 1.5)
+              lower <- lower * fl;  upper <- upper *fu
               if(is.finite(upRad)){
                  args.Ie$upRad <- upper; rL <- .getRisk(upper)
                  args.Ie$upRisk <- rL$Risk; args.Ie$upNorm <- rL$Norm

Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R	2013-01-23 15:17:13 UTC (rev 549)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R	2013-01-23 16:24:43 UTC (rev 550)
@@ -39,7 +39,8 @@
                       PFam = GParetoFamily(scale=1,shape=2),
                       optFct = .RMXE.xi,
                       withSmooth = TRUE,
-                      withPrint = FALSE, withCall = FALSE){
+                      withPrint = FALSE, withCall = FALSE,
+                      GridFileName="LMGrid.Rdata"){
    print(match.call())
    call <- match.call()
    itLM <- 0
@@ -68,7 +69,7 @@
 
             })
    LMGrid <- sapply(xiGrid,getLM)
-   save(LMGrid, file="LMGrid.Rdata")
+   save(LMGrid, file=GridFileName)
    res <- .MakeGridList(xiGrid, Y=t(LMGrid), withSmooth = withSmooth)
    print(res)
    return(list(grid = res$grid,
@@ -118,8 +119,8 @@
 
 .myFolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/ROptEst/R"
 .svInt <- function(optF = .RMXE.xi, nam = ".RMXE")
-             .saveInterpGrid(xiGrid = getShapeGrid(200,
-                  cutoff.at.0=0.01),
+             .saveInterpGrid(xiGrid = getShapeGrid(500,
+                  cutoff.at.0=0.005),
                   PFam = GParetoFamily(shape=1,scale=2),
                   sysRdaFolder=.myFolder, optFct = optF,
                   nameInSysdata = nam, getFun = .getLMGrid,