X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FmultiRun.R;h=f38f9f3a1b418f808007857fe2601a62d69ce673;hb=0f5fbd1371011f25cd1f6caf0e826d2ea9e4e245;hp=1cebaab7b3e9dc60c40abf5f39fc7b577418c7d5;hpb=cf673dee64ab0ce02ccaaba0fb63a9a4589ee8aa;p=morpheus.git diff --git a/pkg/R/multiRun.R b/pkg/R/multiRun.R index 1cebaab..f38f9f3 100644 --- a/pkg/R/multiRun.R +++ b/pkg/R/multiRun.R @@ -17,13 +17,13 @@ #' @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 #' 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) @@ -57,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) { @@ -74,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) @@ -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]]) ) }