Rのブートストラップは実際にどのように機能しますか?


22

私はRのブートパッケージを調査してきましたが、その使用方法に関する多くの優れた入門書を見つけましたが、「舞台裏」で何が起こっているかを正確に説明するものはまだ見つけていません。たとえば、このでは、ガイドは標準の回帰係数をブートストラップ回帰の開始点として使用する方法を示していますが、ブートストラップ回帰係数を導出するためにブートストラップ手順が実際に何をしているのかについては説明しません。何らかの反復プロセスが行われているように見えますが、何が起こっているのかを正確に把握できないようです。


3
私が最後にそれを開いてから長い時間なので、あなたの質問に答えるかどうかはわかりませんが、ブートパッケージは特にDavison、AC、&Hinkley、DV(1997)で詳述されている方法に基づいています。ブートストラップメソッドとそのアプリケーション。ケンブリッジ:ケンブリッジ大学出版局。(参照は、ブートパッケージのヘルプファイルでも引用されています。)
ガラ

回答:


34

ブートストラップにはいくつかの「フレーバー」または形式があります(たとえば、ノンパラメトリック、パラメトリック、残留リサンプリングなど)。この例のブートストラップは、ノンパラメトリックブートストラップまたはケースリサンプリングと呼ばれます(回帰のアプリケーションについてこちらこちらこちらこちらおよびこちらをご覧ください)。基本的な考え方は、あなたが集団として、あなたのサンプルを処理し、繰り返し、そこから新しいサンプルを引き出すことにある交換に。元の観測値はすべて、新しいサンプルに引き込まれる確率が等しくなります。次に、対象の統計を計算して保存します。これは、新しく描画されたサンプルを使用して、平均、中央値、または回帰係数になる場合があります。これを回繰り返します。各反復では、元のサンプルからのいくつかの観測が複数回描画されますが、一部の観測はまったく描画されない場合があります。後回の反復、あなたがしているの関心の統計値(S)のブートストラップ推定値を格納し(例えばもしと関心の統計は平均である、あなたは平均1000のブートストラップ推定値を持っています)。最後に、ブートストラップ推定値の平均、中央値、標準偏差などの要約統計量が計算されます。nnnn=1000n

ブートストラップは次の目的でよく使用されます。

  1. 信頼区間の計算(および標準誤差の推定)
  2. ポイント推定値のバイアスの推定

ブートストラップサンプルに基づいて信頼区間を計算する方法いくつかあります(このペーパーでは説明とガイダンスを提供します)。95%信頼区間を計算するための非常に簡単な方法の1つは、ブートストラップサンプルの経験的な2.5パーセンタイルと97.5パーセンタイルを計算することです(このインターバルはブートストラップパーセンタイルインターバルと呼ばれます。以下のコードを参照)。バイアス修正および加速ブートストラップ(BCa)などのより良い方法があるため、単純なパーセンタイル間隔法は実際にはめったに使用されません。BCa間隔は、ブートストラップ分布のバイアスと歪度の両方を調整します。

バイアスは、単純平均との差として推定される格納されたブートストラップサンプルと元の見積もり(S)。n

ウェブサイトから例を複製してみましょう。ただし、上記で説明したアイデアを取り入れた独自のループを使用します(繰り返し描画します)。

#-----------------------------------------------------------------------------
# Load packages
#-----------------------------------------------------------------------------

require(ggplot2)
require(pscl)
require(MASS)
require(boot)

#-----------------------------------------------------------------------------
# Load data
#-----------------------------------------------------------------------------

zinb <- read.csv("http://www.ats.ucla.edu/stat/data/fish.csv")
zinb <- within(zinb, {
  nofish <- factor(nofish)
  livebait <- factor(livebait)
  camper <- factor(camper)
})

#-----------------------------------------------------------------------------
# Calculate zero-inflated regression
#-----------------------------------------------------------------------------

m1 <- zeroinfl(count ~ child + camper | persons, data = zinb,
               dist = "negbin", EM = TRUE)

#-----------------------------------------------------------------------------
# Store the original regression coefficients
#-----------------------------------------------------------------------------

original.estimates <- as.vector(t(do.call(rbind, coef(summary(m1)))[, 1:2]))

#-----------------------------------------------------------------------------
# Set the number of replications
#-----------------------------------------------------------------------------

n.sim <- 2000

#-----------------------------------------------------------------------------
# Set up a matrix to store the results
#-----------------------------------------------------------------------------

store.matrix <- matrix(NA, nrow=n.sim, ncol=12)

#-----------------------------------------------------------------------------
# The loop
#-----------------------------------------------------------------------------

set.seed(123)

for(i in 1:n.sim) {

  #-----------------------------------------------------------------------------
  # Draw the observations WITH replacement
  #-----------------------------------------------------------------------------

  data.new <- zinb[sample(1:dim(zinb)[1], dim(zinb)[1], replace=TRUE),]

  #-----------------------------------------------------------------------------
  # Calculate the model with this "new" data
  #-----------------------------------------------------------------------------

  m <- zeroinfl(count ~ child + camper | persons,
                data = data.new, dist = "negbin",
                start = list(count = c(1.3711, -1.5152, 0.879),
                             zero = c(1.6028, -1.6663)))

  #-----------------------------------------------------------------------------
  # Store the results
  #-----------------------------------------------------------------------------

  store.matrix[i, ] <- as.vector(t(do.call(rbind, coef(summary(m)))[, 1:2]))

}


#-----------------------------------------------------------------------------
# Save the means, medians and SDs of the bootstrapped statistics
#-----------------------------------------------------------------------------

boot.means <- colMeans(store.matrix, na.rm=T)

boot.medians <- apply(store.matrix,2,median, na.rm=T)

boot.sds <- apply(store.matrix,2,sd, na.rm=T)

#-----------------------------------------------------------------------------
# The bootstrap bias is the difference between the mean bootstrap estimates
# and the original estimates
#-----------------------------------------------------------------------------

boot.bias <- colMeans(store.matrix, na.rm=T) - original.estimates

#-----------------------------------------------------------------------------
# Basic bootstrap CIs based on the empirical quantiles
#-----------------------------------------------------------------------------

conf.mat <- matrix(apply(store.matrix, 2 ,quantile, c(0.025, 0.975), na.rm=T),
ncol=2, byrow=TRUE)
colnames(conf.mat) <- c("95%-CI Lower", "95%-CI Upper")

そして、ここに要約表があります:

#-----------------------------------------------------------------------------
# Set up summary data frame
#-----------------------------------------------------------------------------

summary.frame <- data.frame(mean=boot.means, median=boot.medians,
sd=boot.sds, bias=boot.bias, "CI_lower"=conf.mat[,1], "CI_upper"=conf.mat[,2])

summary.frame

      mean  median       sd       bias CI_lower CI_upper
1   1.2998  1.3013  0.39674 -0.0712912  0.51960   2.0605
2   0.2527  0.2486  0.03208 -0.0034461  0.19898   0.3229
3  -1.5662 -1.5572  0.26220 -0.0509239 -2.12900  -1.0920
4   0.2005  0.1986  0.01949  0.0049019  0.16744   0.2418
5   0.9544  0.9252  0.48915  0.0753405  0.03493   1.9025
6   0.2702  0.2688  0.02043  0.0009583  0.23272   0.3137
7  -0.8997 -0.9082  0.22174  0.0856793 -1.30664  -0.4380
8   0.1789  0.1781  0.01667  0.0029513  0.14494   0.2140
9   2.0683  1.7719  1.59102  0.4654898  0.44150   8.0471
10  4.0209  0.8270 13.23434  3.1845710  0.58114  57.6417
11 -2.0969 -1.6717  1.56311 -0.4306844 -8.43440  -1.1156
12  3.8660  0.6435 13.27525  3.1870642  0.33631  57.6062

いくつかの説明

  • ブートストラップ推定値の平均と元の推定値の差は、出力の「バイアス」と呼ばれるものです boot
  • boot「標準誤差」と呼ばれる出力は、ブートストラップされた推定値の標準偏差です

次の出力と比較してくださいboot

#-----------------------------------------------------------------------------
# Compare with boot output and confidence intervals
#-----------------------------------------------------------------------------

set.seed(10)
res <- boot(zinb, f, R = 2000, parallel = "snow", ncpus = 4)

res

Bootstrap Statistics :
       original       bias    std. error
t1*   1.3710504 -0.076735010  0.39842905
t2*   0.2561136 -0.003127401  0.03172301
t3*  -1.5152609 -0.064110745  0.26554358
t4*   0.1955916  0.005819378  0.01933571
t5*   0.8790522  0.083866901  0.49476780
t6*   0.2692734  0.001475496  0.01957823
t7*  -0.9853566  0.083186595  0.22384444
t8*   0.1759504  0.002507872  0.01648298
t9*   1.6031354  0.482973831  1.58603356
t10*  0.8365225  3.240981223 13.86307093
t11* -1.6665917 -0.453059768  1.55143344
t12*  0.6793077  3.247826469 13.90167954

perc.cis <- matrix(NA, nrow=dim(res$t)[2], ncol=2)
    for( i in 1:dim(res$t)[2] ) {
  perc.cis[i,] <- boot.ci(res, conf=0.95, type="perc", index=i)$percent[4:5] 
}
colnames(perc.cis) <- c("95%-CI Lower", "95%-CI Upper")

perc.cis 

      95%-CI Lower 95%-CI Upper
 [1,]      0.52240       2.1035
 [2,]      0.19984       0.3220
 [3,]     -2.12820      -1.1012
 [4,]      0.16754       0.2430
 [5,]      0.04817       1.9084
 [6,]      0.23401       0.3124
 [7,]     -1.29964      -0.4314
 [8,]      0.14517       0.2149
 [9,]      0.29993       8.0463
[10,]      0.57248      56.6710
[11,]     -8.64798      -1.1088
[12,]      0.33048      56.6702

#-----------------------------------------------------------------------------
# Our summary table
#-----------------------------------------------------------------------------

summary.frame

      mean  median       sd       bias CI_lower CI_upper
1   1.2998  1.3013  0.39674 -0.0712912  0.51960   2.0605
2   0.2527  0.2486  0.03208 -0.0034461  0.19898   0.3229
3  -1.5662 -1.5572  0.26220 -0.0509239 -2.12900  -1.0920
4   0.2005  0.1986  0.01949  0.0049019  0.16744   0.2418
5   0.9544  0.9252  0.48915  0.0753405  0.03493   1.9025
6   0.2702  0.2688  0.02043  0.0009583  0.23272   0.3137
7  -0.8997 -0.9082  0.22174  0.0856793 -1.30664  -0.4380
8   0.1789  0.1781  0.01667  0.0029513  0.14494   0.2140
9   2.0683  1.7719  1.59102  0.4654898  0.44150   8.0471
10  4.0209  0.8270 13.23434  3.1845710  0.58114  57.6417
11 -2.0969 -1.6717  1.56311 -0.4306844 -8.43440  -1.1156
12  3.8660  0.6435 13.27525  3.1870642  0.33631  57.6062

「bias」列と「std。error」を独自のサマリー表の「sd」列と比較します。95%の信頼区間はboot.ci、パーセンタイル法を使用して計算された信頼区間と非常に似ています(ただし、すべてではありません:インデックス9のパラメーターの下限を見てください)。


詳細な返信をありがとう。基本的に、係数は生成された2000セットの係数の平均であると言っていますか?
-zgall1

4
t

「基本的な考え方は、サンプルを母集団として扱い、それから新しいサンプルを繰り返し置き換えて描画することです」-新しいサンプルのサイズを判断する方法は?
シヌクス

1
@Sinusx通常、元のサンプルと同じサイズのサンプルを描画します。重要なアイデアは、サンプルを交換して描画することです。そのため、元のサンプルの一部の値は複数回描画され、一部の値はまったく描画されません。
COOLSerdash

6

boot「統計」パラメーターとして渡される関数に焦点を当て、その構築方法に注意する必要があります。

f <- function(data, i) {
  require(pscl)
  m <- zeroinfl(count ~ child + camper | persons,
    data = data[i, ], dist = "negbin",
    start = list(count = c(1.3711, -1.5152, 0.879), zero = c(1.6028, -1.6663)))
  as.vector(t(do.call(rbind, coef(summary(m)))[, 1:2]))
}

「data」引数はデータフレーム全体を受け取りますが、「i」引数は「boot」によって生成され、1:NROW(data)から取得された行インデックスのサンプルを受け取ります。このコードからわかるように、「i」を使用して、neo-sampleを作成します。これは、渡されzeroinl、その結果の選択された部分のみが返されます。

「i」が{1,2,3,3,3,6,7,7,10}であると想像してみましょう。「[」関数は、行3の3つのコピーと行7の2つのコピーを持つそれらの行のみを返します。これは、単一のzeroinl()計算の基礎となり、係数はbootプロセスの複製の結果として返されます。そのような複製の数は、「R」パラメーターによって制御されます。

statisticこの場合、回帰係数のみが返されるため、boot関数はこれらの累積係数を「t」の値として返します。他のブートパッケージ機能により、さらに比較を実行できます。

弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.