重要な結果が得られるまでデータを収集すると、タイプIのエラー率が増加するのはなぜですか？

重要な結果（例：）が得られるまで（つまり、p-hacking）データを収集すると、タイプIのエラー率が増加するのはなぜだろうか。$p \lt .05$

またR、この現象の実証を高く評価します。

問題は、テストに合格する機会が多すぎることです。これは、このダイアログのファンシーなバージョンです。

誰が夕食の支払いをするかを見るためにあなたをひっくり返します。

OK、私は頭を呼び出します。

ラット、あなたが勝った。3つのうち2つがベストですか？

---

これをよりよく理解するために、この順次手順の単純化された（しかし現実的な）モデルを検討してください。特定の数の観測値の「試行」から始めますが、未満のp値を取得するために、より長い実験を続けていくと仮定します。帰無仮説は、各観測X iが（独立して）標準正規分布に由来するというものです。別の方法は、X iが平均がゼロでない単位分散正規分布から独立していることです。検定統計量は、全ての平均値となり、n個の観測値、ˉ X、それらの標準誤差で割った、1 / $0.05$$X_i$$X_i$$n$$\bar X$。両側検定のために、臨界値は0.025と0.975標準正規分布のパーセント・ポイント、Zのα=±1.96を約。$1/\sqrt{n}$$0.025$$0.975$$Z_\alpha=\pm 1.96$

これは、サンプルサイズ固定した単一の実験に適したテストです。nが何であっても、帰無仮説を棄却する可能性は正確に5 ％です。$n$$5\%$$n$

のは、代数的に基づいて等価なテストにこれを変換してみましょう和全ての値は、S N = X 1 + X 2 + ⋯ + X N = N ˉ X$n$

$$S_n=X_1+X_2+\cdots+X_n = n\bar X.$$

したがって、データは「重要」です

$$\left| Z_\alpha\right| \le \left| \frac{\bar X}{1/\sqrt{n}} \right| = \left| \frac{S_n}{n/\sqrt{n}} \right| = \left| S_n \right| / \sqrt{n};$$

あれは、

$$\left| Z_\alpha\right| \sqrt{n} \le \left| S_n \right| .\tag{1}$$

賢明であれば、損失が削減され、が非常に大きくなり、データがまだ重要な領域に入っていない場合はあきらめます。$n$

これは、ランダムウォーク 表します。式（1 ）ランダムウォークのプロットの周りに、湾曲した放物線「フェンス」またはバリアを正立になる（N 、SのN）、次の場合に結果が「重要」である任意のランダムウォークの点がフェンスに当たりました。$S_n$$(1)$$(n, S_n)$

ランダムウォークのプロパティであるため、十分に長く待つと、ある時点で結果が重要に見える可能性が非常に高くなります。

$n=5000$$n=30$$(1)$

$n$

$25\%$$\alpha=5\%$$5000$$25\%$

4つの「重要な」すべてのケースで、テストを続けると、データがいくつかの点で重要に見えなくなることに注意してください。実際には、早期に停止する実験者は、そのような「復帰」を観察する機会を失います。オプションの停止によるこの選択性は、結果にバイアスをかけます。

誠実さの連続テストでは、障壁は線です。これらは、ここに示されている湾曲した障壁よりも速く広がります。

library(data.table)
library(ggplot2)

alpha <- 0.05   # Test size
n.sim <- 20     # Number of simulated experiments
n.buffer <- 5e3 # Maximum experiment length
i.min <- 30     # Initial number of observations
#
# Generate data.
#
set.seed(17)
X <- data.table(
  n = rep(0:n.buffer, n.sim),
  Iteration = rep(1:n.sim, each=n.buffer+1),
  X = rnorm((1+n.buffer)*n.sim)
)
#
# Perform the testing.
#
Z.alpha <- -qnorm(alpha/2)
X[, Z := Z.alpha * sqrt(n)]
X[, S := c(0, cumsum(X))[-(n.buffer+1)], by=Iteration]
X[, Trigger := abs(S) >= Z & n >= i.min]
X[, Significant := cumsum(Trigger) > 0, by=Iteration]
#
# Plot the results.
#
ggplot(X, aes(n, S, group=Iteration)) +
  geom_path(aes(n,Z)) + geom_path(aes(n,-Z)) +
  geom_point(aes(color=!Significant), size=1/2) +
  facet_wrap(~ Iteration)

仮説検定に慣れていない人は、p値が.05を下回ると、参加者を追加してもp値がさらに減少するだけだと考える傾向があります。しかし、これは真実ではありません。帰無仮説では、ap値は0から1の間で均一に分布し、その範囲内でかなり跳ね返ることができます。

Rでいくつかのデータをシミュレートしました（私のRスキルは非常に基本的です）。このシミュレーションでは、5つのデータポイントを収集します。それぞれがランダムに選択されたグループメンバーシップ（0または1）で、それぞれがランダムに選択された結果メジャー〜N（0,1）です。参加者6から開始して、反復ごとにt検定を実施します。

for (i in 6:150) {
  df[i,1] = round(runif(1))
  df[i,2] = rnorm(1)
  p = t.test(df[ , 2] ~ df[ , 1], data = df)$p.value
  df[i,3] = p
}

p値はこの図にあります。サンプルサイズが約70〜75の場合、重要な結果が見つかります。そこで停止すると、p値がより大きなサンプルで跳ね返ったという事実を見逃してしまうため、私の調査結果が重要であると信じ込んでしまいます（これは実際のデータで一度起こりました）。私は両方の母集団の平均が0であることを知っているので、これは偽陽性でなければなりません。これは、p <.05までデータを追加する際の問題です。十分なテストを追加すると、pは最終的に.05のしきい値を超え、あらゆるデータセットに大きな効果があることがわかります。

この答えは、最終的に「重要な」結果を得る確率と、@ whuberのモデルの下でのこのイベントへの時間の分布にのみ関係します。

$S(t)=X_1 + X_2 + \dots + X_t$$t$$X_1,X_2,\dots$

$$S(t+h)|S(t)=s_0 \sim N(s_0, h), \tag{1}$$ $S(t)$

$T$$S(t)$$\pm z_{\alpha/2}\sqrt{t}$

変換プロセス考えます$Y(\tau)$$S(t)$$t$$\tau=\ln t$

$$Y(\tau)=\frac{S(t(\tau))}{\sqrt{t(\tau)}}=e^{-\tau/2}S(e^\tau). \tag{2}$$ $Y(\tau+\delta)$ $$\begin{align} E(Y(\tau+\delta)|Y(\tau)=y_0) &=E(e^{-(\tau+\delta)/2}S(e^{\tau+\delta})|S(e^\tau)=y_0e^{\tau/2}) \\&=y_0e^{-\delta/2} \tag{3} \end{align}$$ $$\begin{align} \operatorname{Var}(Y(\tau+\delta)|Y(\tau)=y_0) &=\operatorname{Var}(e^{(\tau+\delta)/2}S(e^{\tau+\delta})|S(e^\tau)=y_0e^{\tau/2}) \\&=1-e^{-\delta}, \tag{4} \end{align}$$ $Y(\tau)$

$\pm z_{\alpha/2}$$\mathcal{T}$$Y(\tau)$$\lambda$$\pm z_{\alpha/2}$$\hat\lambda=0.125$$\alpha=0.05$$\alpha$$\tau=0$$H_0$$T=e^\mathcal{T}$

$$ET\approx 1+(1-\alpha)\int_0^\infty e^\tau \lambda e^{-\lambda \tau}d\tau.\tag{5}$$ $T$$\lambda>1$$\alpha$

$T$$ET$$t$$t+1$$t$

$P(T>t)$

Rコード：

# Fig 1
par(mfrow=c(1,2),mar=c(4,4,.5,.5))
set.seed(16)
n <- 20
npoints <- n*100 + 1
t <- seq(1,n,len=npoints)
subset <- 1:n*100-99
deltat <- c(1,diff(t))
z <- qnorm(.975)
s <- cumsum(rnorm(npoints,sd=sqrt(deltat)))
plot(t,s,type="l",ylim=c(-1,1)*z*sqrt(n),ylab="S(t)",col="grey")
points(t[subset],s[subset],pch="+")
curve(sqrt(t)*z,xname="t",add=TRUE)
curve(-sqrt(t)*z,xname="t",add=TRUE)
tau <- log(t)
y <- s/sqrt(t)
plot(tau,y,type="l",ylim=c(-2.5,2.5),col="grey",xlab=expression(tau),ylab=expression(Y(tau)))
points(tau[subset],y[subset],pch="+")
abline(h=c(-z,z))

# Fig 2
nmax <- 1e+3
nsim <- 1e+5
alpha <- .05
t <- numeric(nsim)
n <- 1:nmax
for (i in 1:nsim) {
  s <- cumsum(rnorm(nmax))
  t[i] <- which(abs(s) > qnorm(1-alpha/2)*sqrt(n))[1]
}
delta <- ifelse(is.na(t),0,1)
t[delta==0] <- nmax + 1
library(survival)
par(mfrow=c(1,1),mar=c(4,4,.5,.5))
plot(survfit(Surv(t,delta)~1),log="xy",xlab="t",ylab="P(T>t)",conf.int=FALSE)
curve((1-alpha)*exp(-.125*(log(x))),add=TRUE,col="red",from=1,to=nmax)

上記の議論は、多重度が存在する効果を与える可能性からではなく、データを与える可能性がより極端であることに起因する多頻度主義の世界観であると言う必要があります。問題の根本的な原因は、p値ということであり、私にエラーを入力し、「あなたがここに来たか」が重要になりれ、下位の時間下位情報の流れ調整を使用して、どのような可能性が代わりに起こりました。一方、ベイジアンパラダイムは、データではなく、パラメーター自体への影響に関する懐疑論をコード化します。これにより、5分前に効果の別の事後確率を計算したかどうかにかかわらず、各事後確率が同じように解釈されます。詳細と簡単なシミュレーションは、http：//www.fharrell.com/2017/10/continuous-learning-from-data-noにあります。

$n$$x_1$$\theta=\theta_0$$t$$\alpha$$c$$n$$x_2$$(x_1,x_2)$$K$

この問題は、P。アーミテージ、CKマクファーソンおよびBCロウ（1969年）、Journal of the Royal Statistical Societyによってすでに対処されているようです。シリーズA（132）、2、235-244：「累積データの反復有意性テスト」。

ここで議論されているこの問題に関するベイジアンの視点は、ところで、Berger and Wolpert（1988）、「The Likelihood Principle」、セクション4.2 で議論されています。

$K>1$$\alpha$

試行回数関数としての標準拒否ルールのサイズ$K$

異なる増加する臨界値の関数としてのサイズ$K$

関数として5％のテストを復元するように調整されたクリティカル値$K$

reps <- 50000

K <- c(1:5, seq(10,50,5), seq(60,100,10)) # the number of attempts a researcher gives herself
alpha <- 0.05
cv <- qnorm(1-alpha/2)

grid.scale.cv <- cv*seq(1,1.5,by=.01) # scaled critical values over which we check rejection rates
max.g <- length(grid.scale.cv)
results <- matrix(NA, nrow = length(K), ncol=max.g)

for (kk in 1:length(K)){
  g <- 1
  dev <- 0
  K.act <- K[kk]
  while (dev > -0.01 & g <= max.g){
    rej <- rep(NA,reps)
    for (i in 1:reps){
      k <- 1
      accept <- 1
      x <- rnorm(K.act)
      while(k <= K.act & accept==1){
        # each of our test statistics for "samples" of size n are N(0,1) under H0, so just scaling their sum by sqrt(k) gives another N(0,1) test statistic
        rej[i] <- abs(1/sqrt(k)*sum(x[1:k])) > grid.scale.cv[g] 
        accept <- accept - rej[i]
        k <- k+1
      }
    }
    rej.rate <- mean(rej)
    dev <- rej.rate-alpha
    results[kk,g] <- rej.rate
    g <- g+1
  }
}
plot(K,results[,1], type="l")
matplot(grid.scale.cv,t(results), type="l")
abline(h=0.05)

cv.a <- data.frame(K,adjusted.cv=grid.scale.cv[apply(abs(results-alpha),1,which.min)])
plot(K,cv.a$adjusted.cv, type="l")