[Robast-commits] r731 - branches/robast-1.0/pkg/ROptEst/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Mar 23 17:50:05 CET 2014


Author: stamats
Date: 2014-03-23 17:50:05 +0100 (Sun, 23 Mar 2014)
New Revision: 731

Modified:
   branches/robast-1.0/pkg/ROptEst/R/cniperCont.R
Log:
only minor editing

Modified: branches/robast-1.0/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-1.0/pkg/ROptEst/R/cniperCont.R	2014-03-23 15:06:29 UTC (rev 730)
+++ branches/robast-1.0/pkg/ROptEst/R/cniperCont.R	2014-03-23 16:50:05 UTC (rev 731)
@@ -65,7 +65,7 @@
         }
 
 
-.getFunCnip <- function(IC1,IC2, risk, L2Fam, r, b20=NULL){
+.getFunCnip <- function(IC1, IC2, risk, L2Fam, r, b20=NULL){
 
         riskfct <- getRiskFctBV(risk, biastype(risk))
 
@@ -75,17 +75,18 @@
            if(length(R) > 1) R <- R$value
            return(R)
         }
-        R1 <- .getTrVar (IC1)
-        R2 <- .getTrVar (IC2)
+        R1 <- .getTrVar(IC1)
+        R2 <- .getTrVar(IC2)
 
 
         fun <- function(x){
-            y1 <- evalIC(IC1,as.matrix(x,ncol=1))
-            r1 <- riskfct(var=R1,bias=r*fct(normtype(risk))(y1))
-            if(!is.null(b20))
-               r2 <- riskfct(var=R1,bias=b20) else{
-               y2 <- sapply(x,function(x0) evalIC(IC2,x0))
-               r2 <- riskfct(var=R2,bias=r*fct(normtype(risk))(y2))
+            y1 <- evalIC(IC1, as.matrix(x,ncol=1))
+            r1 <- riskfct(var=R1, bias=r*fct(normtype(risk))(y1))
+            if(!is.null(b20)){
+               r2 <- riskfct(var=R1, bias=b20)
+            }else{
+               y2 <- sapply(x, function(x0) evalIC(IC2,x0))
+               r2 <- riskfct(var=R2, bias=r*fct(normtype(risk))(y2))
             }
             r1 - r2
         }
@@ -120,7 +121,7 @@
             if(fCpl) b20 <- neighbor at radius*Risks(IC2)$asBias$value
         dots$fromCniperPlot <- NULL
         
-        fun <- .getFunCnip(IC1,IC2, risk, L2Fam, neighbor at radius, b20)
+        fun <- .getFunCnip(IC1, IC2, risk, L2Fam, neighbor at radius, b20)
 
         if(missing(scaleX.fct)){
            scaleX.fct <- p(L2Fam)
@@ -201,7 +202,7 @@
         psi <- optIC(model = L2Fam, risk = asCov())
         eta <- optIC(model = robMod, risk = risk)
 
-        fun <- .getFunCnip(psi,eta, risk, L2Fam, neighbor at radius)
+        fun <- .getFunCnip(psi, eta, risk, L2Fam, neighbor at radius)
 
         res <- uniroot(fun, lower = lower, upper = upper)$root
         names(res) <- "cniper point"



More information about the Robast-commits mailing list