Some fixes to re-upload on the CRAN
[morpheus.git] / pkg / R / multiRun.R
CommitLineData
cbd88fe5
BA
1#' multiRun
2#'
2b3a6af5
BA
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.
cbd88fe5 9#'
ab35f610
BA
10#' @name multiRun
11#'
cbd88fe5 12#' @param fargs List of arguments for the estimation functions
2b3a6af5 13#' @param estimParams List of nf function(s) to apply on fargs
cbd88fe5
BA
14#' @param prepareArgs Prepare arguments for the functions inside estimParams
15#' @param N Number of runs
16#' @param ncores Number of cores for parallel runs (<=1: sequential)
cf673dee 17#' @param agg Aggregation method (default: lapply)
cbd88fe5
BA
18#' @param verbose TRUE to indicate runs + methods numbers
19#'
20#' @return A list of nf aggregates of N results (matrices).
21#'
22#' @examples
dfdd811f 23#' \dontrun{
cbd88fe5
BA
24#' β <- matrix(c(1,-2,3,1),ncol=2)
25#'
2b3a6af5 26#' # Bootstrap + computeMu, morpheus VS flexmix
cbd88fe5
BA
27#' io <- generateSampleIO(n=1000, p=1/2, β=β, b=c(0,0), "logit")
28#' μ <- normalize(β)
2b3a6af5 29#' res <- multiRun(list(X=io$X,Y=io$Y,K=2), list(
cbd88fe5
BA
30#' # morpheus
31#' function(fargs) {
32#' library(morpheus)
33#' ind <- fargs$ind
2b3a6af5 34#' computeMu(fargs$X[ind,], fargs$Y[ind], list(K=fargs$K))
cbd88fe5
BA
35#' },
36#' # flexmix
37#' function(fargs) {
38#' library(flexmix)
39#' ind <- fargs$ind
2b3a6af5 40#' K <- fargs$K
ab35f610
BA
41#' dat <- as.data.frame( cbind(fargs$Y[ind],fargs$X[ind,]) )
42#' out <- refit( flexmix( cbind(V1, 1 - V1) ~ 0+., data=dat, k=K,
cbd88fe5
BA
43#' model=FLXMRglm(family="binomial") ) )
44#' normalize( matrix(out@@coef[1:(ncol(fargs$X)*K)], ncol=K) )
45#' } ),
5fc1b9d9
BA
46#' prepareArgs = function(fargs,index) {
47#' if (index == 1)
48#' fargs$ind <- 1:nrow(fargs$X)
49#' else
50#' fargs$ind <- sample(1:nrow(fargs$X),replace=TRUE)
cbd88fe5
BA
51#' fargs
52#' }, N=10, ncores=3)
53#' for (i in 1:2)
54#' res[[i]] <- alignMatrices(res[[i]], ref=μ, ls_mode="exact")
55#'
2b3a6af5 56#' # Monte-Carlo + optimParams from X,Y, morpheus VS flexmix
ab35f610 57#' res <- multiRun(list(n=1000,p=1/2,β=β,b=c(0,0),link="logit"), list(
cbd88fe5
BA
58#' # morpheus
59#' function(fargs) {
60#' library(morpheus)
2b3a6af5
BA
61#' K <- fargs$K
62#' μ <- computeMu(fargs$X, fargs$Y, list(K=fargs$K))
63#' o <- optimParams(fargs$X, fargs$Y, fargs$K, fargs$link, fargs$M)
64#' o$run(list(β=μ))$β
cbd88fe5
BA
65#' },
66#' # flexmix
67#' function(fargs) {
68#' library(flexmix)
2b3a6af5 69#' K <- fargs$K
cbd88fe5 70#' dat <- as.data.frame( cbind(fargs$Y,fargs$X) )
ab35f610 71#' out <- refit( flexmix( cbind(V1, 1 - V1) ~ ., data=dat, k=K,
cbd88fe5 72#' model=FLXMRglm(family="binomial") ) )
2b3a6af5 73#' sapply( seq_len(K), function(i)
ab35f610 74#' as.double( out@@components[[1]][[i]][2:(1+ncol(fargs$X)),1] ) )
cbd88fe5 75#' } ),
5fc1b9d9 76#' prepareArgs = function(fargs,index) {
cbd88fe5 77#' library(morpheus)
ab35f610
BA
78#' io <- generateSampleIO(fargs$n, fargs$p, fargs$β, fargs$b, fargs$link)
79#' fargs$X <- io$X
80#' fargs$Y <- io$Y
81#' fargs$K <- ncol(fargs$β)
82#' fargs$link <- fargs$link
83#' fargs$M <- computeMoments(io$X,io$Y)
cbd88fe5
BA
84#' fargs
85#' }, N=10, ncores=3)
86#' for (i in 1:2)
87#' res[[i]] <- alignMatrices(res[[i]], ref=β, ls_mode="exact")}
88#' @export
89multiRun <- function(fargs, estimParams,
6dd5c2ac 90 prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE)
cbd88fe5 91{
6dd5c2ac
BA
92 if (!is.list(fargs))
93 stop("fargs: list")
94 # No checks on fargs: supposedly done in estimParams[[i]]()
95 if (!is.list(estimParams))
96 estimParams = list(estimParams)
97 # Verify that the provided parameters estimations are indeed functions
98 lapply(seq_along(estimParams), function(i) {
99 if (!is.function(estimParams[[i]]))
100 stop("estimParams: list of function(fargs)")
101 })
102 if (!is.numeric(N) || N < 1)
103 stop("N: positive integer")
cbd88fe5 104
6dd5c2ac
BA
105 estimParamAtIndex <- function(index)
106 {
107 fargs <- prepareArgs(fargs, index)
108 if (verbose)
109 cat("Run ",index,"\n")
110 lapply(seq_along(estimParams), function(i) {
111 if (verbose)
112 cat(" Method ",i,"\n")
113 out <- estimParams[[i]](fargs)
114 if (is.list(out))
115 do.call(rbind, out)
116 else
117 out
118 })
119 }
cbd88fe5 120
6dd5c2ac
BA
121 if (ncores > 1)
122 {
ab35f610 123 cl <- parallel::makeCluster(ncores, outfile="")
6dd5c2ac 124 parallel::clusterExport(cl, c("fargs","verbose"), environment())
ab35f610 125 list_res <- parallel::clusterApplyLB(cl, 1:N, estimParamAtIndex)
6dd5c2ac
BA
126 parallel::stopCluster(cl)
127 }
128 else
ab35f610 129 list_res <- lapply(1:N, estimParamAtIndex)
cbd88fe5 130
6dd5c2ac
BA
131 # De-interlace results: output one list per function
132 nf <- length(estimParams)
133 lapply( seq_len(nf), function(i) lapply(seq_len(N), function(j) list_res[[j]][[i]]) )
cbd88fe5 134}