コンティンジェンシーテーブルからのサンプリング

Question

私は以下のコードまで、コンティンジェンシーテーブルからサンプルする関数を書いています。これはセルの周波数に比例しています。

expand.gridを使用してからtableを使用して元のサイズの表に戻します。サンプルのサイズが大きすぎて、一部のカテゴリが完全に欠落していない限り、正常に動作します。そうでなければ、tableコマンドは、元のものよりも小さな寸法のテーブルを返します。

FunSample<- function(Full, n) { 
    Frame <- expand.grid(lapply(dim(Full), seq)) 
    table(Frame[sample(1:nrow(Frame), n, prob = Full, replace = TRUE), ]) 
} 
Full<-array(c(1,2,3,4), dim=c(2,2,2)) 
FunSample(Full, 100) # OK 
FunSample(Full, 1) # not OK, I want it to still have dim=c(2,2,2)! 

私の脳は機能しなくなった、私はそれが軌道に戻ってそれを得るために小さな微調整でなければならないことを知っている！

Answer 1

クロス集計も多項分布であるので、あなたはrmultinomを使用し、出力に次元をリセットすることができます。これにより、パフォーマンスを大幅に向上させ、保守が必要なコードを削減することができます。

> X <- rmultinom(1, 500, Full) 
> dim(X) <- dim(Full) 
> X 
, , 1 

    [,1] [,2] 
[1,] 18 92 
[2,] 45 92 

, , 2 

    [,1] [,2] 
[1,] 28 72 
[2,] 49 104 

> X2 <-rmultinom(1, 4, Full) 
> dim(X2) <- dim(Full) 
> X2 
, , 1 

    [,1] [,2] 
[1,] 0 1 
[2,] 0 0 

, , 2 

    [,1] [,2] 
[1,] 0 1 
[2,] 1 1 

Answer 2

あなたはtable()が見つからない組み合わせを「ドロップ」したくない場合は、あなたが要因であることをFrameの列を強制する必要があります。

FunSample <- function(Full, n) { 
    Frame <- as.data.frame(lapply(expand.grid(lapply(dim(Full), seq)), factor)) 
    table(Frame[sample(1:nrow(Frame), n, prob = Full, replace = TRUE), ]) 
} 

> dim(FunSample(Full, 1)) 
[1] 2 2 2 
> dim(FunSample(Full, 100)) 
[1] 2 2 2 

Answer 3

あなたはtabulate代わりのtableを使用することができます。整数値のベクトルに作用します。元のデータを作成したときとまったく同じように、arrayを直接使用して出力を配列に取得することもできます。

FunSample<- function(Full, n) { 
    samp <- sample(1:length(Full), n, prob = Full, replace = TRUE) 
    array(tabulate(samp), dim=dim(Full)) 
}