From: Benjamin Auder <benjamin.auder@somewhere>
Date: Tue, 17 Dec 2019 22:50:30 +0000 (+0100)
Subject: Reporting scripts + TODO in OptimParams
X-Git-Url: https://git.auder.net/variants/img/current/%7B%7B%20asset%28%27mixstore/images/%7B%7B%20pkg.url%20%7D%7D?a=commitdiff_plain;h=38c65767eb0c8c5a7ad6025471f56dbaffc68e6e;p=morpheus.git

Reporting scripts + TODO in OptimParams
---

diff --git a/pkg/R/optimParams.R b/pkg/R/optimParams.R
index 5a88ed9..5c80fc2 100644
--- 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)
 
-      # 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,
diff --git a/reports/accuracy.R b/reports/accuracy.R
index d628436..6f322bf 100644
--- 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
+      },
+      # 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)
@@ -101,7 +100,7 @@ if (d == 2) {
 }
 
 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=""))
diff --git a/reports/local_run.sh b/reports/local_run.sh
index e2cff42..c7412b1 100644
--- a/reports/local_run.sh
+++ b/reports/local_run.sh
@@ -1,12 +1,15 @@
 #!/bin/bash
 
 N=100
-n=1e5
+n=5e3
 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
diff --git a/reports/printResults.R b/reports/printResults.R
index 28a2157..a6cac05 100644
--- a/reports/printResults.R
+++ b/reports/printResults.R
@@ -13,9 +13,8 @@ pprms <- function(link)
 {
   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))
       {
@@ -28,6 +27,6 @@ pprms <- function(link)
         ))
       }
       print(toprint, digits=2)
-    #}
+    }
   }
 }