1

次のコードを検討してください。

require(Hmisc)
num.boots <- 10
data <- rchisq(500, df = 5) #generate fake data

#create bins
binx <- cut(data, breaks = 10)
binx <- levels(binx)
binx <- sub("^.*\\,", "", binx)
binx <- as.numeric(substr(binx, 1, nchar(binx) - 1))

#pre-allocate a matrix to be filled with samples
output <- matrix(NA, nrow = num.boots, ncol = length(binx)) 

#do random sampling from the vector and calculate percent
# of values equal or smaller to the bin number (i)
for (i in 1:num.boots) {
    walk.pair.sample <- sample(data, size = length(data), replace = TRUE)
    data.cut <- cut2(x = walk.pair.sample, cuts = binx)
    data.cut <- table(data.cut)/sum(table(data.cut))
    output[i, ] <- data.cut
}

#do some plotting
plot(1:10, seq(0, max(output), length.out = nrow(output)), type = "n", xlab = "", ylab = "")

for (i in 1:nrow(output)) {
    lines(1:10, output[i, 1:nrow(output)])
}

#mean values by columns
output.mean <- apply(output, 2, mean)
lines(output.mean, col="red", lwd = 3)
legend(x = 8, y = 0.25, legend = "mean", col = "red", lty = "solid", lwd = 3)

boot：boot（）関数に、出力として長さn> 1のベクトルを持つ関数を提供できるかどうか疑問に思っていましたか？それは可能ですか？

これが私の弱い試みですが、私は何か間違ったことをしているに違いありません。

require(boot)
bootstrapDistances <- function(data, binx) {
    data.cut <- cut2(x = data, cuts = binx)
    data.cut <- table(data.cut)/sum(table(data.cut))
    return(data.cut)
}

> x <- boot(data = data, statistic = bootstrapDistances, R = 100)
Error in cut.default(x, k2) : 'breaks' are not unique

Hmisc::cut2()呼び出しで正しく機能しない理由はよくわかりませんが、ループboot()で呼び出すと機能します（上記のコードを参照）。for()私のbootstrapDistances()関数のロジックはで実行可能boot()ですか？どんなポインタでも大歓迎です。

。：編集：。

アニコは、インデックスを含めるように関数を変更することを提案しました。boot（）のドキュメントを読んでいる間、これがどのように機能するかがわかりませんでした。これが、関数が機能しない理由を説明しています。アニコが提案した新機能は次のとおりです。

bootstrapDistances2 <- function(data, idx, binx) { 
  data.cut <- cut2(x = data[idx], cuts = binx) 
  data.cut <- table(data.cut)/sum(table(data.cut)) 
  return(data.cut) 
}

しかし、なんとかエラーが発生し、それを削除する方法をまだ検討中です。

> x <- boot(data = data, statistic = bootstrapDistances2, R = 100, binx = binx)
Error in t.star[r, ] <- statistic(data, i[r, ], ...) : 
  number of items to replace is not a multiple of replacement length

Rセッションを再開した後（別のバージョン2.10.1も試しました）、正常に動作しているようです。

4

2 に答える 2

2

関数のヘルプファイルからboot：

その他のすべての場合、statistic は少なくとも 2 つの引数を取る必要があります。渡される最初の引数は、常に元のデータになります。2 番目は、ブートストラップ サンプルを定義するインデックス、頻度、または重みのベクトルになります。

bootstrapDistancesそのため、データのどの要素が選択されているかを関数に伝える2 番目のパラメーターを関数に追加する必要があります。

bootstrapDistances2 <- function(data, idx, binx) { 
  data.cut <- cut2(x = data[idx], cuts = binx) 
  data.cut <- table(data.cut)/sum(table(data.cut)) 
  return(data.cut) 
}

そして結果：

x <- boot(data = data, statistic = bootstrapDistances2, R = 100, binx=binx)
x

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = data, statistic = bootstrapDistances2, R = 100, binx = binx)


Bootstrap Statistics :
     original   bias    std. error
t1*     0.208  0.00134 0.017342783
t2*     0.322  0.00062 0.021700803
t3*     0.190 -0.00034 0.018873433
t4*     0.136 -0.00116 0.016206197
t5*     0.078 -0.00120 0.011413265
t6*     0.036  0.00070 0.008510837
t7*     0.016  0.00074 0.005816417
t8*     0.006  0.00024 0.003654581
t9*     0.000  0.00000 0.000000000
t10*    0.008 -0.00094 0.003368961
于 2010-07-28T21:07:22.270 に答える
0

良い答え、アニコ。

また、「ブート」のヘルプ ページには、ブートストラップ統計関数が単なるスカラーではなくベクトルを返す可能性があると記載されています。

于 2010-07-28T21:17:09.887 に答える