Example
dichotomous case
The probability of responding correctly to a dichotomous item under Rasch-like models (e.g., 1PL models) is often expressed as:
\[\begin{equation} p(x_{ni} = 1)=\frac{exp(\theta_{n} - \delta_{i})}{1 + (\theta_{n} - \delta_{i})} (\#eq:slm) \end{equation}\]
Imagine the item parameters of a single item represented as:
library(conquestr)
myItem <- matrix(
c(
0, 0, 0, 1,
1, 1, 0, 1
), ncol = 4, byrow = TRUE
)
colnames(myItem) <- c("x", "d", "t", "a")
print(myItem)
#> x d t a
#> [1,] 0 0 0 1
#> [2,] 1 1 0 1Then the probability of scoring 0 and 1 on this item, at = 0.5:
A simple ICC can be drawn:
myProbsList <- list()
myThetaRange <- seq(-4, 4, by = 0.1)
myModel <- "muraki"
for (i in seq_along(myThetaRange)) {
myProbsList[[i]] <- simplep(myThetaRange[i], myItem, model = myModel)
}
myProbs <- (matrix(unlist(myProbsList), ncol = nrow(myItem), byrow = TRUE))
plot(myThetaRange, myProbs[, 2], type = "l")
polytomous case
In the case of polytomously scored items, the probability model can be generalised:
\[\begin{equation} p(X_{ni} = x)=\frac{exp\sum\limits_{k=0}^{x}(\theta_{n} - (\delta_{i} + \tau_{ik}))}{\sum\limits_{j=0}^{m}exp(\sum\limits_{k=0}^{j} (\theta_{n} - (\delta_{i} + \tau_{ik})))} (\#eq:pcm) \end{equation}\]
An item can them be represented such that:
library(conquestr)
myItem <- matrix(
c(
0, 0, 0 , 1.5,
1, 1, 0.2 , 1.5,
2, 1, -0.2 , 1.5
), ncol = 4, byrow=TRUE
)
colnames(myItem)<- c("k", "d", "t", "a")
print(myItem)
#> k d t a
#> [1,] 0 0 0.0 1.5
#> [2,] 1 1 0.2 1.5
#> [3,] 2 1 -0.2 1.5Then the probability of scoring 0, 1 and 2 on this item, at = 0.5:
myProbs <- simplep(0.5, myItem)
print(myProbs)
#> [,1]
#> [1,] 0.4456013
#> [2,] 0.2841279
#> [3,] 0.2702708A simple ICC can be drawn:
myProbsList <- list()
myModel <- "muraki"
for (i in seq_along(myThetaRange)) {
myProbsList[[i]] <- simplep(myThetaRange[i], myItem, model = myModel)
}
myProbs <- (matrix(unlist(myProbsList), ncol = nrow(myItem), byrow = TRUE))
plot(myThetaRange, myProbs[,1], type = "l")
lines(myThetaRange, myProbs[,2])
lines(myThetaRange, myProbs[,3])
twoPLScaled_locations <- {
if (myModel == "gpcm") {
c(myItem[2, 2], sum(myItem[2, 2:3]), sum(myItem[3, 2:3]))
} else {
c(myItem[2, 2], sum(myItem[2, 2:3]), sum(myItem[3, 2:3]))/myItem[2, 4]
}
}
abline(v = twoPLScaled_locations)
Expected scores
The expected score for the an item can be calculated at a given value of theta. Taking an arbitrary set of items, it is possible therefor to calculate the test expected score.
library(conquestr)
myItems <- list()
myItems[[1]] <- matrix(c(
0, 0, 0 , 1,
1, 1, -0.2, 1,
2, 1, 0.2 , 1
), ncol = 4, byrow = TRUE)
myItems[[2]] <- matrix(c(
0, 0 , 0 , 1,
1, -1, -0.4, 1,
2, -1, 0.4 , 1
), ncol = 4, byrow = TRUE)
myItems[[3]] <- matrix(c(
0, 0 , 0 , 1,
1, 1.25, -0.6, 1,
2, 1.25, 0.6 , 1
), ncol = 4, byrow = TRUE)
myItems[[4]] <- matrix(c(
0, 0, 0 , 1,
1, 2, 0.2 , 1,
2, 2, -0.2, 1
), ncol = 4, byrow = TRUE)
myItems[[5]] <- matrix(c(
0, 0 , 0 , 1,
1, -2.5, -0.2, 1,
2, -2.5, 0.2 , 1
), ncol = 4, byrow = TRUE)
for (i in seq(myItems)) {
colnames(myItems[[i]]) <- c("k", "d", "t", "a")
}
print(myItems)
#> [[1]]
#> k d t a
#> [1,] 0 0 0.0 1
#> [2,] 1 1 -0.2 1
#> [3,] 2 1 0.2 1
#>
#> [[2]]
#> k d t a
#> [1,] 0 0 0.0 1
#> [2,] 1 -1 -0.4 1
#> [3,] 2 -1 0.4 1
#>
#> [[3]]
#> k d t a
#> [1,] 0 0.00 0.0 1
#> [2,] 1 1.25 -0.6 1
#> [3,] 2 1.25 0.6 1
#>
#> [[4]]
#> k d t a
#> [1,] 0 0 0.0 1
#> [2,] 1 2 0.2 1
#> [3,] 2 2 -0.2 1
#>
#> [[5]]
#> k d t a
#> [1,] 0 0.0 0.0 1
#> [2,] 1 -2.5 -0.2 1
#> [3,] 2 -2.5 0.2 1
expectedRes <- list()
for (i in seq_along(myThetaRange)) {
tmpExp <- 0
for (j in seq(myItems)) {
tmpE <- simplef(myThetaRange[i], myItems[[j]])
tmpExp <- tmpExp + tmpE
}
expectedRes[[i]] <- tmpExp
}
plot(myThetaRange, unlist(expectedRes), type = "l")