1

次のデータフレームがあります

ddd<-data.frame(minutes=1:15,positive=c(0,1,0,1,1,0,1,0,0,0,1,1,1,0,1))

サンプリングを使用して、 jの長さの ddd$ 分の連続した間隔からサンプリングするk回の試行で、少なくとも 1 つが現れる確率を見つけたいと思います。たとえば、j=2 (2 分間隔) の場合、サンプル空間は になります 。ただし、最初の k 回の試行で間隔がサンプリングされた場合 (1 回の成功)、 2 つのグループが交差する (両方に存在する) ため、間隔は (次のランダム サンプリングの前に) サンプリングされた空間から削除されます。ddd$positiveddd$minutes[1:2, 2:3, 3:4, 4:5, 5:6, 6:7, …:14:15]ddd$minutes[1:2]ddd$minutes[2:3]ddd$minutes[2]

サンプリングされたグループだけでなく、既にサンプリングされたグループと交差するすべてのグループも、次のサンプリングが行われる前にサンプル空間から削除される必要があるため、これは置換なしの単純なサンプリングの問題ではありません。

EDIT（Tim Pからのコメント）：length(ddd$minutes)1000〜1200の間のどこかになります。kは 1 から 16の間です。 jは 1 から 30 の間です。

EDIT2 (ティエリーのコメント)

ティエリーのコメントと回答に従って、例を挙げています

ddd<-data.frame(minutes=1:15,positive=c(0,1,0,1,1,0,1,0,0,0,1,1,1,0,1)) 
l=3;k=3

サンプル空間 S0 (最初のサンプリング前): S0:{1:3, 2:4, 3:5, 4:6, 5:7, 6:8, 7:9, 8:10, 9:11, 10 :12, 11:13, 12:14, 13:15} S0 の長さは 13 (n-k+1)

k からの最初の試行: 要素 8:10 が選択されます。

次に、S1 は S0 として再定義されますが、サンプリングされた要素 8:10 と交差する要素 6:8、7:9、8:10、9:11、10:12 はありません。

したがって、S1 は次のとおりです。{ 1:3、2:4、3:5、4:6、5:7、11:13、12:14、13:15}

k のうちの 2 回目の試行: 要素 4:6 が選択されます

S2 は、要素 2:4、3:5、4:6、5:7 を除いて S1 として再定義されます。

S2:{1:3, 11:13, 12:14, 13:15}

*k* 番目のサンプルまで続きます。最終的に私の目標は、この種のサンプリングを何度も実行して、少なくとも 1 つの ddd$success が表示される確率を確認することです。

4

2 に答える 2

1

再帰関数を使用できます。

n <- 1000
j <- 10
set.seed(12345)
ddd <- data.frame(minutes=seq_len(n), positive = rbinom(n, 1, 0.1))
dataset <- ddd
k <- 16
sillySampling <- function(dataset, k, j){
  i <- sample(nrow(dataset) - j + 1, 1)
  thisSample <- max(dataset$positive[i - 1 + seq_len(j)])
  if(k > 1){
    toRemove <- i + -j:j
    toRemove <- toRemove[toRemove >= 1 & toRemove <= nrow(dataset)]
    thisSample <- c(thisSample, sillySampling(dataset[-toRemove, ], k  = k - 1, j = j))
  }
  return(thisSample)
}
rowMeans(replicate(100, {
  sapply(1:16, function(k){
    sum(sillySampling(ddd, k, 10)) / k
  })
}))
于 2012-06-13T09:35:25.277 に答える
0

データセットを k 分のサンプルに集約したいと思います。次に、集約されたデータセットをサンプリングします。あなたの種類のサンプリングから、さらにどのような情報が期待できますか? サンプリングの方法は、より多くのデータを破棄します。

n <- 1000
j <- 10
set.seed(12345)
ddd <- data.frame(minutes=seq_len(n), positive = rbinom(n, 1, 0.1))
ddd$group <- ddd$minutes %/% j
AGR <- aggregate(ddd$positive, by = ddd[, "group", drop = FALSE], FUN = max)
rowMeans(replicate(1000, {
    sapply(1:16, function(k){
        sum(sample(AGR$x, k, replace = FALSE)) / k
    })
}))
于 2012-06-12T10:52:35.610 に答える