確率分布によって通知される特定の数の値を割り当てる（R）

Question

こんにちは、ありがとうございました！

確率分布に従って割り当てられた特定の数の値を持つベクトルを生成しようとしています。たとえば、長さ31のベクトルが必要です.26個のゼロと5個のベクトルが含まれています。 （ベクトルの総和は常に5でなければなりません）。しかし、それらの位置は重要です。

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) 

私はこの分布に応じて値を選択してのベクトルを得ることができます。そして、もう一つあるべきであり、そしてゼロたのであるべき値、私はこのようになります確率のベクトル（長さ31）を、持っている識別するために長さはrbinomを使って31ですが、ちょうど5つの値を選択することはできません。

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 

もう一度おねがいします！

Answer 1

重み付けされたを使用して位置を選択するのはどうですか？

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

私はあなたが目標値5に達するまで、与えられた確率のセットを使って二項分布から再サンプリングしたいと思います、そうですか？もしそうなら、これはあなたが望むことをすると思います。 whileループを使用して、条件が満たされるまで反復することができます。あなたは非常に非現実的probabilitesと目標値を供給した場合、私はそれは自分が警告して暴走機能に変わり、そう考えることができると思います:)

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

    while (sum(out) != target) { 

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

FOO（ちゃったごめんなさい、ターゲット= 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

チェースは偉大な答えを提供し、逃げ道while()反復の問題について言及しています。逃げ道の問題の1つwhile()の問題の1つは、一度に1つの試行を行い、多くの場合、たとえばとなり、試行でターゲット番号1に合致する試行が見つかると、オーバーヘッドが発生します。 は、この場合はrbinom()です。

rbinom()は、Rにおけるこれらの全ての（擬似）乱数生成器のように、ベクトル化され、我々は一度にメートルトライアルを生成し、適合性のものメートルトライアルを確認することができますので、アウトの方法は、しかし、があります5 1の要件に従う。何も見つからない場合、我々は一致するものを見つけるまで繰り返しmの試行を行う。この考え方は、以下の関数foo()に実装されています。 chunkSize引数は、一度に描画する試行の回数であるmです。私はまた、機能が複数の適合試験を見つけることを可能にする機会を得ました。引数nは、返す適合試験数を制御します。

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 == 1場合には空の次元を落とし

> 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 

注意。この機能が必要ない場合は、最後のifコードチャンクをコメントアウトしてください。

chunkSizeのサイズと、一度に多くの試行を確認する計算上の負担とのバランスをとる必要があります。要件（ここでは5 1s）が非常に低い場合は、への呼び出しが少なくなるように、chunkSizeを増やしてください。要件がある可能性が高い場合は、ポイントドローイングトライアルはほとんどなく、chunkSizeは1回または2回だけ試行してください。