因为您提出的测试没有理论基础,也没有考虑计数之间的相关性,所以我们不能很好地利用我们的时间来评估它。相反,让我们开发一些可行的测试。
当所有计数都相对较大时,可以保证似然比检验运行良好。卡方检验也是如此,只要样品中只有一小部分瓮中的球被取出。(通常的经验法则是当样本超过总数的 10% 时要小心。)在其他情况下,从零分布进行模拟是有效的。
观察计数的可能性 x1,…,xr在一个瓮中的样本中N1,…,Nr每种颜色的球是
L(x;N)=(N1x1)(N2x2)⋯(Nrxr) / (N1+⋯+Nrx1+⋯+Nr).
这最好用它的偏差来表达 D=−2logL因为渐近地,偏差有一个χ2分布与r−1自由程度
通过采样几千次(使用计算机),您可以估计D. 观测值的 p 值是由观测偏差确定的右尾面积。
例如,考虑一个带有r=7数量上的颜色(Ni)=(34,45,41,35,49,47,51,42). 我计算了一万个大小样本的零偏差167(每个样本中有一半的球),如左图所示。我还计算了另外一万个样本中的偏差,其中颜色的选择概率从 20%(对于颜色1) 降至仅 6%(用于颜色7)。后一种偏差往往很大。实际上,其中大约 96% 超过了零偏差的第 95 个百分位。从这个意义上说,这个测试的力量,当在alpha=100−95%=5%水平,为 96%。
我们可以和平常一样玩同样的游戏χ2测试。 如果该检验直接适用,则其 p 值的零分布将是均匀的。但是,零分布是偏斜的,大多数 p 值都非常大:请参见下图中的左图。但是,在检查这个模拟后,我们可以声明卡方检验结果在α每当其 p 值小于α此零分布的分位数。该分位数接近0.4(而不是预期的0.05),用阴影条显示。
右图同样显示了备择假设下卡方检验 p 值的分布。它的“标称功效”是报告的(标称)p 值小于α,显示为红色条的区域。这只有 48.2%,远低于似然比 (LR) 测试所达到的 96%。然而,当我们使用α零分布的分位数作为我们的阈值,现在零假设在 95% 的模拟数据中被拒绝。95% 的功效与 LR 测试基本相同。
那么,这些模拟所证明的是
应用标准卡方检验或 LR 检验是无效的,除非样本是骨灰盒的一小部分并且样本数量相当大。第二个图中的偏态空分布显示出了什么问题。
然而,如果 p 值是使用实际的零分布(通过模拟估计的)而不是使用标准公式(依赖于具有大量人口的渐近大样本)计算的,则可以使用这两种测试。
R
执行这些计算并显示这些数字的代码如下。
#
# Multivariate hypergeometric distribution.
# Draw `n` balls without replacement from an urn with length(N) colors, each
# appearing N[i] times.
#
# Returns a vector of counts of the colors.
#
rmhyper <- function(n, N, p) {
if (missing(p)) p <- rep(1/sum(N), length(N))
prob <- rep(p, N)
prob <- prob / sum(prob)
x <- sample(rep(seq_along(N), N), n, prob=prob)
tabulate(x, length(N))
}
#
# Returns the likelihood of observing `k` in a hypergeometric draw specified
# by `N`.
#
dmhyper <- function(k, N, log.p=TRUE) {
q <- sum(lchoose(N, k)) - lchoose(sum(N), sum(k))
if (!isTRUE(log.p)) q <- exp(q)
return(q)
}
#
# Perform a chi-squared test.
#
mhyper.test <- function(k, N, ...) {
chisq.test(k, p=N / sum(N), ...)
}
#
# Simulations.
#
alpha <- 0.05
n.sim <- 1e4
set.seed(17)
N <- rpois(8, 40) + 1 # Determine the population randomly
p <- rgamma(length(N), 10/4) # Determine the alternative hypothesis randomly
p <- rev(sort(p / sum(p)))
n <- ceiling(sum(N)*0.5)
#
# Display the sampling probabilities.
#
plot(p, type="h", col=rainbow(length(N), .9, .8),
lwd=3, ylim=c(0, max(p)), xlab="Color", main="Probabilities")
#
# The chi-squared test p-values are ok when the sample is a small fraction
# of the population.
#
p.values.null <- replicate(n.sim, mhyper.test(rmhyper(n,N), N, simulate.p.value=FALSE)$p.value)
p.values.alt <- replicate(n.sim, mhyper.test(rmhyper(n,N, p), N, simulate.p.value=FALSE)$p.value)
power <- round(100*mean(p.values.alt <= alpha), 1)
power.alt <- round(100*mean(p.values.alt <= quantile(p.values.null, alpha)))
k <- round(20 * quantile(p.values.null, alpha)) - 1
b <- seq(0, 1, by=0.05)
par(mfrow=c(1,2))
h <- hist(p.values.null, freq=FALSE, breaks=b, xlab="p",
col=c("#d08080", rep("#e0e0e0", k), rep("White", 20-k-1)),
main="Histogram of Chi-square P-values\nNull Distribution")
hist(p.values.alt, freq=FALSE, breaks=b, xlab="p", ylim=c(0, max(h$density)),
col=c("#d08080", rep("#e0e0e0", k), rep("White", 20-k-1)),
sub=bquote(paste("Nominal power = ", .(power), "%; Simulation power = ", .(power.alt), "%")),
main="Histogram of Chi-square P-values\nAlternative Distribution")
q.null <- -2 * replicate(n.sim, dmhyper(rmhyper(n, N), N))
q <- -2 * replicate(n.sim, dmhyper(rmhyper(n, N, p), N))
xlim <- range(c(q, q.null))
h <- hist(q.null, xlim=xlim, freq=FALSE, breaks=50, xlab=expression(-2~~log(p)),
col="#f0f0f0",
main="Null distribution of deviance")
abline(v = quantile(q.null, 1-alpha), col="Red", lwd=2)
power <- signif(mean(q >= quantile(q.null, 1-0.05)), 2)
hist(q, xlim=xlim, freq=FALSE, breaks=50, xlab=expression(-2~~log(p)),
col="#f0f0f0", ylim=c(0, max(h$density)),
main="Alternative distribution of deviance",
sub=bquote(paste("Power = ", .(100*power), "%")))
abline(v = quantile(q.null, 1-alpha), col="Red", lwd=2)
par(mfrow=c(1,1))