From: Benjamin Auder Date: Tue, 17 Dec 2019 22:50:30 +0000 (+0100) Subject: Reporting scripts + TODO in OptimParams X-Git-Url: https://git.auder.net/variants/Apocalypse/scripts/current/pieces/assets/DESCRIPTION?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 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 out_${n}_${link}_${d}_${nstart} 2>&1 + R --slave --args N=$N n=$n nc=$nc d=$d link=$link 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) - #} + } } }