## Loading required package: sandwich
data(race)
# Calculate list experiment difference in means

diff.in.means.results <- ictreg(y ~ 1, data = race,
treat = "treat", J=3, method = "lm")

summary(diff.in.means.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ 1, data = race, treat = "treat", J = 3,
##     method = "lm")
##
## Sensitive item
##               Est.    S.E.
## (Intercept) 0.0678 0.04962
##
## Control items
##                Est.    S.E.
## (Intercept) 2.13413 0.03317
##
## Residual standard error: 0.866365 with 1211 degrees of freedom
##
## Number of control items J set to 3. Treatment groups were indicated by '' and '' and the control group by ''.
# Fit linear regression
# Replicates Table 1 Columns 1-2 Imai (2011); note that age is divided by 10

lm.results <- ictreg(y ~ south + age + male + college, data = race,
treat = "treat", J=3, method = "lm")

summary(lm.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ south + age + male + college, data = race,
##     treat = "treat", J = 3, method = "lm")
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -0.43430 0.16033
## south        0.20198 0.11760
## age          0.07309 0.03051
## male         0.18023 0.09846
## college      0.11446 0.09775
##
## Control items
##                 Est.    S.E.
## (Intercept)  2.40606 0.10511
## south       -0.18021 0.07450
## age          0.02047 0.01998
## male        -0.20177 0.06522
## college     -0.39408 0.06406
##
## Residual standard error: 0.837231 with 1203 degrees of freedom
##
## Number of control items J set to 3. Treatment groups were indicated by '' and '' and the control group by ''.
# Fit two-step non-linear least squares regression
# Replicates Table 1 Columns 3-4 Imai (2011); note that age is divided by 10

nls.results <- ictreg(y ~ south + age + male + college, data = race,
treat = "treat", J=3, method = "nls")

summary(nls.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ south + age + male + college, data = race,
##     treat = "treat", J = 3, method = "nls")
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -7.08431 3.66927
## south        2.48985 1.26819
## age          0.26094 0.31467
## male         3.09687 2.82923
## college      0.61232 1.02951
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.38811 0.18683
## south       -0.27655 0.11617
## age          0.03307 0.03503
## male        -0.33223 0.10702
## college     -0.66175 0.11314
##
## Residual standard error: 0.900805 with 619 degrees of freedom
##
## Number of control items J set to 3. Treatment groups were indicated by '' and '' and the control group by ''.
# Fit EM algorithm ML model with constraint
# Replicates Table 1 Columns 5-6, Imai (2011); note that age is divided by 10

ml.constrained.results <- ictreg(y ~ south + age + male + college, data = race,
treat = "treat", J=3, method = "ml",
overdispersed = FALSE, constrained = TRUE)

summary(ml.constrained.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ south + age + male + college, data = race,
##     treat = "treat", J = 3, method = "ml", overdispersed = FALSE,
##     constrained = TRUE)
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -5.50833 1.02112
## south        1.67564 0.55855
## age          0.63587 0.16334
## male         0.84647 0.49374
## college     -0.31527 0.47360
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.19141 0.14369
## south       -0.29204 0.09692
## age          0.03322 0.02768
## male        -0.25060 0.08194
## college     -0.51641 0.08368
##
## Log-likelihood: -1444.394
##
## Number of control items J set to 3. Treatment groups were indicated by '1' and the control group by '0'.
# Fit EM algorithm ML model with no constraint
# Replicates Table 1 Columns 7-10, Imai (2011); note that age is divided by 10

ml.unconstrained.results <- ictreg(y ~ south + age + male + college, data = race,
treat = "treat", J=3, method = "ml",
overdispersed = FALSE, constrained = FALSE)

summary(ml.unconstrained.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ south + age + male + college, data = race,
##     treat = "treat", J = 3, method = "ml", overdispersed = FALSE,
##     constrained = FALSE)
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -6.22629 1.04586
## south        1.37979 0.81937
## age          0.65514 0.20727
## male         1.36539 0.61193
## college     -0.18230 0.56865
##
## Control items (psi0)
##                 Est.    S.E.
## (Intercept)  1.15626 0.15647
## south       -0.29870 0.10684
## age          0.03142 0.03173
## male        -0.21774 0.08581
## college     -0.48814 0.08665
##
## Control items (psi1)
##                 Est.    S.E.
## (Intercept)  3.77827 2.15094
## south       -0.27012 0.58950
## age         -0.12816 0.15707
## male        -1.68693 1.62653
## college     -0.95323 0.71355
##
## Log-likelihood: -1441.02
##
## Number of control items J set to 3. Treatment groups were indicated by '1' and the control group by '0'.
# Fit EM algorithm ML model for multiple sensitive items
# Replicates Table 3 in Blair and Imai (2010)

multi.results <- ictreg(y ~ male + college + age + south + south:age, treat = "treat",
J = 3, data = multi, method = "ml",
multi.condition = "level")

summary(multi.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ male + college + age + south + south:age,
##     data = multi, treat = "treat", J = 3, method = "ml", multi.condition = "level")
##
## Sensitive item (affirm)
##                 Est.    S.E.
## (Intercept) -5.27027 1.26761
## male         0.53768 0.43469
## college     -0.55231 0.39908
## age          0.57904 0.14743
## south        5.65988 2.42870
## age:south   -0.83337 0.41781
## y_i(0)       0.99148 0.26386
##
## Sensitive item (race)
##                 Est.    S.E.
## (Intercept) -7.57538 1.53854
## male         1.19995 0.56941
## college     -0.25892 0.49587
## age          0.85188 0.21973
## south        4.75059 1.84955
## age:south   -0.64331 0.34732
## y_i(0)       0.26663 0.25237
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.38930 0.14274
## male        -0.32550 0.07623
## college     -0.53345 0.07410
## age          0.00594 0.02841
## south       -0.68529 0.29652
## age:south    0.09278 0.06080
##
## Log-likelihood: -2223.394
##
## Number of control items J set to 3. Treatment groups were indicated by 'affirm' and 'race' and the control group by 'control'.
# Fit standard design ML model
# Replicates Table 7 Columns 1-2 in Blair and Imai (2010)

noboundary.results <- ictreg(y ~ age + college + male + south, treat = "treat",
J = 3, data = affirm, method = "ml",
overdispersed = FALSE)

summary(noboundary.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ age + college + male + south, data = affirm,
##     treat = "treat", J = 3, method = "ml", overdispersed = FALSE)
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -1.29845 0.55634
## age          0.29526 0.10118
## college     -0.34319 0.33579
## male         0.03956 0.34630
## south        1.17665 0.47999
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.38795 0.15868
## age          0.02780 0.02845
## college     -0.67058 0.09625
## male        -0.35282 0.09240
## south       -0.23443 0.10760
##
## Log-likelihood: -1434.542
##
## Number of control items J set to 3. Treatment groups were indicated by 'TRUE' and the control group by '0'.
# Fit standard design ML model with ceiling effects alone
# Replicates Table 7 Columns 3-4 in Blair and Imai (2010)

ceiling.results <- ictreg(y ~ age + college + male + south, treat = "treat",
J = 3, data = affirm, method = "ml", fit.start = "nls",
ceiling = TRUE, ceiling.fit = "bayesglm",
ceiling.formula = ~ age + college + male + south)

summary(ceiling.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ age + college + male + south, data = affirm,
##     treat = "treat", J = 3, method = "ml", ceiling = TRUE, ceiling.fit = "bayesglm",
##     ceiling.formula = ~age + college + male + south, fit.start = "nls")
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -1.29074 0.55774
## age          0.29417 0.10130
## college     -0.34462 0.33594
## male         0.03829 0.34641
## south        1.17496 0.47992
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.38725 0.15873
## age          0.02788 0.02845
## college     -0.67042 0.09626
## male        -0.35268 0.09241
## south       -0.23422 0.10760
##
## Ceiling
##                 Est.    S.E.
## (Intercept) -0.76553 1.99813
## age         -1.77721 1.92141
## college     -0.21154 1.75863
## male        -0.23176 1.77484
## south       -0.31343 1.76460
##
## Log-likelihood: -1434.577
##
## Number of control items J set to 3. Treatment groups were indicated by 'TRUE' and the control group by '0'.
# Fit standard design ML model with floor effects alone
# Replicates Table 7 Columns 5-6 in Blair and Imai (2010)

floor.results <- ictreg(y ~ age + college + male + south, treat = "treat",
J = 3, data = affirm, method = "ml", fit.start = "glm",
floor = TRUE, floor.fit = "bayesglm",
floor.formula = ~ age + college + male + south)

summary(floor.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ age + college + male + south, data = affirm,
##     treat = "treat", J = 3, method = "ml", floor = TRUE, floor.fit = "bayesglm",
##     floor.formula = ~age + college + male + south, fit.start = "glm")
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -1.25009 0.50131
## age          0.31359 0.09187
## college     -0.60321 0.29831
## male        -0.08684 0.30008
## south        0.68345 0.33513
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.37176 0.15509
## age          0.02821 0.02759
## college     -0.63219 0.09300
## male        -0.32702 0.08758
## south       -0.16064 0.09828
##
## Floor
##                Est.    S.E.
## (Intercept) 0.22720 1.78462
## age         0.68449 0.53567
## college     0.11950 1.85257
## male        0.13363 1.96343
## south       0.07737 1.92850
##
## Log-likelihood: -1438.501
##
## Number of control items J set to 3. Treatment groups were indicated by 'TRUE' and the control group by '0'.
# Fit standard design ML model with floor and ceiling effects
# Replicates Table 7 Columns 7-8 in Blair and Imai (2010)

both.results <- ictreg(y ~ age + college + male + south, treat = "treat",
J = 3, data = affirm, method = "ml",
floor = TRUE, ceiling = TRUE,
floor.fit = "bayesglm", ceiling.fit = "bayesglm",
floor.formula = ~ age + college + male + south,
ceiling.formula = ~ age + college + male + south)

summary(both.results)
##
## Item Count Technique Regression
##
## Call: ictreg(formula = y ~ age + college + male + south, data = affirm,
##     treat = "treat", J = 3, method = "ml", floor = TRUE, ceiling = TRUE,
##     ceiling.fit = "bayesglm", floor.fit = "bayesglm", ceiling.formula = ~age +
##         college + male + south, floor.formula = ~age + college +
##         male + south)
##
## Sensitive item
##                 Est.    S.E.
## (Intercept) -1.24333 0.50246
## age          0.31265 0.09196
## college     -0.60458 0.29845
## male        -0.08777 0.30017
## south        0.68247 0.33518
##
## Control items
##                 Est.    S.E.
## (Intercept)  1.37120 0.15512
## age          0.02828 0.02759
## college     -0.63202 0.09301
## male        -0.32693 0.08758
## south       -0.16055 0.09828
##
## Ceiling
##                 Est.    S.E.
## (Intercept) -0.76550 1.99818
## age         -1.77719 1.88103
## college     -0.21157 1.75463
## male        -0.23182 1.77041
## south       -0.31348 1.76337
##
## Floor
##                Est.    S.E.
## (Intercept) 0.22732 1.78460
## age         0.68458 0.53592
## college     0.11965 1.85279
## male        0.13366 1.96364
## south       0.07737 1.92871
##
## Log-likelihood: -1438.539
##
## Number of control items J set to 3. Treatment groups were indicated by 'TRUE' and the control group by '0'.