From 0e0fa9ff2da60928a4b15a3c9e712abcbeb0ce02 Mon Sep 17 00:00:00 2001 From: Benjamin Auder Date: Fri, 20 Dec 2019 17:34:09 +0100 Subject: [PATCH] Fix multistart script --- reports/accuracy.R | 4 ++-- reports/multistart.R | 12 +++++++++--- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/reports/accuracy.R b/reports/accuracy.R index 96f3a4a..24191d8 100644 --- a/reports/accuracy.R +++ b/reports/accuracy.R @@ -29,12 +29,12 @@ optimBeta <- function(N, n, p, beta, b, link, ncores) tryCatch({ fm <- flexmix( cbind(V1, 1-V1) ~ .-V1, data=dat, k=K, model = FLXMRglm(family = binomial(link = link)) ) - p <- mean(fm@posterior[["scaled"]][,1]) + pf <- 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,]) + res2 <- rbind(pf, beta_b[2:nrow(beta_b),], beta_b[1,]) }, error = function(e) { res2 <- NA }) diff --git a/reports/multistart.R b/reports/multistart.R index 7cc0a5e..28d471f 100644 --- a/reports/multistart.R +++ b/reports/multistart.R @@ -45,8 +45,7 @@ testMultistart <- function(N, n, p, beta, b, link, nstart, ncores) } } } - # Bet that at least one run succeded: - do.call(rbind,best_par) + do.call(rbind,best_par) #return NULL on empty list } ), prepareArgs = function(fargs, index) { @@ -59,8 +58,15 @@ testMultistart <- function(N, n, p, beta, b, link, nstart, ncores) fargs$Y <- io$Y fargs }, N=N, ncores=ncores, verbose=TRUE) - for (i in 1:2) + p <- c(p, 1-sum(p)) + for (i in 1:length(res)) { + for (j in N:1) { + if (is.null(res[[i]][[j]]) || is.na(res[[i]][[j]])) + res[[i]][[j]] <- NULL + } + print(paste("Count valid runs for ",i," = ",length(res[[i]]),sep="")) res[[i]] <- alignMatrices(res[[i]], ref=rbind(p,beta,b), ls_mode="exact") + } res } -- 2.44.0