### Example with weighting ###
ip <- generate_ip(model = sample(c("GPCM", "2PL"), 10, TRUE))
theta <- c(-3, -1.2, 0.5, 3)
prob_sum_score(ip, theta = theta)
# Most probable sum scores:
apply(prob_sum_score(ip, theta = theta), MARGIN = 2, which.max) - 1
if (FALSE) {
plot(ip, type = "tcc", suppress_plot = TRUE) +
ggplot2::geom_vline(xintercept = theta, lty = "dashed")
}
### Example from Kolen and Brennan (2014) ###
# Item parameters from Kolen and Brennan (2014), p.175, Table 6.1.
ip <- itempool(a = c(1.30, .6, 1.7),
b = c(-1.30, -.10, .9),
c = c(.1, .17, .18),
D = 1.7)
prob(ip, theta = c(-2, 1))
# IRT observed score distribution using recursive formula from
# Kolen and Brennan (2014), p.200, Table 6.4.
# Numbers are not exactly the same as Kolen and Brennan since due to
# rounding applied to the numbers in the book.
prob_sum_score(ip, theta = -2)
### Example from Thissen, Pommerich, Billeaud and Williams (1995) ###
# Replicating Thissen et al. (1995) example, p.43-44, Table 1.
i1 <- item(a = .5, b = -1)
i2 <- item(a = 1, b = 0)
i3 <- item(a = 1.5, b = 1)
ip <- c(i1, i2, i3) # combine items to form an item pool
theta <- -3:3 # Quadrature points
prob_sum_score(ip, theta)
# Item parameters in Table 2
i1 <- item(a = 1.87, b = c(.65, 1.97, 3.14), model = "GRM")
i2 <- item(a = 2.66, b = c(.12, 1.57, 2.69), model = "GRM")
i3 <- item(a = 1.24, b = c(.08, 2.03, 4.30), model = "GRM")
ip <- c(i1, i2, i3)
delta <- 0.01
theta <- seq(-3, 3, delta)
x <- prob_sum_score(ip = ip, theta = theta, theta_pdf = dnorm(theta))
# Figure 1
plot(x = theta, y = x[2, ], type = "l", ylab = "Posterior Density",
xlab = "Theta",
main = paste0("Posterior Distribution for all Examinees Obtaining ",
"a Summed Score of 1"))
# Table 3, column "Modeled Score Group Proportion"
rowSums(x)/sum(rowSums(x))
Run the code above in your browser using DataLab