3 #' Estimate N times some parameters, outputs of some list of functions.
4 #' This method is thus very generic, allowing typically bootstrap or
5 #' Monte-Carlo estimations of matrices μ or β.
6 #' Passing a list of functions opens the possibility to compare them on a fair
7 #' basis (exact same inputs). It's even possible to compare methods on some
8 #' deterministic design of experiments.
10 #' @param fargs List of arguments for the estimation functions
11 #' @param estimParams List of nf function(s) to apply on fargs
12 #' @param prepareArgs Prepare arguments for the functions inside estimParams
13 #' @param N Number of runs
14 #' @param ncores Number of cores for parallel runs (<=1: sequential)
15 #' @param agg Aggregation method (default: lapply)
16 #' @param verbose TRUE to indicate runs + methods numbers
18 #' @return A list of nf aggregates of N results (matrices).
22 #' β <- matrix(c(1,-2,3,1),ncol=2)
24 #' # Bootstrap + computeMu, morpheus VS flexmix
25 #' io <- generateSampleIO(n=1000, p=1/2, β=β, b=c(0,0), "logit")
27 #' res <- multiRun(list(X=io$X,Y=io$Y,K=2), list(
32 #' computeMu(fargs$X[ind,], fargs$Y[ind], list(K=fargs$K))
39 #' dat = as.data.frame( cbind(fargs$Y[ind],fargs$X[ind,]) )
40 #' out = refit( flexmix( cbind(V1, 1 - V1) ~ 0+., data=dat, k=K,
41 #' model=FLXMRglm(family="binomial") ) )
42 #' normalize( matrix(out@@coef[1:(ncol(fargs$X)*K)], ncol=K) )
44 #' prepareArgs = function(fargs,index) {
46 #' fargs$ind <- 1:nrow(fargs$X)
48 #' fargs$ind <- sample(1:nrow(fargs$X),replace=TRUE)
52 #' res[[i]] <- alignMatrices(res[[i]], ref=μ, ls_mode="exact")
54 #' # Monte-Carlo + optimParams from X,Y, morpheus VS flexmix
55 #' res <- multiRun(list(n=1000,p=1/2,β=β,b=c(0,0),link="logit"),list(
60 #' μ <- computeMu(fargs$X, fargs$Y, list(K=fargs$K))
61 #' o <- optimParams(fargs$X, fargs$Y, fargs$K, fargs$link, fargs$M)
68 #' dat <- as.data.frame( cbind(fargs$Y,fargs$X) )
69 #' out <- refit( flexmix( cbind(V1, 1 - V1) ~ 0+., data=dat, k=K,
70 #' model=FLXMRglm(family="binomial") ) )
71 #' sapply( seq_len(K), function(i)
72 #' as.double( out@@components[[1]][[i]][,1] ) )
74 #' prepareArgs = function(fargs,index) {
76 #' io = generateSampleIO(fargs$n, fargs$p, fargs$β, fargs$b, fargs$link)
79 #' fargs$K = ncol(fargs$β)
80 #' fargs$link = fargs$link
81 #' fargs$M = computeMoments(io$X,io$Y)
85 #' res[[i]] <- alignMatrices(res[[i]], ref=β, ls_mode="exact")}
87 multiRun <- function(fargs, estimParams,
88 prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE)
92 # No checks on fargs: supposedly done in estimParams[[i]]()
93 if (!is.list(estimParams))
94 estimParams = list(estimParams)
95 # Verify that the provided parameters estimations are indeed functions
96 lapply(seq_along(estimParams), function(i) {
97 if (!is.function(estimParams[[i]]))
98 stop("estimParams: list of function(fargs)")
100 if (!is.numeric(N) || N < 1)
101 stop("N: positive integer")
103 estimParamAtIndex <- function(index)
105 fargs <- prepareArgs(fargs, index)
107 cat("Run ",index,"\n")
108 lapply(seq_along(estimParams), function(i) {
110 cat(" Method ",i,"\n")
111 out <- estimParams[[i]](fargs)
121 cl = parallel::makeCluster(ncores, outfile="")
122 parallel::clusterExport(cl, c("fargs","verbose"), environment())
123 list_res = parallel::clusterApplyLB(cl, 1:N, estimParamAtIndex)
124 parallel::stopCluster(cl)
127 list_res = lapply(1:N, estimParamAtIndex)
129 # De-interlace results: output one list per function
130 nf <- length(estimParams)
131 lapply( seq_len(nf), function(i) lapply(seq_len(N), function(j) list_res[[j]][[i]]) )