Fix script for cluster + a few other fixes

diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION
index 3872e96..b18cd01 100644 (file)
--- a/pkg/DESCRIPTION
+++ b/pkg/DESCRIPTION
@@ -23,8 +23,7 @@ Suggests:
     parallel,
     testthat,
     roxygen2,
-    tensor,
-    nloptr
+    tensor
 License: MIT + file LICENSE
 RoxygenNote: 5.0.1
 Collate:

diff --git a/pkg/src/hungarian.c b/pkg/src/hungarian.c
index 3a3a5ec..7850f64 100644 (file)
--- a/pkg/src/hungarian.c
+++ b/pkg/src/hungarian.c
@@ -90,8 +90,7 @@ int hungarian_init(hungarian_problem_t* p, double** cost_matrix, int rows, int c
                // nothing to do
        }
 //     else
-//             fprintf(stderr,"%s: unknown mode. Mode was set to \
-//                     HUNGARIAN_MODE_MINIMIZE_COST !\n", __FUNCTION__);
+//             fprintf(stderr,"%s: unknown mode. Mode was set to HUNGARIAN_MODE_MINIMIZE_COST !\n", __FUNCTION__);
 
        return rows;
 }
@@ -370,8 +369,7 @@ double** array_to_matrix(double* m, int rows, int cols)
 }
 
 //TODO: re-code this algorithm in a more readable way, based on
-//https://www.topcoder.com/community/data-science/data-science-tutorials/\
-//  assignment-problem-and-hungarian-algorithm/
+//https://www.topcoder.com/community/data-science/data-science-tutorials/assignment-problem-and-hungarian-algorithm/
 // Get the optimal assignment, by calling hungarian_solve above; "distances" in columns
 void hungarianAlgorithm(double* distances, int* pn, int* assignment)
 {

diff --git a/reports/accuracy.R b/reports/accuracy.R
index 2381524..57a63db 100644 (file)
--- a/reports/accuracy.R
+++ b/reports/accuracy.R
@@ -13,7 +13,7 @@ optimBeta <- function(N, n, K, p, beta, b, link, ncores)
                                mu <- computeMu(fargs$X, fargs$Y, fargs$optargs)
                                res2 <- NULL
                                tryCatch({
-                                       op <- optimParams(K,link,fargs$optargs)
+                                       op <- optimParams(K,fargs$optargs$link,fargs$optargs)
                                        x_init <- list(p=rep(1/K,K-1), beta=mu, b=rep(0,K))
                                        res2 <- do.call(rbind, op$run(x_init))
                                }, error = function(e) {

diff --git a/reports/run_accu_cl.sh b/reports/run_accu_cl.sh
index 50b2844..6d6ac21 100644 (file)
--- a/reports/run_accu_cl.sh
+++ b/reports/run_accu_cl.sh
@@ -1,27 +1,37 @@
 #!/bin/bash
 
-#PBS -l nodes=1:ppn=15,mem=8gb,pmem=512mb
-#PBS -j oe
-
-#PBS -o .output
+#$ -N morpheus
+#$ -m abes
+#$ -M benjamin@auder.net
+#$ -pe make 5
+#$ -l h_vmem=1G
+#$ -j y
+#$ -o .output
 rm -f .output
 
 WORKDIR=/workdir2/auder/morpheus/reports
 cd $WORKDIR
 
-module load R
+module load R/3.6.0
+
+N=1000
+n=1e5
+nc=50
+
+link=logit
+# and disable d=20 to run faster
 
 # arg --vanilla maybe possible on cluster
-for d in 2 5 10 20; do
-       for link in "logit" "probit"; do
-               R --slave --args N=1000 n=1e5 nc=15 d=$d link=$link <accuracy.R >out$d$link 2>&1
-       done
+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 <accuracy.R >out_$n$link$d 2>&1
+       #done
 done
 
 #for d in 2 5; do
 #      for n in 5000 10000 100000 500000 1000000; do
 #              for link in "logit" "probit"; do
-#                      R --slave --args N=1000 n=$n nc=64 d=$d link=$link <accuracy.R >out_$n$link$d 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/test.R b/reports/test.R
new file mode 100644 (file)
index 0000000..2ce9a44
--- /dev/null
+++ b/reports/test.R
@@ -0,0 +1,58 @@
+library(morpheus)
+morph <- function(fargs) {
+       K <- fargs$optargs$K
+       M <- computeMoments(fargs$X, fargs$Y)
+       fargs$optargs$M <- M
+       mu <- computeMu(fargs$X, fargs$Y, fargs$optargs)
+       res2 <- NULL
+       tryCatch({
+               op <- optimParams(K,link,fargs$optargs)
+               x_init <- list(p=rep(1/K,K-1), beta=mu, b=rep(0,K))
+               res2 <- do.call(rbind, op$run(x_init))
+       }, error = function(e) {
+               res2 <- NA
+       })
+       res2
+}
+
+#model = binomial; default values:
+link = "probit"
+N <- 10
+d <- 2
+n <- 1e4
+ncores <- 1
+
+if (d == 2) {
+       K <- 2
+       p <- .5
+       b <- c(-.2, .5)
+       beta <- matrix( c(1,-2, 3,1), ncol=K )
+} else if (d == 5) {
+       K <- 2
+       p <- .5
+       b <- c(-.2, .5)
+       beta <- matrix( c(1,2,-1,0,3, 2,-3,0,1,0), ncol=K )
+} else if (d == 10) {
+       K <- 3
+       p <- c(.3, .3)
+       b <- c(-.2, 0, .5)
+       beta <- matrix( c(1,2,-1,0,3,4,-1,-3,0,2, 2,-3,0,1,0,-1,-4,3,2,0, -1,1,3,-1,0,0,2,0,1,-2), ncol=K )
+} else if (d == 20) {
+       K <- 3
+       p <- c(.3, .3)
+       b <- c(-.2, 0, .5)
+       beta <- matrix( c(1,2,-1,0,3,4,-1,-3,0,2,2,-3,0,1,0,-1,-4,3,2,0, -1,1,3,-1,0,0,2,0,1,-2,1,2,-1,0,3,4,-1,-3,0,2, 2,-3,0,1,0,-1,-4,3,2,0,1,1,2,2,-2,-2,3,1,0,0), ncol=K )
+}
+
+fargs = list(n=n, p=p, beta=beta, b=b)
+fargs$optargs = list(link=link)
+
+io = generateSampleIO(fargs$n, fargs$p, fargs$beta, fargs$b, fargs$optargs$link)
+fargs$X = io$X
+fargs$Y = io$Y
+fargs$optargs$K = ncol(fargs$beta)
+fargs$optargs$M = computeMoments(io$X,io$Y)
+
+res2 <- morph(fargs)
+
+save("res2", file="test.RData")