Modo efficiente per campionare da diversi vettori di probabilità

Question

Sto cercando un modo più efficiente di campionare da un elenco di numeri interi 1: n, più volte, dove il vettore di probabilità (anche la lunghezza n) è diverso ogni volta. Per 20 prove con n = 10, so che si può fare in questo modo:

probs <- matrix(runif(200), nrow = 20) 
answers <- numeric(20) 
for(i in 1:20) answers[i] <- sample(10,1,prob=probs[i,]) 

Ma che chiama campione 10 volte solo per ottenere un singolo numero ogni volta, quindi è non è presumibilmente il modo più veloce. La velocità sarebbe utile poiché il codice lo farà molte volte.

Grazie mille!

Luca

Edit: Un grande grazie a romano, la cui idea di analisi comparativa mi ha aiutato a trovare una buona soluzione. Ora ho spostato questo alla risposta.

Answer 1

Solo per divertimento, ho provato altre due versioni. Su che scala stai facendo questo campionamento? Penso che tutti questi siano abbastanza veloci e più o meno equivalenti (non ho incluso la creazione di probs per la tua soluzione). Mi piacerebbe vedere gli altri fare un tentativo in questo.

library(rbenchmark) 
benchmark(replications = 1000, 
      luke = for(i in 1:20) answers[i] <- sample(10,1,prob=probs[i,]), 
      roman = apply(probs, MARGIN = 1, FUN = function(x) sample(10, 1, prob = x)), 
      roman2 = replicate(20, sample(10, 1, prob = runif(10)))) 

    test replications elapsed relative user.self sys.self user.child sys.child 
1 luke   1000 0.41 1.000  0.42  0   NA  NA 
2 roman   1000 0.47 1.146  0.46  0   NA  NA 
3 roman2   1000 0.47 1.146  0.44  0   NA  NA 

Answer 2

Ecco un altro approccio che ho trovato. È veloce, ma non così veloce come la semplice chiamata di campioni molte volte con un ciclo for. Inizialmente pensavo che fosse molto buono, ma stavo usando benchmark() in modo errato.

luke2 = function(probs) { # takes a matrix of probability vectors, each in its own row 
       probs <- probs/rowSums(probs) 
       probs <- t(apply(probs,1,cumsum)) 
       answer <- rowSums(probs - runif(nrow(probs)) < 0) + 1 
       return(answer) } 

Ecco come funziona: le probabilità immagine come linee di varie lunghezze disposti su una linea numero da 0 a 1. Le grandi probabilità si occupano più della linea numerosi di quelli piccoli. Puoi quindi scegliere il risultato scegliendo un punto casuale sulla linea del numero - le probabilità più grandi avranno più probabilità di essere scelte. Il vantaggio di questo approccio è che puoi lanciare tutti i numeri casuali necessari in una chiamata di runif(), invece di chiamare ripetutamente il campione come nelle funzioni luke, roman e roman2. Tuttavia, sembra che l'ulteriore elaborazione dei dati la rallenti e che i costi più che compensino questo vantaggio.

library(rbenchmark) 
probs <- matrix(runif(2000), ncol = 10) 
answers <- numeric(200) 

benchmark(replications = 1000, 
      luke = for(i in 1:20) answers[i] <- sample(10,1,prob=probs[i,]), 
      luke2 = luke2(probs), 
      roman = apply(probs, MARGIN = 1, FUN = function(x) sample(10, 1, prob = x)), 
      roman2 = replicate(20, sample(10, 1, prob = runif(10)))) 
       roman = apply(probs, MARGIN = 1, FUN = function(x) sample(10, 1, prob = x)), 
       roman2 = replicate(20, sample(10, 1, prob = runif(10)))) 

    test replications elapsed relative user.self sys.self user.child sys.child 
    1 luke   1000 0.171 1.000  0.166 0.005   0   0 
    2 luke2   1000 0.529 3.094  0.518 0.012   0   0 
    3 roman   1000 1.564 9.146  1.513 0.052   0   0 
    4 roman2   1000 0.225 1.316  0.213 0.012   0   0 

Per qualche ragione, apply() fa molto male quando aggiungi più righe. Non capisco perché, perché pensavo che fosse un wrapper per for() e quindi roman() dovrebbe comportarsi allo stesso modo di luke().