[Robast-commits] r1130 - branches/robast-1.2/pkg/RobAStBase/R

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

Author: ruckdeschel
Date: 2018-08-12 10:15:22 +0200 (Sun, 12 Aug 2018)
New Revision: 1130

Modified:
   branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
   branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R
Log:
[RobAStBase] branch 2.8
yet some bug fixes / in vectorized form, the indicators were not helpful...

Modified: branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R	2018-08-12 05:37:32 UTC (rev 1129)
+++ branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R	2018-08-12 08:15:22 UTC (rev 1130)
@@ -24,10 +24,10 @@
             return(IC.i(x)*L2.j(x))
         }
 
-        erg <- matrix(0, ncol = nrvalues, nrow = nrvalues)
+        erg <- matrix(0, ncol = dims, nrow = nrvalues)
 
         for(i in 1:nrvalues)
-            for(j in 1:nrvalues){
+            for(j in 1:dims){
                   Eargs <- c(list(object = Distr, fun = integrandA,
                                   IC.i = IC.v at Map[[i]], L2.j = L2deriv at Map[[j]]),
                                   dotsI)

Modified: branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R	2018-08-12 05:37:32 UTC (rev 1129)
+++ branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R	2018-08-12 08:15:22 UTC (rev 1130)
@@ -19,36 +19,34 @@
                 ICfct[[1]] <- function(x){}
                 if(dims==1L){
                     body(ICfct[[1]]) <- substitute(
-                                            { Lx <- L(x)
+                                            { Lx <- L(x); wx <- w(Lx)
+                                              print(str(a)); print(str(A));print(str(Lx)); print(str(w(Lx)))
                                               Yx <- A %*% Lx - a
-                                              ind <- 1-.eq(Yx)
-                                              (Yx*w(Lx) + zi*(1-ind)*d*b) },
+                                              ifelse(.eq(Yx),zi*d*b,as.numeric(Yx*w(Lx))) },
                                             list(L = L.fct, w = w, b = b, d = d, A = A, a = a,
                                                 zi = sign(trafo(L2Fam at param)), .eq = .eq))
                 }else{
                     body(ICfct[[1]]) <- substitute(
-                                            { Lx <- L(x)
+                                            { Lx <- L(x); wx <- w(Lx)
                                               Yx <- A %*% Lx - a
-                                              ind <- 1-.eq(Yx)
-                                              ifelse(ind, Yx*w(Lx), NA) },
+                                              ifelse(.eq(Yx), NA, as.numeric(Yx*w(Lx))) },
                                             list(L = L.fct, w = w, b = b, d = d, A = A, a = a,
                                                  .eq = .eq))
                 }
             }else{
                 ICfct[[1]] <- function(x){}
-                body(ICfct[[1]]) <- substitute({ Lx <- L(x)
+                body(ICfct[[1]]) <- substitute({ Lx <- L(x); wx <- w(Lx); #Lx <- as.matrix(Lx)
                                                  Yx <- A %*% Lx - a
-                                                 Yx*w(Lx) },
+                                                 as.numeric(Yx*wx) },
                                                  list(L = L.fct, A = A, a = a, w = w))
             }
         }else{
             if(!is.null(res$d))
                 for(i in 1:nrvalues){
                     ICfct[[i]] <- function(x){}
-                    body(ICfct[[i]]) <- substitute({Lx <- L(x)
+                    body(ICfct[[i]]) <- substitute({Lx <- L(x);wx <- w(Lx)
                                                     Yix <- Ai %*% Lx - ai
-                                                    ind <- 1-.eq(Yix)
-                                                    (ind*Yix*w(Lx) + (1-ind)*di)
+                                                    ifelse(.eq(Yix), di, as.numeric(Yix*wx))
                                                     },
                                                  list(L = L.fct, Ai = A[i,,drop=FALSE], ai = a[i], w = w,
                                                       di = d[i]))#,  .eq = .eq))
@@ -56,9 +54,9 @@
             else
                 for(i in 1:nrvalues){
                     ICfct[[i]] <- function(x){}
-                    body(ICfct[[i]]) <- substitute({Lx <- L(x)
+                    body(ICfct[[i]]) <- substitute({Lx <- L(x);wx <- w(Lx)
                                                     Yix <- Ai %*% Lx - ai
-                                                    Yix*w(Lx)  },
+                                                    as.numeric(Yix*wx)  },
                                                  list(L = L.fct, Ai = A[i,,drop=FALSE], ai = a[i], w = w))
                 }
         }