Wydajny sposób próbkowania z różnych wektorów prawdopodobieństwa

Question

Szukam bardziej efektywnego sposobu pobierania próbek z listy liczb całkowitych 1: n, wiele razy, gdzie wektor prawdopodobieństwa (także długość n) jest za każdym razem inny. Na 20 prób z n = 10, wiem, można zrobić to tak:

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

Ale to nazywa próbka 10 razy, aby dostać się jeden numer za każdym razem, więc to nie jest prawdopodobnie najszybszym sposobem. Prędkość byłaby pomocna, ponieważ kod będzie robił to wiele razy.

Wielkie dzięki!

Luke

Edit: Wielkie dzięki dla Roman, którego idea o benchmarkingu pomógł mi znaleźć dobre rozwiązanie. Teraz przeniosłem to do odpowiedzi.

Answer 1

Dla zabawy wypróbowałem jeszcze dwie wersje. W jakiej skali robisz to sampling? Myślę, że wszystkie te są dość szybkie i mniej więcej równoważne (nie uwzględniłem tworzenia probs dla twojego rozwiązania). Chciałbym zobaczyć, jak inni to robią.

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

Oto inne podejście, które znalazłem. Jest szybki, ale nie tak szybki, jak proste wywołanie próbki z pętlą for. Początkowo myślałem, że to bardzo dobrze, ale użyłem benchmark() niepoprawnie.

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) } 

Oto jak to działa: obraz prawdopodobieństwa jak linie o różnych długościach określonymi na osi liczbowej od 0 do 1. Dużym prawdopodobieństwem zajmie więcej osi liczbowej niż małych. Następnie możesz wybrać wynik, wybierając losowy punkt na linii liczbowej - duże prawdopodobieństwa będą miały większe prawdopodobieństwo wyboru. Zaletą tego podejścia jest to, że można przetasować wszystkie liczby losowe potrzebne w jednym wywołaniu zrzutu(), zamiast wywoływać próbkę w kółko, jak w funkcjach luke, roman i roman2. Wygląda jednak na to, że dodatkowe przetwarzanie danych spowalnia to, a koszty z nawiązką kompensują tę korzyść.

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 

Z jakiegoś powodu, apply() bardzo źle, gdy dodajesz więcej wierszy. Nie rozumiem, dlaczego, ponieważ myślałem, że to opakowanie dla(), a więc powinien Roman() powinien działać podobnie jak luke().