From: Benjamin Auder <benjamin@auder>
Date: Mon, 23 Sep 2019 14:13:35 +0000 (+0200)
Subject: Fix script for cluster + a few other fixes
X-Git-Url: https://git.auder.net/js/doc/vendor/parser.js?a=commitdiff_plain;h=324febd30a6fbf63d805dc76f1ac7aed8fead915;p=morpheus.git

Fix script for cluster + a few other fixes
---

diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION
index 3872e96..b18cd01 100644
--- 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
--- 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
--- 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
--- 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
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")