Commit | Line | Data |
---|---|---|
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 BA |
9 | #' |
10 | #' @param fargs List of arguments for the estimation functions | |
2b3a6af5 | 11 | #' @param estimParams List of nf function(s) to apply on fargs |
cbd88fe5 BA |
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) | |
cf673dee | 15 | #' @param agg Aggregation method (default: lapply) |
cbd88fe5 BA |
16 | #' @param verbose TRUE to indicate runs + methods numbers |
17 | #' | |
18 | #' @return A list of nf aggregates of N results (matrices). | |
19 | #' | |
20 | #' @examples | |
1b53e3a5 | 21 | #' \donttest{ |
cbd88fe5 BA |
22 | #' β <- matrix(c(1,-2,3,1),ncol=2) |
23 | #' | |
2b3a6af5 | 24 | #' # Bootstrap + computeMu, morpheus VS flexmix |
cbd88fe5 BA |
25 | #' io <- generateSampleIO(n=1000, p=1/2, β=β, b=c(0,0), "logit") |
26 | #' μ <- normalize(β) | |
2b3a6af5 | 27 | #' res <- multiRun(list(X=io$X,Y=io$Y,K=2), list( |
cbd88fe5 BA |
28 | #' # morpheus |
29 | #' function(fargs) { | |
30 | #' library(morpheus) | |
31 | #' ind <- fargs$ind | |
2b3a6af5 | 32 | #' computeMu(fargs$X[ind,], fargs$Y[ind], list(K=fargs$K)) |
cbd88fe5 BA |
33 | #' }, |
34 | #' # flexmix | |
35 | #' function(fargs) { | |
36 | #' library(flexmix) | |
37 | #' ind <- fargs$ind | |
2b3a6af5 | 38 | #' K <- fargs$K |
cbd88fe5 BA |
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) ) | |
43 | #' } ), | |
5fc1b9d9 BA |
44 | #' prepareArgs = function(fargs,index) { |
45 | #' if (index == 1) | |
46 | #' fargs$ind <- 1:nrow(fargs$X) | |
47 | #' else | |
48 | #' fargs$ind <- sample(1:nrow(fargs$X),replace=TRUE) | |
cbd88fe5 BA |
49 | #' fargs |
50 | #' }, N=10, ncores=3) | |
51 | #' for (i in 1:2) | |
52 | #' res[[i]] <- alignMatrices(res[[i]], ref=μ, ls_mode="exact") | |
53 | #' | |
2b3a6af5 BA |
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( | |
cbd88fe5 BA |
56 | #' # morpheus |
57 | #' function(fargs) { | |
58 | #' library(morpheus) | |
2b3a6af5 BA |
59 | #' K <- fargs$K |
60 | #' μ <- computeMu(fargs$X, fargs$Y, list(K=fargs$K)) | |
61 | #' o <- optimParams(fargs$X, fargs$Y, fargs$K, fargs$link, fargs$M) | |
62 | #' o$run(list(β=μ))$β | |
cbd88fe5 BA |
63 | #' }, |
64 | #' # flexmix | |
65 | #' function(fargs) { | |
66 | #' library(flexmix) | |
2b3a6af5 | 67 | #' K <- fargs$K |
cbd88fe5 BA |
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") ) ) | |
2b3a6af5 BA |
71 | #' sapply( seq_len(K), function(i) |
72 | #' as.double( out@@components[[1]][[i]][,1] ) ) | |
cbd88fe5 | 73 | #' } ), |
5fc1b9d9 | 74 | #' prepareArgs = function(fargs,index) { |
cbd88fe5 | 75 | #' library(morpheus) |
2b3a6af5 | 76 | #' io = generateSampleIO(fargs$n, fargs$p, fargs$β, fargs$b, fargs$link) |
cbd88fe5 BA |
77 | #' fargs$X = io$X |
78 | #' fargs$Y = io$Y | |
d294ece1 | 79 | #' fargs$K = ncol(fargs$β) |
2b3a6af5 BA |
80 | #' fargs$link = fargs$link |
81 | #' fargs$M = computeMoments(io$X,io$Y) | |
cbd88fe5 BA |
82 | #' fargs |
83 | #' }, N=10, ncores=3) | |
84 | #' for (i in 1:2) | |
85 | #' res[[i]] <- alignMatrices(res[[i]], ref=β, ls_mode="exact")} | |
86 | #' @export | |
87 | multiRun <- function(fargs, estimParams, | |
6dd5c2ac | 88 | prepareArgs = function(x,i) x, N=10, ncores=3, agg=lapply, verbose=FALSE) |
cbd88fe5 | 89 | { |
6dd5c2ac BA |
90 | if (!is.list(fargs)) |
91 | stop("fargs: list") | |
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)") | |
99 | }) | |
100 | if (!is.numeric(N) || N < 1) | |
101 | stop("N: positive integer") | |
cbd88fe5 | 102 | |
6dd5c2ac BA |
103 | estimParamAtIndex <- function(index) |
104 | { | |
105 | fargs <- prepareArgs(fargs, index) | |
106 | if (verbose) | |
107 | cat("Run ",index,"\n") | |
108 | lapply(seq_along(estimParams), function(i) { | |
109 | if (verbose) | |
110 | cat(" Method ",i,"\n") | |
111 | out <- estimParams[[i]](fargs) | |
112 | if (is.list(out)) | |
113 | do.call(rbind, out) | |
114 | else | |
115 | out | |
116 | }) | |
117 | } | |
cbd88fe5 | 118 | |
6dd5c2ac BA |
119 | if (ncores > 1) |
120 | { | |
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) | |
125 | } | |
126 | else | |
127 | list_res = lapply(1:N, estimParamAtIndex) | |
cbd88fe5 | 128 | |
6dd5c2ac BA |
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]]) ) | |
cbd88fe5 | 132 | } |