Làm cách nào để lấy mẫu từ cho biến ngẫu nhiên, mỗi biến có các hàm khối lượng khác nhau, trong R?

Trong R, tôi có một $N \times K$ ma trận $P$ nơi $i$ 'th dãy $P$ tương ứng với một phân phối trên $\{1, ..., K\}$ . Về cơ bản, tôi cần lấy mẫu từ mỗi hàng một cách hiệu quả. Một thực hiện ngây thơ là:

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

Điều này là quá chậm. Về nguyên tắc tôi có thể chuyển cái này sang C nhưng tôi chắc chắn phải có một cách hiện có để làm việc này. Tôi muốn một cái gì đó theo tinh thần của mã sau đây (không hoạt động):

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

EDIT: Để có động lực, lấy $N = 10000$ và $K = 100$ . Tôi có ma trận $P_1, ..., P_{5000}$ tất cả $N \times K$ và tôi cần lấy mẫu một vectơ từ mỗi ma trận .

Chúng ta có thể làm điều này theo một vài cách đơn giản . Đầu tiên là dễ viết mã, dễ hiểu và nhanh chóng hợp lý. Thứ hai là một phức tạp hơn chút, nhưng nhiều hiệu quả hơn đối với kích thước của vấn đề này so với phương pháp đầu tiên hoặc các phương pháp khác được đề cập ở đây.

Cách 1 : Nhanh và bẩn.

Để có được một quan sát duy nhất từ ​​phân phối xác suất của mỗi hàng, chúng ta chỉ cần làm như sau.

# 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

Điều này tạo ra phân phối tích lũy của từng hàng và sau đó lấy mẫu một quan sát từ mỗi phân phối. Lưu ý rằng nếu chúng ta có thể sử dụng lại thì chúng ta có thể tính một lần và lưu trữ để sử dụng sau. Tuy nhiên, câu hỏi cần một cái gì đó hoạt động cho một khác nhau ở mỗi lần lặp.P Q $P$ $P$$Q$$P$

Nếu bạn cần nhiều ( ) quan sát từ mỗi hàng, sau đó thay thế dòng cuối cùng bằng hàng sau.$n$

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

Điều này thực sự không phải là một cách cực kỳ hiệu quả nói chung để làm điều này, nhưng nó không tận dụng tốt Rkhả năng vector hóa, mà thường là yếu tố chính của tốc độ thực hiện. Nó cũng đơn giản để hiểu.

Cách 2 : Ghép các cdf.

Giả sử chúng ta có một hàm lấy hai vectơ, vectơ thứ hai được sắp xếp theo thứ tự không tăng đơn điệu và tìm thấy chỉ số trong vectơ thứ hai của giới hạn dưới lớn nhất của mỗi phần tử trong phần tử thứ nhất. Sau đó, chúng ta có thể sử dụng hàm này và một mẹo nhỏ: Chỉ cần tạo tổng tích lũy của các cdf của tất cả các hàng. Điều này mang lại một vectơ tăng đơn điệu với các phần tử trong phạm vi .$[0,N]$

Đây là mã.

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

Lưu ý dòng cuối cùng làm gì, nó tạo ra các biến ngẫu nhiên được phân phối trong và sau đó gọi để tìm chỉ số của giới hạn dưới lớn nhất của mỗi mục . Vì vậy, điều này cho chúng ta biết rằng phần tử đầu tiên sẽ được tìm thấy giữa chỉ số 1 và chỉ số , phần tử thứ hai sẽ được tìm thấy giữa chỉ số và , v.v., mỗi phần theo phân phối của hàng tương ứng . Sau đó, chúng ta cần quay lại biến đổi để đưa từng chỉ số trở lại trong phạm vi .K K + 1 2 K P { 1 , Rời , K $(0,1), (1,2), \dots, (N-1,N)$findIntervalrunif(N)+i$K$$K+1$$2K$$P$$\{1,\ldots,K\}$

Vì findIntervalnhanh về cả thuật toán và triển khai, nên phương pháp này cực kỳ hiệu quả.

Điểm chuẩn

Trên máy tính xách tay cũ của tôi (MacBook Pro, 2,66 GHz, RAM 8GB), tôi đã thử điều này với và và tạo 5000 mẫu có kích thước , chính xác như được đề xuất trong câu hỏi cập nhật, với tổng số 50 triệu biến thể ngẫu nhiên .$N = 10000$$K = 100$$N$

Mã cho Phương pháp 1 mất gần 15 phút để thực thi hoặc khoảng 55K biến thiên ngẫu nhiên mỗi giây. Mã cho Phương pháp 2 mất khoảng bốn phút rưỡi để thực thi, hoặc khoảng 183K biến thiên ngẫu nhiên mỗi giây.

Đây là mã cho mục đích tái sản xuất. (Lưu ý rằng, như được chỉ ra trong một nhận xét, được tính toán lại cho mỗi trong số 5000 lần lặp để mô phỏng tình huống của OP.)$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
}

Đây là đầu ra.

# 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 

Postcript : Bằng cách nhìn vào mã cho findInterval, chúng ta có thể thấy rằng nó thực hiện một số kiểm tra trên đầu vào để xem nếu có NAmục hoặc nếu đối số thứ hai không được sắp xếp. Do đó, nếu chúng tôi muốn đạt được hiệu suất cao hơn trong số này, chúng tôi có thể tạo phiên bản sửa đổi của riêng mình findIntervalđể loại bỏ các kiểm tra không cần thiết trong trường hợp của chúng tôi.

Một forvòng lặp có thể rất chậm trong R. Làm thế nào về vector hóa đơn giản này với 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,]))

Tất nhiên, p đồng phục này chỉ để thử nghiệm.