Passing mclapply() einen Parameter aus (i in range)

Question

Ich versuche, dies zu tun:

nmf.sub <- function(n){ 
sub.data.matrix <- data.matrix[, (index[n, ])] ## the index is a permutation of the original matrix at a 0.8 resampling proportion (doesn't really matter) 
temp.result <- nmf(sub.data.matrix, rank = 2, seed = 12345) ## want to change 2 to i 
return(temp.result) 
} 

class.list <- list() 
for (i in nmf.rank){ ## nmf.rank is 2:4 
results.list <- mclapply(mc.cores = 16, 1:resamp.iterations, function(n) nmf.sub(n)) ## resamp.iterations is 10, nmf.sub is defined above 
} 

Aber statt mit Rang = 2 in der NMF für temp.result, möchte ich haben rank = i

Irgendeine Idee, wie ich diesen Parameter übergeben könnte? Wenn man mclapply als Funktion (n, i) durchgeht, funktioniert das nicht.

Answer 1

Sie haben scheinbar zwei Schleifen: eine für i in nmf.rank und eine für n in 1:resamp.iterations. Daher müssen Sie sowohl i als auch n an nmf.sub übergeben, z. wie in:

nmf.sub <- function(n, i){ 
    ## the index is a permutation of the original matrix at a 0.8 
    ## resampling proportion (doesn't really matter) 
    sub.data.matrix <- data.matrix[, (index[n, ])] 
    ## want to change 2 to i 
    temp.result <- nmf(sub.data.matrix, rank = i, seed = 12345) 
    return(temp.result) 
} 


resamp.iterations <- 10 
nmf.rank <- 2:4 

res <- lapply(nmf.rank, function(i){ 
    results.list <- mclapply(mc.cores = 16, 1:resamp.iterations, 
          function(n) nmf.sub(n,i)) 
}) 
## then you can flatten/reshape res 

In Bezug auf Ihren Kommentar (unten) über die Effizienz: die Masse der numerischen Berechnungen innerhalb des NMF() -Funktion ausgeführt, daher wird die Schleife richtig eingerichtet ist, in dem Sinne, dass jeder Prozess/core bekommt einen zahlenintensiven Job. Um die Berechnung zu beschleunigen, können Sie jedoch das zuvor berechnete Ergebnis anstelle des Seeds 12345 verwenden (es sei denn, die Verwendung des letzteren Seeds ist aus irgendeinem Grund, der mit Ihrem Problem zusammenhängt, obligatorisch). Im folgenden Beispiel bekomme ich eine 30-40% ige Reduzierung der Ausführungszeit:

library(NMF) 
RNGkind("L'Ecuyer-CMRG") ## always use this when using mclapply() 
nr <- 19 
nc <- 2e2 
set.seed(123) 
data.matrix <- matrix(rexp(nc*nr),nr,nc) 

resamp.iterations <- 10 
nmf.rank <- 2:4 

index <- t(sapply(1:resamp.iterations, function(n) sample.int(nc,nc*0.8))) 


nmf.sub <- function(n, i){ 
    sub.data.matrix <- data.matrix[ ,index[n, ]] 
    temp.result <- nmf(sub.data.matrix, rank = i, seed = 12345) 
    return(temp.result) 
} 

## version 1 
system.time({ 
    res <- lapply(nmf.rank, function(i){ 
     results.list <- mclapply(mc.cores = 16, 1:resamp.iterations, 
           function(n) nmf.sub(n,i)) 
    }) 
}) 

## version 2: swap internal and external loops 
system.time({ 
    res <- 
     mclapply(mc.cores=16, 1:resamp.iterations, function(n){ 
      res2 <- nmf(data.matrix[ ,index[n, ]], rank=2, seed = 12345) 
      res3 <- nmf(data.matrix[ ,index[n, ]], rank=3, seed = 12345) 
      res4 <- nmf(data.matrix[ ,index[n, ]], rank=4, seed = 12345) 
      list(res2,res3,res4) 
     }) 
}) 

## version 3: use previous calculation as starting point 
## ==> 30-40% reduction in computing time 
system.time({ 
    res <- 
     mclapply(mc.cores=16, 1:resamp.iterations, function(n){ 
      res2 <- nmf(data.matrix[ ,index[n, ]], rank=2, seed = 12345) 
      res3 <- nmf(data.matrix[ ,index[n, ]], rank=3, seed = res2) 
      res4 <- nmf(data.matrix[ ,index[n, ]], rank=4, seed = res3) 
      list(res2,res3,res4) 
     }) 
})