Cách hiệu quả để lấy mẫu từ các vector xác suất khác nhau

Question

Tôi đang tìm một cách hiệu quả hơn để lấy mẫu từ danh sách các số nguyên 1: n, nhiều lần, trong đó vector xác suất (cũng dài n) khác nhau mỗi lần. Đối với 20 thử nghiệm với n = 10, tôi biết người ta có thể làm điều đó như thế này:

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

Nhưng mà các cuộc gọi mẫu 10 lần chỉ để có được một số duy nhất mỗi lần, vì vậy nó là có lẽ không phải là cách nhanh nhất. Tốc độ sẽ hữu ích vì mã sẽ thực hiện điều này nhiều lần.

Rất cám ơn!

Luke

Chỉnh sửa: Cảm ơn Roman, ý tưởng về điểm chuẩn đã giúp tôi tìm ra giải pháp tốt. Bây giờ tôi đã chuyển câu trả lời này.

Answer 1

Chỉ để cho vui, tôi đã thử hai phiên bản nữa. Bạn lấy mẫu này ở quy mô nào? Tôi nghĩ rằng tất cả những điều này là khá nhanh và ít nhiều tương đương (tôi chưa bao gồm việc tạo ra các probs cho giải pháp của bạn). Rất thích nhìn thấy người khác chụp ảnh này.

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

Đây là một cách tiếp cận khác mà tôi đã tìm thấy. Nó nhanh, nhưng không nhanh như chỉ đơn giản gọi mẫu nhiều lần với vòng lặp for. Ban đầu tôi nghĩ rằng nó là rất tốt, nhưng tôi đã sử dụng chuẩn() không chính xác.

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

Dưới đây là cách hoạt động: hình ảnh các xác suất như dòng có độ dài khác nhau đặt ra trên một dòng số từ 0 đến 1. Xác suất lớn sẽ mất nhiều hơn của dòng số so với những cái nhỏ. Sau đó bạn có thể chọn kết quả bằng cách chọn một điểm ngẫu nhiên trên dòng số - xác suất lớn sẽ có nhiều khả năng được chọn. Ưu điểm của phương pháp này là bạn có thể cuộn tất cả các số ngẫu nhiên cần thiết trong một cuộc gọi runif(), thay vì gọi mẫu lặp đi lặp lại như trong các hàm luke, roman và roman2. Tuy nhiên, có vẻ như việc xử lý dữ liệu bổ sung làm chậm nó xuống và chi phí nhiều hơn bù đắp lợi ích này.

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 

Vì lý do nào đó, hãy áp dụng() rất nặng khi bạn thêm nhiều hàng hơn. Tôi không hiểu tại sao, bởi vì tôi nghĩ rằng nó là một wrapper cho() và do đó roman() nên thực hiện tương tự như luke().