-Copyright (C) 2016-2026 Benjamin AUDER, Mor-Absa LOUM
-
-Permission to use, copy, modify, and/or distribute this software for any
-purpose with or without fee is hereby granted, provided that the above
-copyright notice and this permission notice appear in all copies.
-
-THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
-OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+YEAR: 2016-2026
+COPYRIGHT HOLDER: Benjamin Auder, Mor-Absa Loum
#'
#' @param fargs List of arguments for the estimation functions
#' @param estimParams List of nf function(s) to apply on fargs
+#' @param packages Vector of packages to load on each node (default: morpheus)
#' @param prepareArgs Prepare arguments for the functions inside estimParams
#' @param N Number of runs
#' @param ncores Number of cores for parallel runs (<=1: sequential)
#' res <- multiRun(list(X=io$X,Y=io$Y,K=2), list(
#' # morpheus
#' function(fargs) {
-#' library(morpheus)
#' ind <- fargs$ind
#' computeMu(fargs$X[ind,], fargs$Y[ind], list(K=fargs$K))
#' },
#' # flexmix
#' function(fargs) {
-#' library(flexmix)
#' ind <- fargs$ind
#' K <- fargs$K
#' dat <- as.data.frame( cbind(fargs$Y[ind],fargs$X[ind,]) )
#' model=FLXMRglm(family="binomial") ) )
#' normalize( matrix(out@@coef[1:(ncol(fargs$X)*K)], ncol=K) )
#' } ),
+#' packages = c("morpheus", "flexmix"),
#' prepareArgs = function(fargs,index) {
#' if (index == 1)
#' fargs$ind <- 1:nrow(fargs$X)
#' res <- multiRun(list(n=1000,p=1/2,β=β,b=c(0,0),link="logit"), list(
#' # morpheus
#' function(fargs) {
-#' library(morpheus)
#' K <- fargs$K
#' μ <- computeMu(fargs$X, fargs$Y, list(K=fargs$K))
#' o <- optimParams(fargs$X, fargs$Y, fargs$K, fargs$link, fargs$M)
#' },
#' # flexmix
#' function(fargs) {
-#' library(flexmix)
#' K <- fargs$K
#' dat <- as.data.frame( cbind(fargs$Y,fargs$X) )
#' out <- refit( flexmix( cbind(V1, 1 - V1) ~ ., data=dat, k=K,
#' sapply( seq_len(K), function(i)
#' as.double( out@@components[[1]][[i]][2:(1+ncol(fargs$X)),1] ) )
#' } ),
+#' packages = c("morpheus", "flexmix"),
#' prepareArgs = function(fargs,index) {
#' library(morpheus)
#' io <- generateSampleIO(fargs$n, fargs$p, fargs$β, fargs$b, fargs$link)
#' for (i in 1:2)
#' res[[i]] <- alignMatrices(res[[i]], ref=β, ls_mode="exact")}
#' @export
-multiRun <- function(fargs, estimParams,
+multiRun <- function(fargs, estimParams, packages = c("morpheus"),
prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE)
{
if (!is.list(fargs))
})
}
+ loadPackages <- function() {
+ for (p in packages)
+ library(p, character.only = TRUE)
+ }
+
if (ncores > 1)
{
cl <- parallel::makeCluster(ncores, outfile="")
- parallel::clusterExport(cl, c("fargs","verbose"), environment())
+ parallel::clusterExport(cl, c("fargs", "verbose", "loadPackages"), environment())
+ parallel::clusterEvalQ(cl, loadPackages() )
list_res <- parallel::clusterApplyLB(cl, 1:N, estimParamAtIndex)
parallel::stopCluster(cl)
}
- else
+ else {
+ loadPackages()
list_res <- lapply(1:N, estimParamAtIndex)
+ }
# De-interlace results: output one list per function
nf <- length(estimParams)