Reporting scripts + TODO in OptimParams

diff --git a/pkg/R/optimParams.R b/pkg/R/optimParams.R
index 5a88ed9..5c80fc2 100644 (file)
--- a/pkg/R/optimParams.R
+++ b/pkg/R/optimParams.R
@@ -268,8 +268,7 @@ setRefClass(
       # (Re)Set W to identity, to allow several run from the same object
       W <<- diag(d+d^2+d^3)
 
       # (Re)Set W to identity, to allow several run from the same object
       W <<- diag(d+d^2+d^3)
 

-      # TODO: stopping condition? N iterations? Delta <= epsilon ?
-      loopMax <- 2
+      loopMax <- 2 #TODO: loopMax = 3 ?

       for (loop in 1:loopMax)
       {
         op_res = constrOptim( linArgs(θ0), .self$f, .self$grad_f,
       for (loop in 1:loopMax)
       {
         op_res = constrOptim( linArgs(θ0), .self$f, .self$grad_f,

diff --git a/reports/accuracy.R b/reports/accuracy.R
index d628436..6f322bf 100644 (file)
--- a/reports/accuracy.R
+++ b/reports/accuracy.R
@@ -17,29 +17,28 @@ optimBeta <- function(N, n, p, beta, b, link, ncores)
           res2 <- do.call(rbind, op$run(x_init))
         }, error = function(e) {})
         res2
           res2 <- do.call(rbind, op$run(x_init))
         }, error = function(e) {})
         res2

+      },
+      # flexmix
+      function(fargs) {
+        library(flexmix)
+        source("../patch_Bettina/FLXMRglm.R")
+        K <- ncol(fargs$beta)
+        dat <- as.data.frame( cbind(fargs$Y,fargs$X) )
+        res2 <- NULL
+        tryCatch({
+          fm <- flexmix( cbind(V1, 1-V1) ~ .-V1, data=dat, k=K,
+            model = FLXMRglm(family = binomial(link = link)) )
+          p <- mean(fm@posterior[["scaled"]][,1])
+          out <- refit(fm)
+          beta_b <- sapply( seq_len(K), function(i) {
+            as.double( out@components[[1]][[i]][,1] )
+          } )
+          res2 <- rbind(p, beta_b[2:nrow(beta_b),], beta_b[1,])
+        }, error = function(e) {
+          res2 <- NA
+        })
+        res2

       }
       }

-#      ,
-#      # flexmix
-#      function(fargs) {
-#        library(flexmix)
-#        source("../patch_Bettina/FLXMRglm.R")
-#        K <- ncol(fargs$beta)
-#        dat <- as.data.frame( cbind(fargs$Y,fargs$X) )
-#        res2 <- NULL
-#        tryCatch({
-#          fm <- flexmix( cbind(V1, 1-V1) ~ .-V1, data=dat, k=K,
-#            model = FLXMRglm(family = binomial(link = link)) )
-#          p <- mean(fm@posterior[["scaled"]][,1])
-#          out <- refit(fm)
-#          beta_b <- sapply( seq_len(K), function(i) {
-#            as.double( out@components[[1]][[i]][,1] )
-#          } )
-#          res2 <- rbind(p, beta_b[2:nrow(beta_b),], beta_b[1,])
-#        }, error = function(e) {
-#          res2 <- NA
-#        })
-#        res2
-#      }

     ),
     prepareArgs = function(fargs, index) {
       library(morpheus)
     ),
     prepareArgs = function(fargs, index) {
       library(morpheus)


@@ -101,7 +100,7 @@ if (d == 2) {
 }
 
 mr <- optimBeta(N, n, p, beta, b, link, ncores)
 }
 
 mr <- optimBeta(N, n, p, beta, b, link, ncores)

-mr_params <- list("N"=N, "nc"=ncores, "n"=n, "K"=K, "d"=d, "link"=link,
+mr_params <- list("N"=N, "nc"=ncores, "n"=n, "link"=link,

   "p"=c(p,1-sum(p)), "beta"=beta, "b"=b)
 
 save("mr", "mr_params", file=paste("res_",n,"_",d,"_",link,".RData",sep=""))
   "p"=c(p,1-sum(p)), "beta"=beta, "b"=b)
 
 save("mr", "mr_params", file=paste("res_",n,"_",d,"_",link,".RData",sep=""))

diff --git a/reports/local_run.sh b/reports/local_run.sh
index e2cff42..c7412b1 100644 (file)
--- a/reports/local_run.sh
+++ b/reports/local_run.sh
@@ -1,12 +1,15 @@
 #!/bin/bash
 
 N=100
 #!/bin/bash
 
 N=100

-n=1e5
+n=5e3

 nc=3
 nc=3

-nstart=5
+#nstart=5

 
 

-for d in 2 5 10; do
-       for link in "logit" "probit"; do
-               R --slave --args N=$N n=$n nc=$nc d=$d link=$link nstart=$nstart <multistart.R >out_${n}_${link}_${d}_${nstart} 2>&1
-       done
+for n in "5000" "10000" "100000"; do
+  for d in 2 5 10; do
+    for link in "logit" "probit"; do
+      #R --slave --args N=$N n=$n nc=$nc d=$d link=$link nstart=$nstart <multistart.R >out_${n}_${link}_${d}_${nstart} 2>&1
+      R --slave --args N=$N n=$n nc=$nc d=$d link=$link <accuracy.R >out_${n}_${link}_${d} 2>&1
+    done
+  done

 done
 done

diff --git a/reports/printResults.R b/reports/printResults.R
index 28a2157..a6cac05 100644 (file)
--- a/reports/printResults.R
+++ b/reports/printResults.R
@@ -13,9 +13,8 @@ pprms <- function(link)
 {
   for (n in c("5000", "10000", "100000", "500000", "1000000"))
   {
 {
   for (n in c("5000", "10000", "100000", "500000", "1000000"))
   {

-    method  =1
-    #for (method in 1:2)
-    #{
+    for (method in 1:2)
+    {

       toprint <- c()
       for (d in c(2,5,10))
       {
       toprint <- c()
       for (d in c(2,5,10))
       {


@@ -28,6 +27,6 @@ pprms <- function(link)
         ))
       }
       print(toprint, digits=2)
         ))
       }
       print(toprint, digits=2)

-    #}
+    }

   }
 }
   }
 }