Chỉ định số lượng giá trị cụ thể được thông báo bằng phân phối xác suất (trong R)

Question

Xin chào và cảm ơn trước sự giúp đỡ!

Tôi đang cố gắng tạo một vectơ có số giá trị cụ thể được chỉ định theo phân bố xác suất. Ví dụ, tôi muốn một vector có chiều dài 31, chứa 26 số không và 5 số. (Tổng số tiền của véc tơ phải luôn luôn là năm.) Tuy nhiên, vị trí của vectơ là quan trọng. Và để xác định giá trị nên là một và cần được không, tôi có một vector của xác suất (chiều dài 31), mà trông như thế này:

probs<-c(0.01,0.02,0.01,0.02,0.01,0.01,0.01,0.04,0.01,0.01,0.12,0.01,0.02,0.01, 
0.14,0.06,0.01,0.01,0.01,0.01,0.01,0.14,0.01,0.07,0.01,0.01,0.04,0.08,0.01,0.02,0.01) 

tôi có thể chọn các giá trị theo phân phối này và nhận được một vector của chiều dài 31 sử dụng rbinom, nhưng tôi không thể chọn chính xác năm giá trị.

Inv=rbinom(length(probs),1,probs) 
Inv 
[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 

Bất kỳ ý tưởng nào?

Cảm ơn bạn lần nữa!

Answer 1

Làm thế nào để chỉ sử dụng trọng số sample.int để chọn vị trí?

Inv<-integer(31) 
Inv[sample.int(31,5,prob=probs)]<-1 
Inv 
[1] 0 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 

Answer 2

Tôi nghĩ bạn muốn lấy mẫu lại từ bản phân phối nhị thức với một tập xác suất cho trước cho đến khi bạn đạt giá trị mục tiêu là 5, đúng không? Nếu vậy, thì tôi nghĩ điều này làm những gì bạn muốn. Một vòng lặp while có thể được sử dụng để lặp lại cho đến khi điều kiện được đáp ứng. Nếu bạn ăn probabilites rất không thực tế và giá trị mục tiêu, tôi đoán nó có thể biến thành một hàm run-đi, nên xem xét cho mình cảnh báo :)

FOO <- function(probs, target) { 
    out <- rbinom(length(probs), 1, probs) 

    while (sum(out) != target) { 

    out <- rbinom(length(probs), 1, probs) 
    } 
    return(out) 
} 

FOO (probs, target = 5)

> FOO(probs, target = 5) 
[1] 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 

Answer 3

Chase cung cấp một câu trả lời tuyệt vời và đề cập đến vấn đề của việc lặp đi lặp lại while(). Một trong những vấn đề với việc chạy trốn while() là nếu bạn thực hiện một lần thử này tại một thời điểm và phải mất rất nhiều, giả sử t, các thử nghiệm để tìm một kết quả phù hợp với số mục tiêu là 1 s, bạn phải chịu chi phí t cuộc gọi đến chức năng chính, rbinom() trong trường hợp này.

Có một lối thoát, tuy nhiên, vì rbinom(), giống như tất cả trong số này (giả) máy phát điện số ngẫu nhiên trong R, được vectorised, chúng ta có thể tạo ra m thử nghiệm tại một thời điểm và kiểm tra những m thử nghiệm cho phù hợp theo yêu cầu của 5 1 s. Nếu không tìm thấy chúng tôi, chúng tôi sẽ liên tục vẽ m bản dùng thử cho đến khi chúng tôi tìm thấy bản dùng thử phù hợp. Ý tưởng này được thực hiện trong hàm foo() bên dưới. Đối số chunkSize là m, số lần thử để vẽ tại một thời điểm. Tôi cũng đã tận dụng cơ hội này để cho phép hàm tìm kiếm nhiều hơn một thử nghiệm duy nhất; đối số n kiểm soát số lượng thử nghiệm phù hợp để trả lại.

foo <- function(probs, target, n = 1, chunkSize = 100) { 
    len <- length(probs) 
    out <- matrix(ncol = len, nrow = 0) ## return object 
    ## draw chunkSize trials 
    trial <- matrix(rbinom(len * chunkSize, 1, probs), 
        ncol = len, byrow = TRUE) 
    rs <- rowSums(trial) ## How manys `1`s 
    ok <- which(rs == 5L) ## which meet the `target` 
    found <- length(ok) ## how many meet the target 
    if(found > 0)   ## if we found some, add them to out 
     out <- rbind(out, 
        trial[ok, , drop = FALSE][seq_len(min(n,found)), , 
               drop = FALSE]) 
    ## if we haven't found enough, repeat the whole thing until we do 
    while(found < n) { 
     trial <- matrix(rbinom(len * chunkSize, 1, probs), 
          ncol = len, byrow = TRUE) 
     rs <- rowSums(trial) 
     ok <- which(rs == 5L) 
     New <- length(ok) 
     if(New > 0) { 
      found <- found + New 
      out <- rbind(out, trial[ok, , drop = FALSE][seq_len(min(n, New)), , 
                 drop = FALSE]) 
     } 
    } 
    if(n == 1L)   ## comment this, and 
     out <- drop(out) ## this if you don't want dimension dropping 
    out 
} 

Nó hoạt động như thế này:

> set.seed(1) 
> foo(probs, target = 5) 
[1] 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 
[31] 0 
> foo(probs, target = 5, n = 2) 
    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] 
[1,] 0 0 0 0 0 0 0 0 0  0  0 
[2,] 0 0 0 0 0 0 0 0 0  0  1 
    [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] 
[1,]  0  0  0  1  1  0  0  0  0  0 
[2,]  0  1  0  0  1  0  0  0  0  0 
    [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30] [,31] 
[1,]  1  0  1  0  0  0  1  0  0  0 
[2,]  1  0  1  0  0  0  0  0  0  0 

Lưu ý rằng tôi thả kích thước trống trong trường hợp n == 1. Hãy chú ý đoạn mã if cuối cùng nếu bạn không muốn tính năng này.

Bạn cần cân bằng kích thước chunkSize với gánh nặng tính toán khi kiểm tra nhiều lần thử nghiệm tại một thời điểm.Nếu yêu cầu (ở đây 5 1 s) là rất khó xảy ra, sau đó tăng chunkSize để bạn phải thực hiện các cuộc gọi ít hơn đến rbinom(). Nếu có yêu cầu, có ít thử nghiệm vẽ điểm và lớn chunkSize tại một thời điểm nếu bạn chỉ muốn một hoặc hai khi bạn phải đánh giá mỗi lần rút thăm thử.