我试图模拟二进制logit模型中的“假设”情况。我估计通过测试的概率，考虑到测试的难度（1 =最简单，5 =最难），性别作为对照。 （数据为here）。学生将接受一项通常很难的测试（数据中的“高”）。由此我们可以估计考试难度对传球可能性的影响：
model = glm(PASS ~ as.factor(SEX) + as.factor(HIGH), family=binomial(link="logit"), data=df)
summary(model)
我们还可以通过以下方式获得预测的概率：
predict.high = predict(model, type="response")
问题是，如果给出“低”测试怎么办？为了获得新的概率，我们可以做到：
newdata = rename.vars(subset(df, select=c(-HIGH)), 'LOW','HIGH')
predict.low = predict(model, newdata=newdata, type="response")
但我怎么知道在这种情况下还会有多少学生通过？ glm()我没有看到明显的转变吗？
答案 0 :(得分：3)
我还没有尝试挖掘出我根据Gelman和Hill（2006）编写的预测代码，我似乎记得使用模拟。我仍打算这样做。在我有限的经历中，你的问题的一个方面似乎是独一无二的，我习惯于预测单个观察（在这种情况下，单个学生进行单一测试）。但是，您似乎想要预测两组预测之间的差异。换句话说，如果给出一组5个简单的考试而不是5个硬考试，你想要预测会有多少学生通过。
我不确定盖尔曼和希尔（2006）是否涵盖了这一点。你似乎也想用频繁的方法做到这一点。
我在想，如果你能预测一次观察，那么每次观察都有一个置信区间，那么也许你可以估计每组内传球的加权平均概率并减去两个加权平均值。 delta方法可用于估计加权平均值及其差异的置信区间。
预测观测值之间的协方差可能必须假设为0才能实现该方法。
如果假设协方差为0并不令人满意，那么贝叶斯方法可能会更好。同样，我只熟悉预测单个观察。使用贝叶斯方法，我通过包括自变量而不是因变量来预测单个观察，以便预测观察。我想你可以预测同一个贝叶斯运行中的每个观察结果（预测每个学生在HIGH和LOW）。每组通过测试的加权平均值和加权平均值的差异是派生参数，我怀疑可以直接包含在贝叶斯逻辑回归的代码中。然后，您将获得您的点估计和通过每组测试的概率的方差估计以及通过每组测试的概率差异。如果你想要通过每组测试的学生数量的差异，也许这可以作为派生参数包含在贝叶斯代码中。
到目前为止，我意识到这个答案比想要的更具说服力。我只是在没有时间尝试实施这些策略的情况下制定策略。提供所有R和WinBUGS代码来实现这两个提议的策略可能需要几天时间。 （可以从R中调用WinBUGS或OpenBUGS。）随着时间的推移，我会将代码附加到此答案中。如果有人认为我提出的策略和/或即将推出的代码不正确，我希望他们可以随意指出我的错误并提供更正。
修改
下面是生成虚假数据并使用频率和贝叶斯方法分析数据的代码。我还没有添加代码来实现上述预测的想法。我将尝试在接下来的1-2天内添加贝叶斯预测代码。我只用了三次测试而不是五次。下面编写代码的方式可以将学生数n更改为可以分为6个相等整数的任何非零数字。
# Bayesian_logistic_regression_June2012.r
# June 24, 2012
library(R2WinBUGS)
library(arm)
library(BRugs)
set.seed(3234)
# create fake data for n students and three tests
n <- 1200
# create factors for n/6 students in each of 6 categories
gender <- c(rep(0, (n/2)), rep(1, (n/2)))
test2 <- c(rep(0, (n/6)), rep(1, (n/6)), rep(0, (n/6)),
rep(0, (n/6)), rep(1, (n/6)), rep(0, (n/6)))
test3 <- c(rep(0, (n/6)), rep(0, (n/6)), rep(1, (n/6)),
rep(0, (n/6)), rep(0, (n/6)), rep(1, (n/6)))
# assign slopes to factors
B0 <- 0.4
Bgender <- -0.2
Btest2 <- 0.6
Btest3 <- 1.2
# estimate probability of passing test
p.pass <- ( exp(B0 + Bgender * gender +
Btest2 * test2 +
Btest3 * test3) /
(1 + exp(B0 + Bgender * gender +
Btest2 * test2 +
Btest3 * test3)))
# identify which students passed their test, 0 = fail, 1 = pass
passed <- rep(0, n)
r.passed <- runif(n,0,1)
passed[r.passed <= p.pass] = 1
# use frequentist approach in R to estimate probability
# of passing test
m.freq <- glm(passed ~ as.factor(gender) +
as.factor(test2) +
as.factor(test3) ,
family = binomial)
summary(m.freq)
# predict(m.freq, type = "response")
# use OpenBUGS to analyze same data set
# Define model
sink("Bayesian.logistic.regression.txt")
cat("
model {
# Priors
alpha ~ dnorm(0,0.01)
bgender ~ dnorm(0,0.01)
btest2 ~ dnorm(0,0.01)
btest3 ~ dnorm(0,0.01)
# Likelihood
for (i in 1:n) {
passed[i] ~ dbin(p[i], 1)
logit(p[i]) <- (alpha + bgender * gender[i] +
btest2 * test2[i] +
btest3 * test3[i])
}
# Derived parameters
p.g.t1 <- exp(alpha) / (1 + exp(alpha))
p.b.t1 <- exp(alpha + bgender) / (1 + exp(alpha + bgender))
p.g.t2 <- ( exp(alpha + btest2) /
(1 + exp(alpha + btest2)))
p.b.t2 <- ( exp(alpha + bgender + btest2) /
(1 + exp(alpha + bgender + btest2)))
p.g.t3 <- ( exp(alpha + btest3) /
(1 + exp(alpha + btest3)))
p.b.t3 <- ( exp(alpha + bgender + btest3) /
(1 + exp(alpha + bgender + btest3)))
}
", fill = TRUE)
sink()
my.data <- list(passed = passed,
gender = gender,
test2 = test2,
test3 = test3,
n = length(passed))
# Inits function
inits <- function(){ list(alpha = rlnorm(1),
bgender = rlnorm(1),
btest2 = rlnorm(1),
btest3 = rlnorm(1)) }
# Parameters to estimate
params <- c("alpha", "bgender", "btest2", "btest3",
"p.g.t1", "p.b.t1", "p.g.t2", "p.b.t2",
"p.g.t3", "p.b.t3")
# MCMC settings
nc <- 3
ni <- 2000
nb <- 500
nt <- 2
# Start Gibbs sampling
out <- bugs(data = my.data, inits = inits,
parameters.to.save = params,
"c:/users/Mark W Miller/documents/Bayesian.logistic.regression.txt",
program = 'OpenBUGS',
n.thin = nt, n.chains = nc,
n.burnin = nb, n.iter = ni, debug = TRUE)
print(out, dig = 5)
在我尝试实施加权平均预测方法之前，我想让自己相信它可能有用。所以我给下面的代码搞砸了，这似乎表明它可能：
# specify number of girls taking each test and
# number of boys taking each test
g.t1 <- rep(0,400)
b.t1 <- rep(0,120)
g.t2 <- rep(0,1200)
b.t2 <- rep(0,50)
g.t3 <- rep(0,1000)
b.t3 <- rep(0,2000)
# specify probability of individuals in each of the
# 6 groups passing their test
p.g1.t1 <- 0.40
p.b1.t1 <- 0.30
p.g1.t2 <- 0.60
p.b1.t2 <- 0.50
p.g1.t3 <- 0.80
p.b1.t3 <- 0.70
# identify which individuals in each group passed their test
g.t1[1:(p.g1.t1 * length(g.t1))] = 1
sum(g.t1)
b.t1[1:(p.b1.t1 * length(b.t1))] = 1
sum(b.t1)
g.t2[1:(p.g1.t2 * length(g.t2))] = 1
sum(g.t2)
b.t2[1:(p.b1.t2 * length(b.t2))] = 1
sum(b.t2)
g.t3[1:(p.g1.t3 * length(g.t3))] = 1
sum(g.t3)
b.t3[1:(p.b1.t3 * length(b.t3))] = 1
sum(b.t3)
# determine the weighted average probability of passing
# on test day for all individuals as a class
wt.ave.p <- ((p.g1.t1 * length(g.t1) + p.b1.t1 * length(b.t1) +
p.g1.t2 * length(g.t2) + p.b1.t2 * length(b.t2) +
p.g1.t3 * length(g.t3) + p.b1.t3 * length(b.t3) ) /
(length(g.t1) + length(b.t1) + length(g.t2) +
length(b.t2) + length(g.t3) + length(b.t3)))
wt.ave.p
# determine the expected number of individuals passing
# their test in the class as a whole
exp.num.pass <- wt.ave.p * (length(g.t1) + length(b.t1) +
length(g.t2) + length(b.t2) +
length(g.t3) + length(b.t3))
exp.num.pass
# determine the number of individuals passing
num.passing <- (sum(g.t1) + sum(b.t1) +
sum(g.t2) + sum(b.t2) +
sum(g.t3) + sum(b.t3) )
num.passing
# the expected number of students passing, exp.num.pass,
# should equal the observed number of students passing,
# num.passing regardless of the number of students in each
# group and regardless of the probability of passing a
# given test, within rounding error
identical(round(exp.num.pass), round(num.passing))
希望在接下来的几天内我可以尝试将预测代码添加到上面的贝叶斯代码中。
编辑 - 2012年6月27日
我没有忘记这件事。相反，我遇到了几个问题：
通过逻辑回归，可以预测：a）给定组中的学生通过测试的概率p和b）给定测试的学生（0或1）的结果。然后对所有0和1进行平均。我不确定使用哪一种。预测p的点估计和SD与已知测试结果的估计p相同。预测的0和1的平均值的点估计略有不同，并且平均0和1的SD更大。我相信我想要b，预测的0和1的平均值。但是，我试图检查各种网站和书籍。 Collett（1991）有一个不使用计算机代码的工作示例，但是这个有效的例子包括6个变量，包括2个交互，我在使贝叶斯估计符合她的频率估计时遇到一些麻烦。
< / LI>使用大量派生参数，程序需要很长时间才能运行。
显然，即使没有预测代码，OpenBUGS也经常崩溃。我不确定这是因为我做错了什么，还是因为最近R版本的更改或最近版本的R包的更改，或者是因为我试图用64位R或其他东西运行代码其他
我会尽快发布预测代码，但所有上述问题都让我失望。
答案 1 :(得分：0)
您可以轻松地使用此方法找到切断点：
cutoff <- runif(length(predicted_probabilities))
这是基于Metropolis-Hastings的确定性决定。