From: 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/%7B%7B%20asset%28%27mixstore/css/img/pieces/scripts/config.php?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 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 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 out_$n$link$d 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/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")