X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FmultiRun.R;h=f38f9f3a1b418f808007857fe2601a62d69ce673;hb=0f5fbd1371011f25cd1f6caf0e826d2ea9e4e245;hp=8b70d6d2adb184b8cde0e7667378a1396498aefc;hpb=d294ece1cf943b74d96b26cc28b08c00cb191264;p=morpheus.git diff --git a/pkg/R/multiRun.R b/pkg/R/multiRun.R index 8b70d6d..f38f9f3 100644 --- a/pkg/R/multiRun.R +++ b/pkg/R/multiRun.R @@ -23,7 +23,7 @@ #' # Bootstrap + computeMu, morpheus VS flexmix ; assumes fargs first 3 elts X,Y,K #' io <- generateSampleIO(n=1000, p=1/2, β=β, b=c(0,0), "logit") #' μ <- normalize(β) -#' res <- multiRun(list(X=io$X,Y=io$Y,optargs=list(K=2,jd_nvects=0)), list( +#' res <- multiRun(list(X=io$X,Y=io$Y,optargs=list(K=2)), list( #' # morpheus #' function(fargs) { #' library(morpheus) @@ -82,48 +82,48 @@ #' res[[i]] <- alignMatrices(res[[i]], ref=β, ls_mode="exact")} #' @export multiRun <- function(fargs, estimParams, - prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE) + prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE) { - if (!is.list(fargs)) - stop("fargs: list") - # No checks on fargs: supposedly done in estimParams[[i]]() - if (!is.list(estimParams)) - estimParams = list(estimParams) - # Verify that the provided parameters estimations are indeed functions - lapply(seq_along(estimParams), function(i) { - if (!is.function(estimParams[[i]])) - stop("estimParams: list of function(fargs)") - }) - if (!is.numeric(N) || N < 1) - stop("N: positive integer") + if (!is.list(fargs)) + stop("fargs: list") + # No checks on fargs: supposedly done in estimParams[[i]]() + if (!is.list(estimParams)) + estimParams = list(estimParams) + # Verify that the provided parameters estimations are indeed functions + lapply(seq_along(estimParams), function(i) { + if (!is.function(estimParams[[i]])) + stop("estimParams: list of function(fargs)") + }) + if (!is.numeric(N) || N < 1) + stop("N: positive integer") - estimParamAtIndex <- function(index) - { - fargs <- prepareArgs(fargs, index) - if (verbose) - cat("Run ",index,"\n") - lapply(seq_along(estimParams), function(i) { - if (verbose) - cat(" Method ",i,"\n") - out <- estimParams[[i]](fargs) - if (is.list(out)) - do.call(rbind, out) - else - out - }) - } + estimParamAtIndex <- function(index) + { + fargs <- prepareArgs(fargs, index) + if (verbose) + cat("Run ",index,"\n") + lapply(seq_along(estimParams), function(i) { + if (verbose) + cat(" Method ",i,"\n") + out <- estimParams[[i]](fargs) + if (is.list(out)) + do.call(rbind, out) + else + out + }) + } - if (ncores > 1) - { - cl = parallel::makeCluster(ncores, outfile="") - parallel::clusterExport(cl, c("fargs","verbose"), environment()) - list_res = parallel::clusterApplyLB(cl, 1:N, estimParamAtIndex) - parallel::stopCluster(cl) - } - else - list_res = lapply(1:N, estimParamAtIndex) + if (ncores > 1) + { + cl = parallel::makeCluster(ncores, outfile="") + parallel::clusterExport(cl, c("fargs","verbose"), environment()) + list_res = parallel::clusterApplyLB(cl, 1:N, estimParamAtIndex) + parallel::stopCluster(cl) + } + else + list_res = lapply(1:N, estimParamAtIndex) - # De-interlace results: output one list per function - nf <- length(estimParams) - lapply( seq_len(nf), function(i) lapply(seq_len(N), function(j) list_res[[j]][[i]]) ) + # De-interlace results: output one list per function + nf <- length(estimParams) + lapply( seq_len(nf), function(i) lapply(seq_len(N), function(j) list_res[[j]][[i]]) ) }