data(race)
race.south <- race.nonsouth <- race
race.south[, "south"] <- 1
race.nonsouth[, "south"] <- 0
if (FALSE) {
# Fit EM algorithm ML model with constraint with no covariates
ml.results.south.nocov <- ictreg(y ~ 1,
data = race[race$south == 1, ], method = "ml", treat = "treat",
J = 3, overdispersed = FALSE, constrained = TRUE)
ml.results.nonsouth.nocov <- ictreg(y ~ 1,
data = race[race$south == 0, ], method = "ml", treat = "treat",
J = 3, overdispersed = FALSE, constrained = TRUE)
# Calculate average predictions for respondents in the South
# and the the North of the US for the MLE no covariates
# model, replicating the estimates presented in Figure 1,
# Imai (2010)
avg.pred.south.nocov <- predict(ml.results.south.nocov,
newdata = as.data.frame(matrix(1, 1, 1)), se.fit = TRUE,
avg = TRUE)
avg.pred.nonsouth.nocov <- predict(ml.results.nonsouth.nocov,
newdata = as.data.frame(matrix(1, 1, 1)), se.fit = TRUE,
avg = TRUE)
# Fit linear regression
lm.results <- ictreg(y ~ south + age + male + college,
data = race, treat = "treat", J=3, method = "lm")
# Calculate average predictions for respondents in the
# South and the the North of the US for the lm model,
# replicating the estimates presented in Figure 1, Imai (2010)
avg.pred.south.lm <- predict(lm.results, newdata = race.south,
se.fit = TRUE, avg = TRUE)
avg.pred.nonsouth.lm <- predict(lm.results, newdata = race.nonsouth,
se.fit = TRUE, avg = TRUE)
# Fit two-step non-linear least squares regression
nls.results <- ictreg(y ~ south + age + male + college,
data = race, treat = "treat", J=3, method = "nls")
# Calculate average predictions for respondents in the South
# and the the North of the US for the NLS model, replicating
# the estimates presented in Figure 1, Imai (2010)
avg.pred.nls <- predict(nls.results, newdata = race.south,
newdata.diff = race.nonsouth, se.fit = TRUE, avg = TRUE)
# Fit EM algorithm ML model with constraint
ml.constrained.results <- ictreg(y ~ south + age + male + college,
data = race, treat = "treat", J=3, method = "ml",
overdispersed = FALSE, constrained = TRUE)
# Calculate average predictions for respondents in the South
# and the the North of the US for the MLE model, replicating the
# estimates presented in Figure 1, Imai (2010)
avg.pred.diff.mle <- predict(ml.constrained.results,
newdata = race.south, newdata.diff = race.nonsouth,
se.fit = TRUE, avg = TRUE)
# Calculate average predictions from the item count technique
# regression and from a direct sensitive item modeled with
# a logit.
# Estimate logit for direct sensitive question
data(mis)
mis.list <- subset(mis, list.data == 1)
mis.sens <- subset(mis, sens.data == 1)
# Fit EM algorithm ML model
fit.list <- ictreg(y ~ age + college + male + south,
J = 4, data = mis.list, method = "ml")
# Fit logistic regression with directly-asked sensitive question
fit.sens <- glm(sensitive ~ age + college + male + south,
data = mis.sens, family = binomial("logit"))
# Predict difference between response to sensitive item
# under the direct and indirect questions (the list experiment).
# This is an estimate of the revealed social desirability bias
# of respondents. See Blair and Imai (2010).
avg.pred.social.desirability <- predict(fit.list,
direct.glm = fit.sens, se.fit = TRUE)
}
Run the code above in your browser using DataLab