Browse code

replace wrong use of parallal foreach in function clusterFastICARuns by future_lapply or lapply

Anne Biton authored on 09/04/2020 09:43:12
Showing 2 changed files

... ...
@@ -22,7 +22,7 @@ Depends: R (>= 2.10), methods, BiocGenerics (>= 0.13.8), Biobase, plyr,
22 22
 Imports: AnnotationDbi, lumi, fpc, lumiHumanAll.db
23 23
 Suggests: biomaRt, GOstats, cluster, hgu133a.db, mclust, igraph,
24 24
         breastCancerMAINZ, breastCancerTRANSBIG, breastCancerUPP,
25
-        breastCancerVDX
25
+        breastCancerVDX, future, future.apply
26 26
 Enhances: doMC
27 27
 Collate: 'AllClasses.R' 'AllGeneric.R' 'methods-IcaSet.R'
28 28
         'methods-MineICAParams.R' 'compareAnalysis.R'
... ...
@@ -105,27 +105,60 @@ clusterFastICARuns <- function(X, nbComp, nbIt=100, alg.type = c("deflation", "p
105 105
     ## compute Iq indices and extract centrotypes
106 106
     # Iq=avg(intra-cluster similarity) - avg(extra-cluster similarity)
107 107
     
108
-    Iq <- 
109
-        foreach(clus=unique(partition), .combine=c) %dopar% {
110
-            indC <- which(partition==clus)
111
-            if (length(indC)>1) {
112
-                if (funClus != "pam")
113
-                    centrotypes <- c(centrotypes,indC[which.max(apply(sim[indC,indC],1,sum))])
114
-                internalSim <- mean(sim[indC,indC])
115
-            }
116
-            else {
117
-                if (funClus != "pam")
118
-                    centrotypes <- c(centrotypes,indC)
119
-                internalSim <- sim[indC,indC]                                
120
-            }
121
-            externalSim <- mean(sim[indC,setdiff(1:ncol(sim),indC)])
122
-            iq <- internalSim-externalSim
123
-
124
-            return(iq)
125
-        }
108
+    getIqCentr <-  function(clus, partition, sim, funClus) {
109
+	      	indC <- which(partition==clus)
110
+            	if (length(indC)>1) {
111
+                   if (funClus != "pam")
112
+                      centrotypes <- indC[which.max(apply(sim[indC,indC],1,sum))]
113
+                   internalSim <- mean(sim[indC,indC])
114
+            	} else {
115
+                   if (funClus != "pam")
116
+                      centrotypes <- indC
117
+                      internalSim <- sim[indC,indC]                                
118
+            	}
119
+            	externalSim <- mean(sim[indC,setdiff(1:ncol(sim),indC)])
120
+            	iq <- internalSim-externalSim
121
+
122
+            	return(c(centrotype=centrotypes,iq=iq))
123
+    }
124
+		
125
+
126
+    if (requireNamespace("future", quietly = TRUE) & requireNamespace("future.apply", quietly = TRUE)) {
127
+       future::plan(future::multiprocess) ## => parallelize on your local computer
128
+       iqcentr <-
129
+       	  future.apply::future_lapply(unique(partition), getIqCentr, partition=partition, sim=sim, funClus=funClus)
130
+    } else {
131
+        iqcentr <-
132
+       	  lapply(unique(partition), getIqCentr, partition=partition, sim=sim, funClus=funClus)    
133
+    }
134
+    
135
+    iqcentr <- do.call(rbind, iqcentr)
136
+    Iq <- iqcentr[,"iq"]
137
+    if (funClus != "pam") centrotypes <- iqcentr[,"centrotype"]
138
+    
139
+	
140
+
141
+#    Iq <- 
142
+#        foreach(clus=unique(partition), .combine=c) %dopar% {
143
+#            indC <- which(partition==clus)
144
+#            if (length(indC)>1) {
145
+#                if (funClus != "pam")
146
+#                    centrotypes <- c(centrotypes,indC[which.max(apply(sim[indC,indC],1,sum))])
147
+#                internalSim <- mean(sim[indC,indC])
148
+#            }
149
+#            else {
150
+#                if (funClus != "pam")
151
+#                    centrotypes <- c(centrotypes,indC)
152
+#                internalSim <- sim[indC,indC]                                
153
+#            }
154
+#            externalSim <- mean(sim[indC,setdiff(1:ncol(sim),indC)])
155
+#            iq <- internalSim-externalSim
156
+#
157
+#            return(iq)
158
+#        }
126 159
 
127 160
     
128
-    ## extract W including the centrotypes of each cluster
161
+    ## Extract W including the centrotypes of each cluster
129 162
     W <- whit %*% allW[,centrotypes]
130 163
     A <- solve(t(W)%*%W) %*% t(W)
131 164
     S <- X%*%W