Wie kann man aus

In R habe ich eine Matrix wobei die -te Reihe von einer Verteilung auf . Im Wesentlichen muss ich aus jeder Zeile effizient probieren. Eine naive Implementierung ist:P i P { 1 , . . . , K $N \times K$$P$$i$$P$$\{1, ..., K\}$

X = rep(0, N);
for(i in 1:N){
    X[i] = sample(1:K, 1, prob = P[i, ]);
}

Das ist viel zu langsam. Im Prinzip könnte ich dies nach C verschieben, aber ich bin mir sicher, dass es dafür einen bestehenden Weg geben muss. Ich möchte etwas im Sinne des folgenden Codes (der nicht funktioniert):

X = sample(1:K, N, replace = TRUE, prob = P)

EDIT: Zur Motivation nimm und . Ich habe Matrizen alle und ich muss von jedem einen Vektor abtasten.K = 100 P 1 , . . . , P 5000 N × $N = 10000$$K = 100$$P_1, ..., P_{5000}$$N \times K$

Wir können dies auf ein paar einfache Arten tun . Der erste ist einfach zu codieren, leicht zu verstehen und relativ schnell. Die zweite ist etwas kniffliger, aber für diese Problemgröße viel effizienter als die erste Methode oder andere hier erwähnte Ansätze.

Methode 1 : Schnell und schmutzig.

Um eine einzelne Beobachtung aus der Wahrscheinlichkeitsverteilung jeder Zeile zu erhalten, können wir einfach Folgendes tun.

# Q is the cumulative distribution of each row.
Q <- t(apply(P,1,cumsum))

# Get a sample with one observation from the distribution of each row.
X <- rowSums(runif(N) > Q) + 1

$P$ $P$$Q$$P$

$n$

# Returns an N x n matrix
X <- replicate(n, rowSums(runif(N) > Q)+1)

Dies ist im Allgemeinen keine äußerst effiziente Methode, um dies zu tun, nutzt jedoch die RVektorisierungsfunktionen, die normalerweise die Hauptdeterminante für die Ausführungsgeschwindigkeit sind. Es ist auch einfach zu verstehen.

Methode 2 : Verketten der cdfs.

$[0,N]$

Hier ist der Code.

i <- 0:(N-1)

# Cumulative function of the cdfs of each row of P.
Q <- cumsum(t(P))

# Find the interval and then back adjust
findInterval(runif(N)+i, Q)-i*K+1

$(0,1), (1,2), \dots, (N-1,N)$findIntervalrunif(N)+i$K$$K+1$$2K$$P$$\{1,\ldots,K\}$

Da findIntervaldiese Methode sowohl algorithmisch als auch implementierungsmäßig schnell ist, erweist sie sich als äußerst effizient.

Ein Maßstab

$N = 10000$$K = 100$$N$

Die Ausführung des Codes für Methode 1 dauerte fast genau 15 Minuten oder etwa 55.000 zufällige Variationen pro Sekunde. Die Ausführung des Codes für Methode 2 dauerte ungefähr viereinhalb Minuten , oder ungefähr 183.000 zufällige Variationen pro Sekunde.

$Q$

# Benchmark code
N <- 10000
K <- 100

set.seed(17)
P <- matrix(runif(N*K),N,K)
P <- P / rowSums(P)

method.one <- function(P)
{
    Q <- t(apply(P,1,cumsum))
    X <- rowSums(runif(nrow(P)) > Q) + 1
}

method.two <- function(P)
{
    n <- nrow(P)
    i <- 0:(n-1)
    Q <- cumsum(t(P))
    findInterval(runif(n)+i, Q)-i*ncol(P)+1
}

Hier ist die Ausgabe.

# Method 1: Timing
> system.time(replicate(5e3, method.one(P)))
   user  system elapsed 
691.693 195.812 899.246 

# Method 2: Timing
> system.time(replicate(5e3, method.two(P)))
   user  system elapsed 
182.325  82.430 273.021 

Nachtrag : Wenn findIntervalwir uns den Code ansehen, können wir feststellen, dass die Eingabe überprüft wird, ob NAEinträge vorhanden sind oder ob das zweite Argument nicht sortiert ist. Wenn wir also mehr Leistung daraus ziehen möchten, könnten wir unsere eigene modifizierte Version erstellen findInterval, die diese in unserem Fall unnötigen Überprüfungen entfernt.

Eine forSchleife kann furchtbar langsam sein R. Wie wäre es mit dieser einfachen Vektorisierung mit sapply?

n <- 10000
k <- 200

S <- 1:k
p <- matrix(rep(1 / k, n * k), nrow = n, ncol = k)
x <- numeric(n)

x <- sapply(1:n, function(i) sample(S, 1, prob = p[i,]))

Natürlich dient dieses einheitliche p nur zum Testen.