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

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

Author: ruckdeschel
Date: 2014-04-15 00:36:07 +0200 (Tue, 15 Apr 2014)
New Revision: 749

Modified:
   branches/robast-1.0/pkg/ROptEst/R/cniperCont.R
Log:
ROptEst: fixed Matthias' error-issue in TeaserExample.R

Modified: branches/robast-1.0/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-1.0/pkg/ROptEst/R/cniperCont.R	2014-04-12 13:05:31 UTC (rev 748)
+++ branches/robast-1.0/pkg/ROptEst/R/cniperCont.R	2014-04-14 22:36:07 UTC (rev 749)
@@ -65,28 +65,27 @@
         }
 
 
-.getFunCnip <- function(IC1, IC2, risk, L2Fam, r, b20=NULL){
+.getFunCnip <- function(IC1,IC2, risk, L2Fam, r, b20=NULL){
 
         riskfct <- getRiskFctBV(risk, biastype(risk))
-
        .getTrVar <- function(IC){
            R <- Risks(IC)[["trAsCov"]]
            if(is.null(R)) R <- getRiskIC(IC, risk = trAsCov(), L2Fam = L2Fam)
            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))
+            y1 <- sapply(x, function(x1)evalIC(IC1,as.matrix(x1,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))
+               y2 <- sapply(x,function(x0) evalIC(IC2,x0))
+               r2 <- riskfct(var=R2,bias=r*fct(normtype(risk))(y2))
             }
             r1 - r2
         }
@@ -121,7 +120,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)
@@ -138,7 +137,6 @@
         dots$x <- resc$X
         dots$y <- resc$Y
 
-
         dots$type <- "l"
         if(is.null(dots$main)) dots$main <- gettext("Cniper region plot")
         if(is.null(dots$xlab)) dots$xlab <- gettext("Dirac point")
@@ -165,7 +163,6 @@
                    dots$lty <- ltyo[[1]]
             }
         }
-        dots <- dots[names(dots) != "withMaxRisk"]
         do.call(plot,dots)
 
         dots <- .makedotsLowLevel(dots)
@@ -192,18 +189,17 @@
 
         mc <- match.call(expand.dots = FALSE)
 
-        if(!is.null(as.list(mc)$lower)) lower <- p(L2Fam)(lower)
-        if(!is.null(as.list(mc)$upper)) upper <- p(L2Fam)(upper)
-        lower <- q(L2Fam)(lower)
-        upper <- q(L2Fam)(upper)
+        if(is.null(as.list(mc)$lower)) lower <- q(L2Fam)(lower)
+        if(is.null(as.list(mc)$upper)) upper <- q(L2Fam)(upper)
+#        lower <- q(L2Fam)(lower)
+#        upper <- q(L2Fam)(upper)
 
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
 
         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"
         res
@@ -222,12 +218,12 @@
                            which.lbs = NULL, which.Order  = NULL,
                            return.Order = FALSE){
 
-        mc <- match.call(#call = sys.call(sys.parent(1)),
+        mc0 <- match.call(#call = sys.call(sys.parent(1)),
                        expand.dots = FALSE)
+        mc <- match.call(#call = sys.call(sys.parent(1)),
+                       expand.dots = TRUE)
         mcl <- as.list(mc[-1])
-        mcl <- mcl[names(mcl) != "..."]
-        dots <- as.list(mc$"...")
-        mcl <- .merge.lists(mcl, dots)
+        dots <- as.list(mc0$"...")
 
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
 
@@ -240,6 +236,7 @@
            mcl$main <- gettext("Cniper point plot")
 
         if(withMaxRisk) mcl$fromCniperPlot <- TRUE
+        mcl$withMaxRisk <- NULL
         do.call(cniperCont, mcl)
 }