X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FmultiRun.R;h=56c3e199915659fa0251e6ebf06c6a675945e331;hb=6dd5c2acccd10635449230faa824b7e8906911bf;hp=0a2a8333b21fe7fda32e9238d67dbf0057d0e6e3;hpb=5fc1b9d9bbb20ebf5228792f5885b77991c0cec9;p=morpheus.git diff --git a/pkg/R/multiRun.R b/pkg/R/multiRun.R index 0a2a833..56c3e19 100644 --- a/pkg/R/multiRun.R +++ b/pkg/R/multiRun.R @@ -11,12 +11,13 @@ #' @param prepareArgs Prepare arguments for the functions inside estimParams #' @param N Number of runs #' @param ncores Number of cores for parallel runs (<=1: sequential) +#' @param agg Aggregation method (default: lapply) #' @param verbose TRUE to indicate runs + methods numbers #' #' @return A list of nf aggregates of N results (matrices). #' #' @examples -#' \dontrun{ +#' \donttest{ #' β <- matrix(c(1,-2,3,1),ncol=2) #' #' # Bootstrap + computeMu, morpheus VS flexmix ; assumes fargs first 3 elts X,Y,K @@ -56,8 +57,7 @@ #' library(morpheus) #' K <- fargs$optargs$K #' μ <- computeMu(fargs$X, fargs$Y, fargs$optargs) -#' V <- list( p=rep(1/K,K-1), β=μ, b=c(0,0) ) -#' optimParams(V,fargs$optargs)$β +#' optimParams(fargs$K,fargs$link,fargs$optargs)$run(list(β=μ))$β #' }, #' # flexmix #' function(fargs) { @@ -73,7 +73,8 @@ #' io = generateSampleIO(fargs$n, fargs$p, fargs$β, fargs$b, fargs$optargs$link) #' fargs$X = io$X #' fargs$Y = io$Y -#' fargs$optargs$K = ncol(fargs$β) +#' fargs$K = ncol(fargs$β) +#' fargs$link = fargs$optargs$link #' fargs$optargs$M = computeMoments(io$X,io$Y) #' fargs #' }, N=10, ncores=3) @@ -81,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]]) ) }