[Robast-commits] r328 - branches/robast-0.7/pkg/ROptEst/R

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

Author: stamats
Date: 2009-07-21 11:19:50 +0200 (Tue, 21 Jul 2009)
New Revision: 328

Modified:
   branches/robast-0.7/pkg/ROptEst/R/cniperCont.R
   branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
Log:
made Risk slot slightly more consistent (no longer double asMSE) - still a weak point.

Modified: branches/robast-0.7/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/cniperCont.R	2009-07-17 17:17:17 UTC (rev 327)
+++ branches/robast-0.7/pkg/ROptEst/R/cniperCont.R	2009-07-21 09:19:50 UTC (rev 328)
@@ -37,7 +37,7 @@
         psi <- optIC(model = L2Fam, risk = asCov())
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
         eta <- optIC(model = robMod, risk = asMSE())
-        maxMSE <- Risks(eta)$asMSE
+        maxMSE <- Risks(eta)$asMSE$value
         Delta <- sqrt(maxMSE - tr.invF)/neighbor at radius
         fun <- function(x){
             y <- evalIC(psi, x) 
@@ -56,7 +56,7 @@
         psi <- optIC(model = L2Fam, risk = asCov())
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
         eta <- optIC(model = robMod, risk = asMSE())
-        maxMSE <- Risks(eta)$asMSE
+        maxMSE <- Risks(eta)$asMSE$value
         fun <- function(x){
             y <- evalIC(psi, x) 
             tr.invF + as.vector(y %*% y)*neighbor at radius^2 - maxMSE

Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R	2009-07-17 17:17:17 UTC (rev 327)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R	2009-07-21 09:19:50 UTC (rev 328)
@@ -15,10 +15,12 @@
                         neighbor = neighbor, Finfo = Finfo, trafo = trafo,
                         verbose = verbose)
             res <- c(res, list(biastype = biastype, normtype = NormType()))
-            Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
-                              biastype = biastype, clip = res$b, cent = res$a, 
-                              stand = res$A, trafo = trafo)
-            res$risk <- c(Risk, res$risk)
+            if(!is(risk, "asMSE")){
+                Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
+                                  biastype = biastype, clip = res$b, cent = res$a, 
+                                  stand = res$A, trafo = trafo)
+                res$risk <- c(Risk, res$risk)
+            }
             Cov <- res$risk$asCov
             res$risk$asBias <- list(value = b, biastype = biastype, 
                                    normtype = NormType(), 
@@ -97,9 +99,13 @@
                      biastype = biastype, clip = c0, cent = z, trafo = trafo)
         a <- as.vector(A)*z
         b <- abs(as.vector(A))*c0
-        Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
-                          biastype = biastype, clip = b, cent = a, stand = A, 
-                          trafo = trafo)
+        if(!is(risk, "asMSE")){
+            Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
+                              biastype = biastype, clip = b, cent = a, stand = A, 
+                              trafo = trafo)
+        }else{
+            Risk <- NULL
+        }
         Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor, 
                        biastype = biastype, clip = c0, cent = z, stand = A)
 
@@ -161,18 +167,19 @@
                                Distr = Distr, Finfo = Finfo, trafo = trafo, 
                                QuadForm = QF, verbose = verbose)
             res <- c(res, list(biastype = biastype, normtype = normtype))
-            Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
-                              biastype = biastype, cent = res$a, 
-                              stand = res$A, trafo = trafo)
-            res$risk <- c(Risk, res$risk)
+            if(!is(risk, "asMSE")){
+                Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
+                                  biastype = biastype, cent = res$a, 
+                                  stand = res$A, trafo = trafo)
+                res$risk <- c(Risk, res$risk)
+            }
             trAsCov <- sum(diag(QF%*%res$risk$asCov)); 
-            r <- neighbor at radius
             res$risk$trAsCov <- list(value = trAsCov, normtype = normtype)
             res$risk$asBias <- list(value = b, biastype = biastype, 
                                    normtype = normtype, 
                                    neighbortype = class(neighbor))
-            res$risk$asMSE <- list(value = trAsCov + r^2*b^2, 
-                                   r = r,
+            res$risk$asMSE <- list(value = trAsCov + radius^2*b^2, 
+                                   r = radius,
                                    at = neighbor)
             return(res)
         }
@@ -203,7 +210,7 @@
 
             QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A))
             upper0 <- sqrt( (sum( diag(QF%*%A%*%Finfo%*%t(A))) + t(A%*%z)%*%QF%*%(A%*%z)) / 
-                          ((1 + neighbor at radius^2)^2-1))
+                          ((1 + radius^2)^2-1))
 
             if (!is.null(upper)|(iter == 1)) 
                     {lower <- .Machine$double.eps^0.75; 
@@ -283,9 +290,13 @@
 
         a <- as.vector(A %*% z)
         info <- paste("optimally robust IC for", sQuote(class(risk)[1]))
-        Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
-                          biastype = biastype, clip = b, cent = a, stand = A, 
-                          trafo = trafo)
+        if(!is(risk, "asMSE")){
+            Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor, 
+                              biastype = biastype, clip = b, cent = a, stand = A, 
+                              trafo = trafo)
+        }else{
+            Risk <- NULL
+        }
         Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor, 
                        biastype = biastype, Distr = Distr, 
                        V.comp = A.comp, cent = a,