09-Item-Response-Theory.Rmd

# Item Response Theory {#irt}

In the chapter on [reliability](#reliability), we introduced [classical test theory](#ctt).\index{reliability}\index{classical test theory}
[Classical test theory](#ctt) is a measurement theory of how test scores relate to a construct.\index{classical test theory}
[Classical test theory](#ctt) provides a way to estimate the relation between the measure (or item) and the construct.\index{classical test theory}
For instance, with a [classical test theory](#ctt) approach, to estimate the relation between an item and the construct, you would compute an [item–total correlation](#itemTotalCorrelation-reliability).\index{classical test theory}\index{reliability!internal consistency!average item–total correlation}
An [item–total correlation](#itemTotalCorrelation-reliability) is the correlation of an item with the total score on the measure (e.g., sum score).\index{reliability!internal consistency!average item–total correlation}
The [item–total correlation](#itemTotalCorrelation-reliability) approximates the relation between an item and the construct.\index{reliability!internal consistency!average item–total correlation}
However, the [item–total correlation](#itemTotalCorrelation-reliability) is a crude estimate of the relation between an item and the construct.\index{reliability!internal consistency!average item–total correlation}
And there are many other ways to characterize the relation between an item and a construct.
One such way is with item response theory (IRT).\index{item response theory}

## Overview of IRT {#overview-irt}

Unlike [classical test theory](#ctt), which is a measurement theory of how test scores relate to a construct, IRT is a measurement theory that describes how an *item* is related to a construct.\index{classical test theory}\index{item response theory}
For instance, given a particular person's level on the construct, what is their chance of answering "TRUE" on a particular item?\index{item response theory}

IRT is an approach to [latent variable modeling](#latentVariableModeling).\index{item response theory}\index{latent variable}
In IRT, we estimate a person's construct score (i.e., level on the construct) based on their item responses.
The construct is estimated as a latent factor that represents the common variance among all items as in [structural equation modeling](#sem) or [confirmatory factor analysis](#cfa).\index{item response theory}
The person's level on the construct is called theta ($\theta$).\index{item response theory}\index{item response theory!theta}
When dealing with performance-based tests, theta is sometimes called "ability."\index{item response theory}\index{item response theory!theta}

### Item Characteristic Curve {#icc}

In IRT, we can plot an *item characteristic curve* (ICC).\index{item response theory}\index{item response theory!item characteristic curve}
The ICC is a plot of the model-derived probability of a symptom being present (or a correct response) as a function of a person's standing on a latent continuum.\index{item response theory!item characteristic curve}
For instance, we can create empirical ICCs that can take any shape (see Figure \@ref(fig:empiricalICC)).\index{item response theory!item characteristic curve}

```{r, include = FALSE}
empiricalICCdata <- data.frame(
  item1 =  c(.40, .63, .73, .85, .93, .95, .97, .99, .99),
  item2 =  c(.20, .53, .56, .76, .90, .94, .95, .98, .99),
  item3 =  c(.10, .28, .39, .58, .75, .82, .88, .94, .99),
  item4 =  c(.05, .24, .30, .50, .68, .73, .84, .92, .99),
  item5 =  c(.03, .19, .27, .38, .49, .53, .79, .97, .99),
  item6 =  c(.02, .15, .25, .43, .57, .65, .75, .85, .95),
  item7 =  c(.01, .07, .15, .29, .42, .59, .70, .82, .90),
  item8 =  c(.01, .05, .10, .26, .35, .46, .60, .80, .85),
  item9 =  c(.01, .02, .05, .16, .23, .35, .46, .55, .70),
  item10 = c(.01, .02, .03, .05, .06, .07, .10, .14, .20),
  itemSum = 1:9
)
```

```{r empiricalICC, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.height = 8, fig.cap = "Empirical Item Characteristic Curves of the Probability of Endorsement of a Given Item as a Function of the Person's Sum Score.", fig.scap = "Empirical Item Characteristic Curves of the Probability of Endorsement of a Given Item as a Function of the Person's Sum Score."}
plot(empiricalICCdata$itemSum, empiricalICCdata$item10, type = "n", xlim = c(1,9), ylim = c(0,1), xlab = "Person's Sum Score", ylab = "Probability of Item Endorsement", xaxt = "n")
lines(empiricalICCdata$itemSum, empiricalICCdata$item1, type = "b", pch = "1")
lines(empiricalICCdata$itemSum, empiricalICCdata$item2, type = "b", pch = "2")
lines(empiricalICCdata$itemSum, empiricalICCdata$item3, type = "b", pch = "3")
lines(empiricalICCdata$itemSum, empiricalICCdata$item4, type = "b", pch = "4")
lines(empiricalICCdata$itemSum, empiricalICCdata$item5, type = "b", pch = "5")
lines(empiricalICCdata$itemSum, empiricalICCdata$item6, type = "b", pch = "6")
lines(empiricalICCdata$itemSum, empiricalICCdata$item7, type = "b", pch = "7")
lines(empiricalICCdata$itemSum, empiricalICCdata$item8, type = "b", pch = "8")
lines(empiricalICCdata$itemSum, empiricalICCdata$item9, type = "b", pch = "9")
lines(empiricalICCdata$itemSum, empiricalICCdata$item10, type = "l")
points(empiricalICCdata$itemSum, empiricalICCdata$item10, type = "p", pch = 19, col = "white", cex = 3)
text(empiricalICCdata$itemSum, empiricalICCdata$item10, labels = "10")
axis(1, at = 1:9, labels = 1:9)
```

In a model-implied ICC, we fit a logistic (sigmoid) curve to each item's probability of a symptom being present as a function of a person's level on the latent construct.\index{item response theory!item characteristic curve}
The model-implied ICCs for the same 10 items from Figure \@ref(fig:empiricalICC) are depicted in Figure \@ref(fig:modelImpliedICC).\index{item response theory!item characteristic curve}

```{r, include = FALSE}
#https://www.statforbiology.com/nonlinearregression/usefulequations#logistic_curve; archived at https://perma.cc/8WFX-FCEQ
#https://github.com/OnofriAndreaPG/aomisc/blob/1eb698b3bc5f55a718c37bfd2028b9ac73a6fbbe/R/SSL.R; archived at https://perma.cc/94CM-PSGY

library("viridis")

#Log-Logistic Function nlsL.2 (similar to L.3 from drc package)
L2.fun <- function(predictor, a, b) {
  x <- predictor
  1/(1 + exp( - a* (x - b)))
}

L2.Init <- function(mCall, LHS, data, ...) {
  xy <- sortedXyData(mCall[["predictor"]], LHS, data)
  x <- xy[, "x"]; y <- xy[, "y"]
  d <- 1
  ## Linear regression on pseudo y values
  pseudoY <- log((d - y)/(y+0.00001))
  coefs <- coef( lm(pseudoY ~ x))
  k <- coefs[1]; a <- - coefs[2]
  b <- k/a
  value <- c(a, b)
  names(value) <- mCall[c("a", "b")]
  value
}

NLS.L2 <- selfStart(L2.fun, L2.Init, parameters = c("a", "b"))

twoPLitem1 <- nls(item1 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem2 <- nls(item2 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem3 <- nls(item3 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem4 <- nls(item4 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem5 <- nls(item5 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem6 <- nls(item6 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem7 <- nls(item7 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem8 <- nls(item8 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem9 <- nls(item9 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))
twoPLitem10 <- nls(item10 ~ NLS.L2(itemSum, a, b), data = empiricalICCdata, control = list(warnOnly = TRUE))

newdata <- data.frame(itemSum = seq(from = 1, to = 9, length.out = 1000))
newdata$item1 <- predict(twoPLitem1, newdata = newdata)
newdata$item2 <- predict(twoPLitem2, newdata = newdata)
newdata$item3 <- predict(twoPLitem3, newdata = newdata)
newdata$item4 <- predict(twoPLitem4, newdata = newdata)
newdata$item5 <- predict(twoPLitem5, newdata = newdata)
newdata$item6 <- predict(twoPLitem6, newdata = newdata)
newdata$item7 <- predict(twoPLitem7, newdata = newdata)
newdata$item8 <- predict(twoPLitem8, newdata = newdata)
newdata$item9 <- predict(twoPLitem9, newdata = newdata)
newdata$item10 <- predict(twoPLitem10, newdata = newdata)
newdata$itemTotal <- rowSums(newdata[,paste("item", 1:10, sep = "")])
```

```{r modelImpliedICC, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves of the Probability of Endorsement of a Given Item as a Function of the Person's Level on the Latent Construct."}
plot(newdata$itemSum, newdata$item1, type = "n", ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n")
lines(newdata$itemSum, newdata$item1, type = "l", lwd = 2, col = viridis(10)[1])
lines(newdata$itemSum, newdata$item2, type = "l", lwd = 2, col = viridis(10)[2])
lines(newdata$itemSum, newdata$item3, type = "l", lwd = 2, col = viridis(10)[3])
lines(newdata$itemSum, newdata$item4, type = "l", lwd = 2, col = viridis(10)[4])
lines(newdata$itemSum, newdata$item5, type = "l", lwd = 2, col = viridis(10)[5])
lines(newdata$itemSum, newdata$item6, type = "l", lwd = 2, col = viridis(10)[6])
lines(newdata$itemSum, newdata$item7, type = "l", lwd = 2, col = viridis(10)[7])
lines(newdata$itemSum, newdata$item8, type = "l", lwd = 2, col = viridis(10)[8])
lines(newdata$itemSum, newdata$item9, type = "l", lwd = 2, col = viridis(10)[9])
lines(newdata$itemSum, newdata$item10, type = "l", lwd = 2, col = viridis(10)[10])
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
legend("topleft", legend = paste("item", 1:10, sep = " "), col = viridis(10), lwd = 2, cex = 0.6)
```

ICCs can be summed across items to get the test characteristic curve (TCC):\index{item response theory!item characteristic curve}\index{item response theory!test characteristic curve}

```{r modelImpliedTCC, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve of the Expected Total Score on the Test as a Function of the Person's Level on the Latent Construct."}
plot(newdata$itemSum, newdata$itemTotal, type = "n", ylim = c(0,10), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Expected Total Score on Test", xaxt = "n")
lines(newdata$itemSum, newdata$itemTotal, type = "l", lwd = 2)
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
```

An ICC provides more information than an [item–total correlation](#itemTotalCorrelation-reliability).\index{item response theory!item characteristic curve}\index{reliability!internal consistency!average item–total correlation}
Visually, we can see the utility of various items by looking at the items' ICC plots.\index{item response theory!item characteristic curve}
For instance, consider what might be a useless item for diagnostic purposes.\index{item response theory!item characteristic curve}
For a particular item, among those with a low total score (level on the construct), 90% respond with "TRUE" to the item, whereas among everyone else, 100% respond with "TRUE" (see Figure \@ref(fig:iccCeilingEffect)).\index{item response theory!item characteristic curve}
This item has a ceiling effect and provides only a little information about who would be considered above clinical threshold for a disorder.\index{item response theory!item characteristic curve}\index{ceiling effect}
So, the item is not very clinically useful.\index{item response theory!item characteristic curve}

```{r, include = FALSE}
library("drc")

empiricalICCdata$ceilingEffect <- c(.90, .95, .98, 1, 1, 1, 1, 1, 1)
empiricalICCdata$diagnosticallyUseful <- c(0, 0, 0, 0, 0, 0, .69, .70, .70)

threePL_ceilingeffect <- drm(ceilingEffect ~ itemSum, data = empiricalICCdata, fct = LL.3u(), type = "continuous") #fix upper asymptote at 1
threePL_diagnosticallyUseful <- drm(diagnosticallyUseful ~ itemSum, data = empiricalICCdata, fct = LL.3(), type = "continuous") #fix lower asymptote at 0

newdata$ceilingEffect <- predict(threePL_ceilingeffect, newdata = newdata)
newdata$diagnosticallyUseful <- predict(threePL_diagnosticallyUseful, newdata = newdata)
```

```{r iccCeilingEffect, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curve of an Item with a Ceiling Effect That is not Diagnostically Useful."}
plot(newdata$itemSum, newdata$ceilingEffect, type = "l", lwd = 2, ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n")
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
```

Now, consider a different item.\index{item response theory!item characteristic curve}
For those with a low level on the construct, 0% respond with "TRUE", so it has a floor effect and tells us nothing about the lower end of the construct.\index{item response theory!item characteristic curve}
But for those with a higher level on the construct, 70% respond with true (see Figure \@ref(fig:iccDiagnosticallyUseful)).\index{item response theory!item characteristic curve}
So, the item tells us something about the higher end of the distribution, and could be diagnostically useful.\index{item response theory!item characteristic curve}
Thus, an ICC allows us to immediately tell the utility of items.\index{item response theory!item characteristic curve}

```{r iccDiagnosticallyUseful, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curve of an Item With a Floor Effect That is Diagnostically Useful."}
plot(newdata$itemSum, newdata$diagnosticallyUseful, type = "l", lwd = 2, ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n")
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
```

### Parameters {#parameters-irt}

We can estimate up to four parameters in an IRT model and can glean up to four key pieces of information from an item's ICC:\index{item response theory}\index{item response theory!item characteristic curve}

1. Difficulty (severity)\index{item response theory!item difficulty}
1. Discrimination\index{item response theory!item discrimination}
1. Guessing\index{item response theory!item guessing}
1. Inattention/careless errors\index{item response theory!item careless errors}

#### Difficulty (Severity) {#itemDifficulty}

The item's *difficulty* parameter is the item's location on the latent construct.\index{item response theory!item difficulty}
It is quantified by the intercept, i.e., the location on the x-axis of the inflection point of the [ICC](#icc).\index{item response theory!item difficulty}\index{item response theory!item characteristic curve}
In a 1- or 2-parameter model, the inflection point is where 50% of the sample endorses the item (or gets the item correct), that is, the point on the x-axis where the [ICC](#icc) crosses .5 probability on the y-axis (i.e., the level on the construct at which the probability of endorsing the item is equal to the probability of not endorsing the item).\index{item response theory!item difficulty}\index{item response theory!item characteristic curve}
Item difficulty is similar to item means or intercepts in [structural equation modeling](#sem) or [factor analysis](#factorAnalysis).\index{item response theory!item difficulty}\index{structural equation modeling!intercept}
Some items are more useful at the higher levels of the construct, whereas other items are more useful at the lower levels of the construct.
See Figure \@ref(fig:iccDifficulty) for an example of an item with a low difficulty and an item with a high difficulty.\index{item response theory!item difficulty}

```{r, include = FALSE}
library("tidyverse")
library("psych")

difficultyData <- data.frame(itemSum = 1:length(-4:4))

difficultyData$lowDifficulty <- psych::logistic(-4:4, d = -0.8)
difficultyData$highDifficulty <- psych::logistic(-4:4, d = 0.8)

L1.fun <- function(predictor, b) {
  x <- predictor
  1/(1 + exp( -(x - b)))
}

L1.Init <- function(mCall, LHS, data, ...) {
  xy <- sortedXyData(mCall[["predictor"]], LHS, data)
  x <- xy[, "x"]; y <- xy[, "y"]
  d <- 1
  ## Linear regression on pseudo y values
  pseudoY <- log((d - y)/(y+0.00001))
  coefs <- coef( lm(pseudoY ~ x))
  k <- coefs[1]
  b <- coefs[2]
  value <- c(b)
  names(value) <- mCall[c("b")]
  value
}

NLS.L1 <- selfStart(L1.fun, L1.Init, parameters = c("b"))

onePL_lowDifficulty <- nls(lowDifficulty ~ NLS.L1(itemSum, b), data = difficultyData, control = list(warnOnly = TRUE))
onePL_highDifficulty <- nls(highDifficulty ~ NLS.L1(itemSum, b), data = difficultyData, control = list(warnOnly = TRUE))

newdata$lowDifficulty <- predict(onePL_lowDifficulty, newdata = newdata)
newdata$highDifficulty <- predict(onePL_highDifficulty, newdata = newdata)

newdata$theta <- seq(from = -4, to = 4, length.out = 1000)

midpoint_lowDifficulty <- newdata$theta[which.min(abs(newdata$lowDifficulty - 0.5))]
midpoint_highDifficulty <- newdata$theta[which.min(abs(newdata$highDifficulty - 0.5))]

difficulty_long <- pivot_longer(newdata, cols = lowDifficulty:highDifficulty) %>%
  rename(item = name)

difficulty_long$Difficulty <- NA
difficulty_long$Difficulty[which(difficulty_long$item == "lowDifficulty")] <- "Low"
difficulty_long$Difficulty[which(difficulty_long$item == "highDifficulty")] <- "High"
```

(ref:iccDifficulty) Item Characteristic Curves of an Item With Low Difficulty Versus High Difficulty. The dashed horizontal line indicates a probability of item endorsement of .50. The dashed vertical line is the item difficulty, i.e., the person's level on the construct (the location on the x-axis) at the inflection point of the item characteristic curve. In a two-parameter logistic model, the inflection point corresponds to the probability of item endorsement is 50%. Thus, in a two-parameter logistic model, the difficulty of an item is the person's level on the construct where the probability of endorsing the item is 50%.

```{r iccDifficulty, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "(ref:iccDifficulty)", fig.scap = "Item Characteristic Curves of an Item With Low Difficulty Versus High Difficulty."}
ggplot(difficulty_long, aes(theta, value, group = Difficulty, color = Difficulty)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  geom_hline(yintercept = 0.5, linetype = "dashed") +
  geom_segment(aes(x = midpoint_lowDifficulty, xend = midpoint_lowDifficulty, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  geom_segment(aes(x = midpoint_highDifficulty, xend = midpoint_highDifficulty, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

When dealing with a measure of clinical symptoms (e.g., depression), the difficulty parameter is sometimes called severity, because symptoms that are endorsed less frequently tend to be more severe [e.g., suicidal behavior; @Krueger2004].\index{item response theory!item difficulty}
One way of thinking about the severity parameter of an item is: "How severe does your psychopathology have to be for half of people to endorse the symptom?"\index{item response theory!item difficulty}

When dealing with a measure of performance, aptitude, or intelligence, the parameter would be more likely to be called difficulty: "How high does your ability have to be for half of people to pass the item?"\index{item response theory!item difficulty}
An item with a low difficulty would be considered easy, because even people with a low ability tend to pass the item.\index{item response theory!item difficulty}
An item with a high difficulty would be considered difficult, because only people with a high ability tend to pass the item.\index{item response theory!item difficulty}

#### Discrimination {#itemDiscrimination}

The item's *discrimination* parameter is how well the item can distinguish between those who were higher versus lower on the construct, that is, how strongly the item is correlated with the construct (i.e., the latent factor).\index{item response theory!item discrimination}
It is similar to the factor loading in [structural equation modeling](#sem) or [factor analysis](#factorAnalysis).\index{item response theory!item discrimination}\index{structural equation modeling!factor loading}
It is quantified by the slope of the [ICC](#icc), i.e., the steepness of the line at its steepest point.\index{item response theory!item discrimination}\index{item response theory!item characteristic curve}
The slope reflects the inverse of how much range of construct levels it would take to flip 50/50 whether a person is likely to pass or fail an item.\index{item response theory!item discrimination}

Some items have [ICCs](#icc) that go up fast (have a steep slope).\index{item response theory!item discrimination}\index{item response theory!item characteristic curve}
These items provide a fine distinction between people with lower versus higher levels on the construct and therefore have high discrimination.\index{item response theory!item discrimination}
Some items go up gradually (less steep slope), so it provides less precision and information, and has a low discrimination.\index{item response theory!item discrimination}\index{item response theory!item characteristic curve}\index{item response theory!information}
See Figure \@ref(fig:iccDiscrimination) for an example of an item with a low discrimination and an item with a high discrimination.\index{item response theory!item discrimination}\index{item response theory!item characteristic curve}

```{r, include = FALSE}
discriminationData <- data.frame(itemSum = 1:length(-4:4))

discriminationData$lowDiscrimination <- psych::logistic(-4:4, d = 0, a = 0.7)
discriminationData$highDiscrimination <- psych::logistic(-4:4, d = 0, a = 2)

twoPL_lowDiscrimination <- nls(lowDiscrimination ~ NLS.L2(itemSum, a, b), data = discriminationData, control = list(warnOnly = TRUE))
twoPL_highDiscrimination <- nls(highDiscrimination ~ NLS.L2(itemSum, a, b), data = discriminationData, control = list(warnOnly = TRUE))

newdata$lowDiscrimination <- predict(twoPL_lowDiscrimination, newdata = newdata)
newdata$highDiscrimination <- predict(twoPL_highDiscrimination, newdata = newdata)

newdata$theta <- seq(from = -4, to = 4, length.out = 1000)

discrimination_long <- pivot_longer(newdata, cols = lowDiscrimination:highDiscrimination) %>%
  rename(item = name)

discrimination_long$Discrimination <- NA
discrimination_long$Discrimination[which(discrimination_long$item == "lowDiscrimination")] <- "Low"
discrimination_long$Discrimination[which(discrimination_long$item == "highDiscrimination")] <- "High"
```

```{r iccDiscrimination, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves of an Item With Low Discrimination Versus High Discrimination. The discrimination of an item is the slope of the line at its inflection point.", fig.scap = "Item Characteristic Curves of an Item With Low Discrimination Versus High Discrimination."}
ggplot(discrimination_long, aes(theta, value, group = Discrimination, color = Discrimination)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

#### Guessing {#itemGuessing}

The item's *guessing* parameter is reflected by the lower asymptote of the [ICC](#icc).\index{item response theory!item guessing}
If the item has a lower asymptote above zero, it suggests that the probability of getting the item correct (or endorsing the item) never reaches zero, for any level of the construct.\index{item response theory!item guessing}
On an educational test, this could correspond to the person's likelihood of being able to answer the item correctly by chance just by guessing.\index{item response theory!item guessing}
For example, for a 4-option multiple choice test, a respondent would be expected to get a given item correct 25% of the time just by guessing.\index{item response theory!item guessing}
See Figure \@ref(fig:iccGuessingTF) for an example of an item from a true/false exam and Figure \@ref(fig:iccGuessingMC) for an example of an item from a 4-option multiple choice exam.\index{item response theory!item guessing}

```{r, include = FALSE}
empiricalICCdata$guessingTF <- psych::logistic(-4:4, c = 0.5)
empiricalICCdata$guessingMC <- psych::logistic(-4:4, c = 0.25)

threePL_guessingTF <- drm(guessingTF ~ itemSum, data = empiricalICCdata, fct = LL.3u(), type = "continuous") #fix upper asymptote at 1
threePL_guessingMC <- drm(guessingMC ~ itemSum, data = empiricalICCdata, fct = LL.3u(), type = "continuous") #fix upper asymptote at 1

newdata$guessingTF <- predict(threePL_guessingTF, newdata = newdata)
newdata$guessingMC <- predict(threePL_guessingMC, newdata = newdata)
```

(ref:iccGuessingTFCaption) Item Characteristic Curve of an Item from a True/False Exam, There Test Takers Get the Item Correct at Least 50% of the Time.

```{r iccGuessingTF, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "(ref:iccGuessingTFCaption)"}
plot(newdata$itemSum, newdata$guessingTF, type = "l", lwd = 2, ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n", yaxt = "n")
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
axis(2, at = c(0, .25, .5, .75, 1), labels = c(0, .25, .5, .75, 1))
```

(ref:iccGuessingMCCaption) Item Characteristic Curve of an Item From a 4-Option Multiple Choice Exam, Where Test Takers Get the Item Correct at Least 25% of the Time.

```{r iccGuessingMC, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "(ref:iccGuessingMCCaption)"}
plot(newdata$itemSum, newdata$guessingMC, type = "l", lwd = 2, ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n", yaxt = "n")
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
axis(2, at = c(0, .25, .5, .75, 1), labels = c(0, .25, .5, .75, 1))
```

#### Inattention/Careless Errors {#itemCarelessErrors}

The item's *inattention* (or *careless error*) parameter is the reflected by the upper asymptote of the [ICC](#icc).\index{item response theory!item careless errors}
If the item has an upper asymptote below one, it suggests that the probability of getting the item correct (or endorsing the item) never reaches one, for any level on the construct.\index{item response theory!item careless errors}
See Figure \@ref(fig:iccInattention) for an example of an item whose probability of endorsement (or getting it correct) exceeds .85.\index{item response theory!item careless errors}

```{r, include = FALSE}
empiricalICCdata$inattention <- psych::logistic(-4:4, z = 0.85, a = 2)

threePL_inattention <- drm(inattention ~ itemSum, data = empiricalICCdata, fct = LL.3(), type = "continuous") #fix lower asymptote at 0

newdata$inattention <- predict(threePL_inattention, newdata = newdata)
```

```{r iccInattention, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curve of an Item Where the Probability of Getting an Item Correct Never Exceeds .85."}
plot(newdata$itemSum, newdata$inattention, type = "l", lwd = 2, ylim = c(0,1), xlab = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), ylab = "Probability of Item Endorsement", xaxt = "n")
axis(1, at = seq(from = 1, to = 9, length.out = 9), labels = c(-4:4))
```

### Models {#models-irt}

IRT models can be fit that estimate one or more of these four item parameters.\index{item response theory}

#### 1-Parameter and Rasch models {#onePL}

A Rasch model estimates the [item difficulty](#itemDifficulty) parameter and holds everything else fixed across items.\index{item response theory!one-parameter model}\index{item response theory!item difficulty}
It fixes the [item discrimination](#itemDiscrimination) to be one for each item.\index{item response theory!one-parameter model}\index{item response theory!item discrimination}
In the Rasch model, the probability that a person $j$ with a level on the construct of $\theta$ gets a score of one (instead of zero) on item $i$, based on the difficulty ($b$) of the item, is estimated using Equation \@ref(eq:raschModel):\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!theta}

\begin{equation}
P(X = 1|\theta_j, b_i) = \frac{e^{\theta_j - b_i}}{1 + e^{\theta_j - b_i}}
(\#eq:raschModel)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `fourPL()` function that estimates the probability of item endorsement as function of the item characteristics from the Rasch model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!theta}
To estimate the probability of endorsement from the Rasch model, specify $b$ and $\theta$, while keeping the defaults for the other parameters.\index{item response theory!theta}

```{r, class.source = "fold-hide"}
library("petersenlab") #to install: install.packages("remotes"); remotes::install_github("DevPsyLab/petersenlab")
```

```{r, eval = FALSE, class.source = "fold-hide"}
fourPL <- function(a = 1, b, c = 0, d = 1, theta){
  c + (d - c) * (exp(a * (theta - b))) / (1 + exp(a * (theta - b)))
}
```

```{r, eval = FALSE}
fourPL(b, theta)
```

```{r}
fourPL(b = 1, theta = 0)
```

A one-parameter logistic (1-PL) IRT model, similar to a Rasch model, estimates the [item difficulty](#itemDifficulty) parameter, and holds everything else fixed across items (see Figure \@ref(fig:irt1PL)).\index{item response theory!one-parameter model}\index{item response theory!item difficulty}
The one-parameter logistic model holds the [item discrimination](#itemDiscrimination) fixed across items, but does not fix it to one, unlike the Rasch model.\index{item response theory!one-parameter model}\index{item response theory!item difficulty}

In the one-parameter logistic model, the probability that a person $j$ with a level on the construct of $\theta$ gets a score of one (instead of zero) on item $i$, based on the [difficulty](#itemDifficulty) ($b$) of the item and the items' (fixed) [discrimination](#itemDiscrimination) ($a$), is estimated using Equation \@ref(eq:onePL):\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!theta}

\begin{equation}
P(X = 1|\theta_j, b_i, a) = \frac{e^{a(\theta_j - b_i)}}{1 + e^{a(\theta_j - b_i)}}
(\#eq:onePL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `fourPL()` function that estimates the probability of item endorsement as function of the item characteristics from the one-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory!one-parameter model}\index{item response theory!theta}
To estimate the probability of endorsement from the one-parameter logistic model, specify $a$, $b$, and $\theta$, while keeping the defaults for the other parameters.\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!theta}

```{r, eval = FALSE}
fourPL(a, b, theta)
```

Rasch and one-parameter logistic models are common and are the easiest to fit.\index{item response theory!one-parameter model}\index{item response theory!item difficulty}
However, they make fairly strict assumptions.
They assume that items have the same [discrimination](#itemDiscrimination).\index{item response theory!one-parameter model}\index{item response theory!item discrimination}

```{r, include = FALSE}
library("tidyverse")

onePLitems <- data.frame(
  theta = -4:4,
  item1 = fourPL(b = -2, theta = -4:4),
  item2 = fourPL(b = -1, theta = -4:4),
  item3 = fourPL(b = 0, theta = -4:4),
  item4 = fourPL(b = 1, theta = -4:4),
  item5 = fourPL(b = 2, theta = -4:4))

onePL_item1 <- nls(item1 ~ NLS.L1(theta, b), data = onePLitems, control = list(warnOnly = TRUE))
onePL_item2 <- nls(item2 ~ NLS.L1(theta, b), data = onePLitems, control = list(warnOnly = TRUE))
onePL_item3 <- nls(item3 ~ NLS.L1(theta, b), data = onePLitems, control = list(warnOnly = TRUE))
onePL_item4 <- nls(item4 ~ NLS.L1(theta, b), data = onePLitems, control = list(warnOnly = TRUE))
onePL_item5 <- nls(item5 ~ NLS.L1(theta, b), data = onePLitems, control = list(warnOnly = TRUE))

onePLitems_newdata <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

onePLitems_newdata$item1 <- predict(onePL_item1, newdata = onePLitems_newdata)
onePLitems_newdata$item2 <- predict(onePL_item2, newdata = onePLitems_newdata)
onePLitems_newdata$item3 <- predict(onePL_item3, newdata = onePLitems_newdata)
onePLitems_newdata$item4 <- predict(onePL_item4, newdata = onePLitems_newdata)
onePLitems_newdata$item5 <- predict(onePL_item5, newdata = onePLitems_newdata)

onePLitems_long <- pivot_longer(onePLitems_newdata, cols = item1:item5) %>%
  rename(item = name)

onePLitems_long$Item <- NA
onePLitems_long$Item[which(onePLitems_long$item == "item1")] <- 1
onePLitems_long$Item[which(onePLitems_long$item == "item2")] <- 2
onePLitems_long$Item[which(onePLitems_long$item == "item3")] <- 3
onePLitems_long$Item[which(onePLitems_long$item == "item4")] <- 4
onePLitems_long$Item[which(onePLitems_long$item == "item5")] <- 5
```

```{r irt1PL, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "One-Parameter Logistic Model in Item Response Theory."}
ggplot(onePLitems_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

A one-parameter logistic model is only valid if there is not crossing of lines in empirical [ICCs](#icc) (see Figure \@ref(fig:empiricalICCnoCrossing)).\index{item response theory!one-parameter model}\index{item response theory!item characteristic curve}

```{r, include = FALSE}
empiricalICCdata_noCrossing <- data.frame(
  item1 =  c(.40, .63, .73, .85, .93, .95, .97, .99, .99),
  item2 =  c(.20, .53, .56, .76, .90, .94, .95, .98, .99),
  item3 =  c(.10, .28, .39, .58, .75, .82, .88, .94, .99),
  item4 =  c(.05, .24, .30, .50, .68, .73, .84, .92, .99),
  item5 =  c(.03, .19, .27, .48, .57, .65, .79, .89, .99),
  item6 =  c(.02, .15, .25, .38, .48, .59, .75, .85, .95),
  item7 =  c(.01, .07, .15, .29, .42, .53, .70, .82, .90),
  item8 =  c(.01, .05, .10, .26, .35, .46, .60, .80, .85),
  item9 =  c(.01, .02, .05, .16, .23, .35, .46, .55, .70),
  item10 = c(.01, .02, .03, .05, .06, .07, .10, .14, .20),
  itemSum = 1:9
)
```

```{r empiricalICCnoCrossing, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.height = 8, fig.cap = "Empirical Item Characteristic Curves of the Probability of Endorsement of a Given Item as a Function of the Person's Sum Score. The empirical item characteristic curves of these items do not cross each other.", fig.scap = "Empirical Item Characteristic Curves of the Probability of Endorsement of a Given Item as a Function of the Person's Sum Score."}
plot(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item10, type = "n", xlim = c(1,9), ylim = c(0,1), xlab = "Person's Sum Score", ylab = "Probability of Item Endorsement", xaxt = "n")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item1, type = "b", pch = "1")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item2, type = "b", pch = "2")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item3, type = "b", pch = "3")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item4, type = "b", pch = "4")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item5, type = "b", pch = "5")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item6, type = "b", pch = "6")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item7, type = "b", pch = "7")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item8, type = "b", pch = "8")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item9, type = "b", pch = "9")
lines(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item10, type = "l")
points(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item10, type = "p", pch = 19, col = "white", cex = 3)
text(empiricalICCdata_noCrossing$itemSum, empiricalICCdata_noCrossing$item10, labels = "10")
axis(1, at = 1:9, labels = 1:9)
```

#### 2-Parameter {#twoPL}

A two-parameter logistic (2-PL) IRT model estimates item [difficulty](#itemDifficulty) and [discrimination](#itemDiscrimination), and it holds the asymptotes fixed across items (see Figure \@ref(fig:irt2PL)).\index{item response theory!two-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
Two-parameter logistic models are also common.\index{item response theory!two-parameter model}

In the two-parameter logistic model, the probability that a person $j$ with a level on the construct of $\theta$ gets a score of one (instead of zero) on item $i$, based on the [difficulty](#itemDifficulty) ($b$) and [discrimination](#itemDiscrimination) ($a$) of the item, is estimated using Equation \@ref(eq:twoPL):\index{item response theory!two-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!theta}

\begin{equation}
P(X = 1|\theta_j, b_i, a_i) = \frac{e^{a_i(\theta_j - b_i)}}{1 + e^{a_i(\theta_j - b_i)}}
(\#eq:twoPL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `fourPL()` function that estimates the probability of item endorsement as function of the item characteristics from the two-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory!two-parameter model}\index{item response theory!theta}
To estimate the probability of endorsement from the two-parameter logistic model, specify $a$, $b$, and $\theta$, while keeping the defaults for the other parameters.\index{item response theory!two-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!theta}

```{r, eval = FALSE}
fourPL(a, b, theta)
```

```{r}
fourPL(a = 0.6, b = 0, theta = -1)
```

```{r, include = FALSE}
twoPLitems <- data.frame(theta = -6:6,
                         item1 = fourPL(a = 1.3, b = -2, theta = -6:6),
                         item2 = fourPL(a = 0.8, b = -1, theta = -6:6),
                         item3 = fourPL(a = 0.6, b = 0, theta = -6:6),
                         item4 = fourPL(a = 1.5, b = 1, theta = -6:6),
                         item5 = fourPL(a = 2.3, b = 2, theta = -6:6))

twoPL_item1 <- nls(item1 ~ NLS.L2(theta, a, b), data = twoPLitems, control = list(warnOnly = TRUE))
twoPL_item2 <- nls(item2 ~ NLS.L2(theta, a, b), data = twoPLitems, control = list(warnOnly = TRUE))
twoPL_item3 <- nls(item3 ~ NLS.L2(theta, a, b), data = twoPLitems, control = list(warnOnly = TRUE))
twoPL_item4 <- nls(item4 ~ NLS.L2(theta, a, b), data = twoPLitems, control = list(warnOnly = TRUE))
twoPL_item5 <- nls(item5 ~ NLS.L2(theta, a, b), data = twoPLitems, control = list(warnOnly = TRUE))

twoPLitems_newdata <- data.frame(theta = seq(from = -6, to = 6, length.out = 1000))

twoPLitems_newdata$item1 <- predict(twoPL_item1, newdata = twoPLitems_newdata)
twoPLitems_newdata$item2 <- predict(twoPL_item2, newdata = twoPLitems_newdata)
twoPLitems_newdata$item3 <- predict(twoPL_item3, newdata = twoPLitems_newdata)
twoPLitems_newdata$item4 <- predict(twoPL_item4, newdata = twoPLitems_newdata)
twoPLitems_newdata$item5 <- predict(twoPL_item5, newdata = twoPLitems_newdata)

twoPLitems_long <- pivot_longer(twoPLitems_newdata, cols = item1:item5) %>%
  rename(item = name)

twoPLitems_long$Item <- NA
twoPLitems_long$Item[which(twoPLitems_long$item == "item1")] <- 1
twoPLitems_long$Item[which(twoPLitems_long$item == "item2")] <- 2
twoPLitems_long$Item[which(twoPLitems_long$item == "item3")] <- 3
twoPLitems_long$Item[which(twoPLitems_long$item == "item4")] <- 4
twoPLitems_long$Item[which(twoPLitems_long$item == "item5")] <- 5
```

```{r irt2PL, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Two-Parameter Logistic Model in Item Response Theory."}
ggplot(twoPLitems_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = seq(from = -6, to = 6, by = 2), limits = c(-6,6)) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

#### 3-Parameter {#threePL}

A three-parameter logistic (3-PL) IRT model estimates item [difficulty](#itemDifficulty), [discrimination](#itemDiscrimination), and [guessing](#itemGuessing) (lower asymptote), and it holds the upper asymptote fixed across items (see Figure \@ref(fig:irt3PL)).\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}
This model would provide information about where an item drops out.\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}
Three-parameter logistic models are less common to estimate because it adds considerable computational complexity and requires a large sample size, and the [guessing](#itemGuessing) parameter is often not as important as [difficulty](#itemDifficulty) and [discrimination](#itemDiscrimination).\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}
Nevertheless, 3-parameter logistic models are sometimes estimated in the education literature to account for getting items correct by random guessing.\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}

In the three-parameter logistic model, the probability that a person $j$ with a level on the construct of $\theta$ gets a score of one (instead of zero) on item $i$, based on the [difficulty](#itemDifficulty) ($b$), [discrimination](#itemDiscrimination) ($a$), and [guessing parameter](#itemGuessing) ($c$) of the item, is estimated using Equation \@ref(eq:threePL):\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!theta}

\begin{equation}
P(X = 1|\theta_j, b_i, a_i, c_i) = c_i + (1 - c_i) \frac{e^{a_i(\theta_j - b_i)}}{1 + e^{a_i(\theta_j - b_i)}}
(\#eq:threePL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `fourPL()` function that estimates the probability of item endorsement as function of the item characteristics from the three-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory!three-parameter model}\index{item response theory!item guessing}\index{item response theory!theta}
To estimate the probability of endorsement from the three-parameter logistic model, specify $a$, $b$, $c$, and $\theta$, while keeping the defaults for the other parameters.\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!theta}

```{r, eval = FALSE}
fourPL(a, b, c, theta)
```

```{r}
fourPL(a = 0.8, b = -1, c = .25, theta = -1)
```

```{r, include = FALSE}
threePLitems <- data.frame(theta = 1:13,
                           item1 = fourPL(a = 1.3, b = -2, c = 0, theta = -6:6),
                           item2 = fourPL(a = 0.8, b = -1, c = .25, theta = -6:6),
                           item3 = fourPL(a = 0.6, b = 0, c = .3, theta = -6:6),
                           item4 = fourPL(a = 1.5, b = 1, c = .15, theta = -6:6),
                           item5 = fourPL(a = 2.3, b = 2, c = 0, theta = -6:6))

threePL_item1 <- drm(item1 ~ theta, data = threePLitems, fct = LL.3u(), type = "continuous")
threePL_item2 <- drm(item2 ~ theta, data = threePLitems, fct = LL.3u(), type = "continuous")
threePL_item3 <- drm(item3 ~ theta, data = threePLitems, fct = LL.3u(), type = "continuous")
threePL_item4 <- drm(item4 ~ theta, data = threePLitems, fct = LL.3u(), type = "continuous")
threePL_item5 <- drm(item5 ~ theta, data = threePLitems, fct = LL.3u(), type = "continuous")

threePLitems_newdata <- data.frame(theta = seq(from = 1, to = 13, length.out = 1000))

threePLitems_newdata$item1 <- predict(threePL_item1, newdata = threePLitems_newdata)
threePLitems_newdata$item2 <- predict(threePL_item2, newdata = threePLitems_newdata)
threePLitems_newdata$item3 <- predict(threePL_item3, newdata = threePLitems_newdata)
threePLitems_newdata$item4 <- predict(threePL_item4, newdata = threePLitems_newdata)
threePLitems_newdata$item5 <- predict(threePL_item5, newdata = threePLitems_newdata)

threePLitems_newdata$theta <- seq(from = -6, to = 6, length.out = 1000)

threePLitems_long <- pivot_longer(threePLitems_newdata, cols = item1:item5) %>%
  rename(item = name)

threePLitems_long$Item <- NA
threePLitems_long$Item[which(threePLitems_long$item == "item1")] <- 1
threePLitems_long$Item[which(threePLitems_long$item == "item2")] <- 2
threePLitems_long$Item[which(threePLitems_long$item == "item3")] <- 3
threePLitems_long$Item[which(threePLitems_long$item == "item4")] <- 4
threePLitems_long$Item[which(threePLitems_long$item == "item5")] <- 5
```

```{r irt3PL, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Three-Parameter Logistic Model in Item Response Theory."}
ggplot(threePLitems_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = seq(from = -6, to = 6, by = 2), limits = c(-6,6)) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

#### 4-Parameter {#fourPL}

A four-parameter logistic (4-PL) IRT model estimates item [difficulty](#itemDifficulty), [discrimination](#itemDiscrimination), [guessing](#itemGuessing), and [careless errors](#itemCarelessErrors) (see Figure \@ref(fig:irt4PL)).\index{item response theory!four-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!item careless errors}
The fourth parameter adds considerable computational complexity and is rare to estimate.\index{item response theory!four-parameter model}

In the four-parameter logistic model, the probability that a person $j$ with a level on the construct of $\theta$ gets a score of one (instead of zero) on item $i$, based on the [difficulty](#itemDifficulty) ($b$), [discrimination](#itemDiscrimination) ($a$), [guessing parameter](#itemGuessing) ($c$), and [careless error parameter](#itemCarelessErrors) ($d$) of the item, is estimated using Equation \@ref(eq:fourPL) [@Magis2013]:\index{item response theory!four-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!item careless errors}\index{item response theory!theta}

\begin{equation}
P(X = 1|\theta_j, b_i, a_i, c_i, d_i) = c_i + (d_i - c_i) \frac{e^{a_i(\theta_j - b_i)}}{1 + e^{a_i(\theta_j - b_i)}}
(\#eq:fourPL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `fourPL()` function that estimates the probability of item endorsement as function of the item characteristics from the four-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}
To estimate the probability of endorsement from the four-parameter logistic model, specify $a$, $b$, $c$, $d$, and $\theta$.\index{item response theory!four-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!item careless errors}\index{item response theory!theta}

```{r, eval = FALSE}
fourPL(a, b, c, d, theta)
```

```{r}
fourPL(a = 1.5, b = 1, c = .15, d = 0.85, theta = 3)
```

```{r, include = FALSE}
fourPLitems <- data.frame(theta = 1:13,
                          item1 = fourPL(a = 1.3, b = -2, c = 0, d = 1, theta = -6:6),
                          item2 = fourPL(a = 0.8, b = -1, c = .25, d = 0.9, theta = -6:6),
                          item3 = fourPL(a = 0.6, b = 0, c = .3, d = 0.95, theta = -6:6),
                          item4 = fourPL(a = 1.5, b = 1, c = .15, d = 0.85, theta = -6:6),
                          item5 = fourPL(a = 2.3, b = 2, c = 0, d = 0.98, theta = -6:6))

fourPL_item1 <- drm(item1 ~ theta, data = fourPLitems, fct = LL.4(), type = "continuous")
fourPL_item2 <- drm(item2 ~ theta, data = fourPLitems, fct = LL.4(), type = "continuous")
fourPL_item3 <- drm(item3 ~ theta, data = fourPLitems, fct = LL.4(), type = "continuous")
fourPL_item4 <- drm(item4 ~ theta, data = fourPLitems, fct = LL.4(), type = "continuous")
fourPL_item5 <- drm(item5 ~ theta, data = fourPLitems, fct = LL.4(), type = "continuous")

fourPLitems_newdata <- data.frame(theta = seq(from = 1, to = 13, length.out = 1000))

fourPLitems_newdata$item1 <- predict(fourPL_item1, newdata = fourPLitems_newdata)
fourPLitems_newdata$item2 <- predict(fourPL_item2, newdata = fourPLitems_newdata)
fourPLitems_newdata$item3 <- predict(fourPL_item3, newdata = fourPLitems_newdata)
fourPLitems_newdata$item4 <- predict(fourPL_item4, newdata = fourPLitems_newdata)
fourPLitems_newdata$item5 <- predict(fourPL_item5, newdata = fourPLitems_newdata)

fourPLitems_newdata$theta <- seq(from = -6, to = 6, length.out = 1000)

fourPLitems_long <- pivot_longer(fourPLitems_newdata, cols = item1:item5) %>%
  rename(item = name)

fourPLitems_long$Item <- NA
fourPLitems_long$Item[which(fourPLitems_long$item == "item1")] <- 1
fourPLitems_long$Item[which(fourPLitems_long$item == "item2")] <- 2
fourPLitems_long$Item[which(fourPLitems_long$item == "item3")] <- 3
fourPLitems_long$Item[which(fourPLitems_long$item == "item4")] <- 4
fourPLitems_long$Item[which(fourPLitems_long$item == "item5")] <- 5
```

```{r irt4PL, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Four-Parameter Logistic Model in Item Response Theory."}
ggplot(fourPLitems_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = seq(from = -6, to = 6, by = 2), limits = c(-6,6)) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

#### Graded Response Model {#grm}

*Graded response models* and *generalized partial credit models* can be estimated with one, two, three, or four parameters.\index{item response theory!graded response model}\index{item response theory!one-parameter model}\index{item response theory!two-parameter model}\index{item response theory!three-parameter model}\index{item response theory!four-parameter model}
However, they use polytomous data (not dichotomous data), as described in the section below.\index{item response theory!graded response model}

The [two-parameter](#twoPL) graded response model takes the general form of Equation \@ref(eq:gradedResponseModel1):\index{item response theory!graded response model}\index{item response theory!two-parameter model}

\begin{equation}
P(X_{ji} = x_{ji}|\theta_j) = P^*_{x_{ji}}(\theta_j) - P^*_{x_{ji} + 1}(\theta_j)
(\#eq:gradedResponseModel1)
\end{equation}

where:

\begin{equation}
P^*_{x_{ji}}(\theta_j) = P(X_{ji} \geq x_{ji}|\theta_j, b_{ic}, a_i) = \frac{1}{1 + e^{a_i(\theta_j - b_{ic})}}
(\#eq:gradedResponseModel2)
\end{equation}

In the model, $a_i$ an item-specific [discrimination parameter](#itemDiscrimination), $b_{ic}$ is an item- and category-specific [difficulty parameter](#itemDifficulty), and $θ_n$ is an estimate of a person's standing on the latent variable.\index{item response theory!graded response model}\index{item response theory!two-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
In the model, $i$ represents unique items, $c$ represents different categories that are rated, and $j$ represents participants.\index{item response theory!graded response model}

### Type of Data {#dataTypes-irt}

IRT models are most commonly estimated with binary or dichotomous data.\index{item response theory}\index{data!dichotomous}
For example, the measures have questions or items that can be considered collapsed into two groups (e.g., true/false, correct/incorrect, endorsed/not endorsed).\index{item response theory}\index{data!dichotomous}
IRT models can also be estimated with polytomous data (e.g., likert scale), which adds computational complexity.\index{data!polytomous}\index{Likert scale}
IRT models with polytomous data can be fit with a graded response model or generalized partial credit model.\index{item response theory}\index{item response theory!graded response model}\index{data!polytomous}

For example, see Figure \@ref(fig:polytomousItemBoundaryCurves) for an example of an item boundary characteristic curve for an item from a 5-level likert scale (based on a cumulative distribution).\index{item response theory}\index{item response theory!item boundary characteristic curve}\index{Likert scale}
If an item has $k$ response categories, it has $k - 1$ thresholds.\index{item response theory}\index{item response theory!item boundary characteristic curve}
For example, an item with 5-level likert scale (1 = strongly disagree; 2 = disagree; 3 = neither agree nor disagree; 4 = agree; 5 = strongly agree) has 4 thresholds: one from 1–2, one from 2–3, one from 3–4, and one from 4–5.\index{item response theory}\index{item response theory!item boundary characteristic curve}\index{Likert scale}
The item boundary characteristic curve is the probability that a person selects a response category higher than $k$ of a polytomous item.\index{item response theory}\index{item response theory!item boundary characteristic curve}\index{data!polytomous}
As depicted, one likert scale item does equivalent work as 4 binary items.\index{item response theory}\index{item response theory!item boundary characteristic curve}\index{data!dichotomous}\index{data!polytomous}\index{Likert scale}
See Figure \@ref(fig:polytomousItemResponseCategoryCurves) for the same 5-level likert scale item plotted with an item response category characteristic curve (based on a static, non-cumulative distribution).\index{item response theory}\index{item response theory!item response category characteristic curve}\index{Likert scale}

```{r, include = FALSE}
polytomousItemBoundary <- data.frame(theta = seq(from = -4, to = 4, length.out= 1000),
                                     itemBoundary1 = psych::logistic(seq(from = -4, to = 4, length.out = 1000), d = -2),
                                     itemBoundary2 = psych::logistic(seq(from = -4, to = 4, length.out = 1000), d = -0.6667),
                                     itemBoundary3 = psych::logistic(seq(from = -4, to = 4, length.out = 1000), d = 0.6667),
                                     itemBoundary4 = psych::logistic(seq(from = -4, to = 4, length.out = 1000), d = 2))

polytomousItemResponseCategory <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))
polytomousItemResponseCategory$itemResponseCategory1 <- 1 - polytomousItemBoundary$itemBoundary1
polytomousItemResponseCategory$itemResponseCategory5 <- polytomousItemBoundary$itemBoundary4
polytomousItemResponseCategory$itemResponseCategory4 <- polytomousItemBoundary$itemBoundary3 - polytomousItemResponseCategory$itemResponseCategory5
polytomousItemResponseCategory$itemResponseCategory3 <- polytomousItemBoundary$itemBoundary2 - rowSums(polytomousItemResponseCategory[,c("itemResponseCategory4","itemResponseCategory5")])
polytomousItemResponseCategory$itemResponseCategory2 <- polytomousItemBoundary$itemBoundary1 - rowSums(polytomousItemResponseCategory[,c("itemResponseCategory3","itemResponseCategory4","itemResponseCategory5")])

polytomousItemResponseCategory <- polytomousItemResponseCategory %>%
  dplyr::select(theta, itemResponseCategory1, itemResponseCategory2, itemResponseCategory3, itemResponseCategory4, itemResponseCategory5)

polytomousItemBoundary_long <- pivot_longer(polytomousItemBoundary, cols = itemBoundary1:itemBoundary4) %>%
  rename(item = name)

polytomousItemBoundary_long$boundary <- NA
polytomousItemBoundary_long$boundary[which(polytomousItemBoundary_long$item == "itemBoundary1")] <- 1
polytomousItemBoundary_long$boundary[which(polytomousItemBoundary_long$item == "itemBoundary2")] <- 2
polytomousItemBoundary_long$boundary[which(polytomousItemBoundary_long$item == "itemBoundary3")] <- 3
polytomousItemBoundary_long$boundary[which(polytomousItemBoundary_long$item == "itemBoundary4")] <- 4

polytomousItemResponseCategory_long <- pivot_longer(polytomousItemResponseCategory, cols = itemResponseCategory1:itemResponseCategory5) %>%
  rename(item = name)

polytomousItemResponseCategory_long$responseCategory <- NA
polytomousItemResponseCategory_long$responseCategory[which(polytomousItemResponseCategory_long$item == "itemResponseCategory1")] <- 1
polytomousItemResponseCategory_long$responseCategory[which(polytomousItemResponseCategory_long$item == "itemResponseCategory2")] <- 2
polytomousItemResponseCategory_long$responseCategory[which(polytomousItemResponseCategory_long$item == "itemResponseCategory3")] <- 3
polytomousItemResponseCategory_long$responseCategory[which(polytomousItemResponseCategory_long$item == "itemResponseCategory4")] <- 4
polytomousItemResponseCategory_long$responseCategory[which(polytomousItemResponseCategory_long$item == "itemResponseCategory5")] <- 5
```

```{r polytomousItemBoundaryCurves, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Boundary Characteristic Curves From Two-Parameter Graded Response Model in Item Response Theory."}
ggplot(polytomousItemBoundary_long, aes(theta, value, group = factor(boundary), color = factor(boundary))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Boundary") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Endorsing an Item Response Category that is Higher than the Boundary") +
  theme_bw() +
  theme(axis.title.y = element_text(size = 9))
```

```{r polytomousItemResponseCategoryCurves, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Response Category Characteristic Curves From Two-Parameter Graded Response Model in Item Response Theory."}
ggplot(polytomousItemResponseCategory_long, aes(theta, value, group = factor(responseCategory), color = factor(responseCategory))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Response Category") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Response Category Endorsement") +
  theme_bw()
```

IRT does not handle continuous data well, with some exceptions [@Chen2019] such as in a Bayesian framework [@Buerkner2021].\index{item response theory}
If you want to use continuous data, you might consider moving to a [factor analysis](#factorAnalysis) framework.\index{factor analysis}

### Sample Size {#sampleSize-irt}

Sample size requirements depend on the complexity of the model.
A 1-parameter model often requires ~100 participants.\index{item response theory!one-parameter model}
A 2-parameter model often requires ~1,000 participants.\index{item response theory!two-parameter model}
A 3-parameter model often requires ~10,000 participants.\index{item response theory!three-parameter model}

### Reliability (Information) {#irtReliability}

IRT conceptualizes [reliability](#reliability) in a different way than [classical test theory](#ctt) does.\index{item response theory}\index{classical test theory}\index{item response theory!information}\index{reliability}
Both IRT and [classical test theory](#ctt) conceptualize [reliability](#reliability) as involving the *precision* of a measure's scores.\index{item response theory}\index{classical test theory}\index{item response theory!information}\index{reliability}\index{reliability!precision}
In [classical test theory](#ctt), (im)precision—as operationalized by the [standard error of measurement](#standardErrorOfMeasurement)—is estimated with a single index across the whole range of the construct.\index{classical test theory}\index{reliability}\index{reliability!precision}\index{reliability!standard error of measurement}
That is, in [classical test theory](#ctt), the same [standard error of measurement](#standardErrorOfMeasurement) applies to all scores in the population [@Embretson1996].\index{classical test theory}\index{reliability}\index{reliability!precision}\index{reliability!standard error of measurement}
However, IRT estimates how much measurement precision (information) or imprecision ([standard error of measurement](#standardErrorOfMeasurement)) each item, and the test as a whole, has at different construct levels.\index{item response theory!information}\index{reliability}
This allows IRT to conceptualize [reliability](#reliability) in such a way that precision/[reliability](#reliability) can *differ* at different construct levels, unlike in [classical test theory](#ctt) [@Embretson1996].\index{item response theory}\index{classical test theory}\index{item response theory!information}\index{reliability}
Thus, IRT does not have one index of [reliability](#reliability); rather, its estimate of [reliability](#reliability) differs at different levels on the construct.\index{item response theory}\index{classical test theory}\index{item response theory!information}\index{reliability}

Based on an item's [difficulty](#itemDifficulty) and [discrimination](#itemDiscrimination), we can calculate how much information each item provides.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
In IRT, *information* is how much measurement precision or consistency an item (or the measure) provides.\index{item response theory}\index{item response theory!information}\index{reliability}\index{reliability!precision}
In other words, information is the degree to which an item (or measure) reduces the [standard error of measurement](#standardErrorOfMeasurement), that is, how much it reduces uncertainty of a person's level on the construct.\index{item response theory}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}
As a reminder (from Equation \@ref(eq:standardErrorOfMeasurement)), the [standard error of measurement](#standardErrorOfMeasurement) is calculated as:\index{reliability!standard error of measurement}

$$
\text{standard error of measurement (SEM)} = \sigma_x \sqrt{1 - r_{xx}}
$$

where $\sigma_x = \text{standard deviation of observed scores on the item } x$, and $r_{xx} = \text{reliability of the item } x$.\index{reliability!standard error of measurement}
The [standard error of measurement](#standardErrorOfMeasurement) is used to generate confidence intervals for people's scores.\index{reliability!standard error of measurement}
In IRT, the [standard error of measurement](#standardErrorOfMeasurement) (at a given construct level) can be calculated as the inverse of the square root of the amount of test information at that construct level, as in Equation \@ref(eq:semIRT):\index{item response theory}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

\begin{equation}
\text{SEM}(\theta) = \frac{1}{\sqrt{\text{information}(\theta)}}
(\#eq:semIRT)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `standardErrorIRT()` function that estimates the [standard error of measurement](#standardErrorOfMeasurement) at a person's level on the construct (theta) from the amount of information that the item (or test) provides.\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}\index{item response theory!theta}

```{r, eval = FALSE, class.source = "fold-hide"}
standardErrorIRT <- function(information){
  1/sqrt(information)
}
```

```{r, eval = FALSE}
standardErrorIRT(information)
```

```{r}
standardErrorIRT(0.6)
```

The [standard error of measurement](#standardErrorOfMeasurement) tends to be higher (i.e., [reliability](#reliability)/information tends to be lower) at the extreme levels of the construct where there are fewer items.\index{item response theory}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}

The formula for information for item $i$ at construct level $\theta$ in a Rasch model is in Equation \@ref(eq:itemInformationRasch) [@Baker2017]:\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}

\begin{equation}
\text{information}_i(\theta) = P_i(\theta)Q_i(\theta)
(\#eq:itemInformationRasch)
\end{equation}

where $P_i(\theta)$ is the probability of getting a one instead of a zero on item $i$ at a given level on the latent construct, and $Q_i(\theta) = 1 - P_i(\theta)$.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `itemInformation()` function that estimates the amount of information an item provides as function of the item characteristics from the Rasch model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}
To estimate the amount of information an item provides in a Rasch model, specify $b$ and $\theta$, while keeping the defaults for the other parameters.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!theta}

```{r, eval = FALSE, class.source = "fold-hide"}
itemInformation <- function(a = 1, b, c = 0, d = 1, theta){
  P <- NULL
  information <- NULL

  for(i in 1:length(theta)){
    P[i] <- fourPL(b = b, a = a, c = c, d = d, theta = theta[i])
    information[i] <- ((a^2) * (P[i] - c)^2 * (d - P[i])^2) / ((d - c)^2 * P[i] * (1 - P[i]))
  }

  return(information)
}
```

```{r, eval = FALSE}
itemInformation(b, theta)
```

```{r}
itemInformation(b = 1, theta = 0)
```

The formula for information for item $i$ at construct level $\theta$ in a two-parameter logistic model is in Equation \@ref(eq:itemInformation2PL) [@Baker2017]:\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!two-parameter model}

\begin{equation}
\text{information}_i(\theta) = a^2_iP_i(\theta)Q_i(\theta)
(\#eq:itemInformation2PL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `itemInformation()` function that estimates the amount of information an item provides as function of the item characteristics from the two-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!two-parameter model}
To estimate the amount of information an item provides in a two-parameter logistic model, specify $a$, $b$, and $\theta$, while keeping the defaults for the other parameters.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!one-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!theta}

```{r, eval = FALSE}
itemInformation(a, b, theta)
```

```{r}
itemInformation(a = 0.6, b = 0, theta = -1)
```

The formula for information for item $i$ at construct level $\theta$ in a three-parameter logistic model is in Equation \@ref(eq:itemInformation3PL) [@Baker2017]:\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!three-parameter model}

\begin{equation}
\text{information}_i(\theta) = a^2_i\bigg[\frac{Q_i(\theta)}{P_i(\theta)}\bigg]\bigg[\frac{(P_i(\theta) - c_i)^2}{(1 - c_i)^2}\bigg]
(\#eq:itemInformation3PL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `itemInformation()` function that estimates the amount of information an item provides as function of the item characteristics from the three-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!three-parameter model}\index{item response theory!theta}
To estimate the amount of information an item provides in a three-parameter logistic model, specify $a$, $b$, $c$, and $\theta$, while keeping the defaults for the other parameters.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!theta}

```{r, eval = FALSE}
itemInformation(a, b, c, theta)
```

```{r}
itemInformation(a = 0.8, b = -1, c = .25, theta = -1)
```

The formula for information for item $i$ at construct level $\theta$ in a four-parameter logistic model is in Equation \@ref(eq:itemInformation4PL) [@Magis2013]:\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!four-parameter model}

\begin{equation}
\text{information}_i(\theta) = \frac{a^2_i[P_i(\theta) - c_i]^2[d_i - P_i(\theta)^2]}{(d_i - c_i)^2 P_i(\theta)[1 - P_i(\theta)]}
(\#eq:itemInformation4PL)
\end{equation}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `itemInformation()` function that estimates the amount of information an item provides as function of the item characteristics from the four-parameter logistic model and the person's level on the construct (theta).\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!four-parameter model}\index{item response theory!theta}
To estimate the amount of information an item provides in a four-parameter logistic model, specify $a$, $b$, $c$, $d$, and $\theta$.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}\index{item response theory!four-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!item careless errors}\index{item response theory!theta}

```{r, eval = FALSE}
itemInformation(a, b, c, d, theta)
```

```{r}
itemInformation(a = 1.5, b = 1, c = .15, d = 0.85, theta = 3)
```

[Reliability](#irtReliability) at a given level of the construct ($\theta$) can be estimated as in Equation \@ref(eq:reliabilityIRT):\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}

$$
\begin{aligned}
  \text{reliability}(\theta) &= \frac{\text{information}(\theta)}{\text{information}(\theta) + \sigma^2(\theta)} \\
  &= \frac{\text{information}(\theta)}{\text{information}(\theta) + 1}
\end{aligned}
(\#eq:reliabilityIRT)
$$

where $\sigma^2(\theta)$ is the variance of theta, which is fixed to one in most IRT models.\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `reliabilityIRT()` function that estimates the amount of [reliability](#irtReliability) an item or a measure provides as function of its information and the variance of people's construct levels ($\theta$).\index{petersenlab package}\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!theta}

```{r, eval = FALSE, class.source = "fold-hide"}
reliabilityIRT <- function(information, varTheta = 1){
  information / (information + varTheta)
}
```

```{r, eval = FALSE}
reliabilityIRT(information, varTheta = 1)
```

```{r}
reliabilityIRT(10)
```

Consider some hypothetical items depicted with [ICCs](#icc) in Figure \@ref(fig:reliabilityIRTicc).\index{item response theory!item characteristic curve}

```{r, include = FALSE}
#https://journals.sagepub.com/doi/full/10.1177/0146621613475471
irtReliability <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

irtReliability$item1 <- fourPL(b = -1, a = 1, theta = irtReliability$theta)
irtReliability$item2 <- fourPL(b = 0, a = 0.6, theta = irtReliability$theta)
irtReliability$item3 <- fourPL(b = 1, a = 1.5, theta = irtReliability$theta)
irtReliability$item4 <- fourPL(b = 2, a = 2, theta = irtReliability$theta)

irtInformation <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

irtInformation$information1 <- itemInformation(b = -1, a = 1, theta = irtInformation$theta)
irtInformation$information2 <- itemInformation(b = 0, a = 0.6, theta = irtInformation$theta)
irtInformation$information3 <- itemInformation(b = 1, a = 1.5, theta = irtInformation$theta)
irtInformation$information4 <- itemInformation(b = 2, a = 2, theta = irtInformation$theta)

midpoint_item1 <- irtReliability$theta[which.min(abs(irtReliability$item1 - 0.5))]
midpoint_item2 <- irtReliability$theta[which.min(abs(irtReliability$item2 - 0.5))]
midpoint_item3 <- irtReliability$theta[which.min(abs(irtReliability$item3 - 0.5))]
midpoint_item4 <- irtReliability$theta[which.min(abs(irtReliability$item4 - 0.5))]

irtInformation$testInformation <- rowSums(irtInformation[,c("information1","information2","information3","information4")])
irtInformation$standardError <- standardErrorIRT(irtInformation$testInformation)
irtInformation$reliability <- reliabilityIRT(irtInformation$testInformation)

irtReliability_long <- pivot_longer(irtReliability, cols = item1:item4) %>%
  rename(item = name)

irtInformation_long <- pivot_longer(irtInformation, cols = information1:information4) %>% 
  rename(item = name)

irtReliability_long$Item <- NA
irtReliability_long$Item[which(irtReliability_long$item == "item1")] <- 1
irtReliability_long$Item[which(irtReliability_long$item == "item2")] <- 2
irtReliability_long$Item[which(irtReliability_long$item == "item3")] <- 3
irtReliability_long$Item[which(irtReliability_long$item == "item4")] <- 4

irtInformation_long$Item <- NA
irtInformation_long$Item[which(irtInformation_long$item == "information1")] <- 1
irtInformation_long$Item[which(irtInformation_long$item == "information2")] <- 2
irtInformation_long$Item[which(irtInformation_long$item == "information3")] <- 3
irtInformation_long$Item[which(irtInformation_long$item == "information4")] <- 4
```

(ref:reliabilityIRTiccCaption) Item Characteristic Curves From Two-Parameter Logistic Model in Item Response Theory. The dashed horizontal line indicates a probability of item endorsement of .50. The dashed vertical line is the item difficulty, i.e., the person's level on the construct (the location on the x-axis) at the inflection point of the item characteristic curve. In a two-parameter logistic model, the inflection point corresponds to the probability of item endorsement is 50%. Thus, in a two-parameter logistic model, the difficulty of an item is the person's level on the construct where the probability of endorsing the item is 50%.

```{r reliabilityIRTicc, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "(ref:reliabilityIRTiccCaption)", fig.scap = "Item Characteristic Curves From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(irtReliability_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  geom_hline(yintercept = 0.5, linetype = "dashed") +
  geom_segment(aes(x = midpoint_item1, xend = midpoint_item1, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  geom_segment(aes(x = midpoint_item2, xend = midpoint_item2, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  geom_segment(aes(x = midpoint_item3, xend = midpoint_item3, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  geom_segment(aes(x = midpoint_item4, xend = midpoint_item4, y = 0, yend = 0.5), linewidth = 0.5, col = "black", linetype = "dashed") +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

We can present the [ICC](#icc) in terms of an item information curve (see Figure \@ref(fig:reliabilityIRTitemInformation)).\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{item response theory!item information curve}
On the x-axis, the information peak is located at the [difficulty/severity](#itemDifficulty) of the item.
The higher the [discrimination](#itemDiscrimination), the higher the information peak on the y-axis.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{item response theory!item difficulty}\index{item response theory!item discrimination}

```{r reliabilityIRTitemInformation, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Item Information From Two-Parameter Logistic Model in Item Response Theory. The dashed vertical line is the item difficulty, which is located at the peak of the item information curve.", fig.scap = "Item Information From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(irtInformation_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  geom_vline(xintercept = midpoint_item1, linetype = "dashed") +
  geom_vline(xintercept = midpoint_item2, linetype = "dashed") +
  geom_vline(xintercept = midpoint_item3, linetype = "dashed") +
  geom_vline(xintercept = midpoint_item4, linetype = "dashed") +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Item Information") +
  theme_bw()
```

We can aggregate (sum) information across items to determine how much information the measure as a whole provides.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{item response theory!test information curve}
This is called the test information curve (see Figure \@ref(fig:reliabilityIRTtestInformation)).\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{item response theory!test information curve}
Note that we get more information from likert/multiple response items compared to binary/dichotomous items.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{data!dichotomous}\index{data!polytomous}\index{item response theory!test information curve}\index{Likert scale}
Having 10 items with a 5-level response scale yields as much information as 40 dichotomous items.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{item response theory!test information curve}

```{r reliabilityIRTtestInformation, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(irtInformation, aes(theta, testInformation)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Test Information", limits = c(0,2)) +
  theme_bw()
```

Based on test information, we can calculate the [standard error of measurement](#standardErrorOfMeasurement) (see Figure \@ref(fig:reliabilityIRTtestSE)).\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}
Notice how the degree of [(un)reliability](#reliability) differs at different construct levels.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

```{r reliabilityIRTtestSE, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(irtInformation, aes(theta, standardError)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Standard Error of Measurement", limits = c(0,4)) +
  theme_bw()
```

Based on test information, we can estimate the [reliability](#irtReliability) (see Figure \@ref(fig:reliabilityIRTtestReliability)).\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}
Notice how the degree of [(un)reliability](#reliability) differs at different construct levels.\index{item response theory}\index{item response theory!item characteristic curve}\index{item response theory!information}\index{reliability}\index{reliability!standard error of measurement}\index{item response theory!standard error of measurement}

```{r reliabilityIRTtestReliability, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(irtInformation, aes(theta, reliability)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Reliability", limits = c(0,1)) +
  theme_bw()
```

### Efficient Assessment {#efficientAssessment}

One of the benefits of IRT is for item selection to develop brief assessments.\index{item response theory}\index{brief assessment}
For instance, you could use two items to estimate where the person is on the construct: low, middle, or high (see Figure \@ref(fig:efficientAssessment)).\index{item response theory}\index{brief assessment}
If the responses to the two items do not meet expectations, for instance, the person passes the difficult item but fails the easy item, we would keep assessing additional items to determine their level on the construct.\index{item response theory}\index{brief assessment}
If two items perform similarly, that is, they have the same [difficulty](#itemDifficulty) and [discrimination](#itemDiscrimination), they are redundant, and we can sacrifice one of them.\index{item response theory}\index{brief assessment}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
This leads to greater efficiency and better measurement in terms of [reliability](#reliability) and [validity](#validity).\index{item response theory}\index{brief assessment}\index{reliability}\index{validity}
For more information on designing and evaluating short forms compared to their full-scale counterparts, see @Smith2000.\index{brief assessment}

```{r, include = FALSE}
efficientAssessment <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

efficientAssessment$item1 <- fourPL(b = -1.5, a = 2, theta = efficientAssessment$theta)
efficientAssessment$item2 <- fourPL(b = 1.5, a = 2, theta = efficientAssessment$theta)

efficientAssessment_long <- pivot_longer(efficientAssessment, cols = item1:item2) %>%
  rename(item = name)

efficientAssessment_long$Item <- NA
efficientAssessment_long$Item[which(efficientAssessment_long$item == "item1")] <- 1
efficientAssessment_long$Item[which(efficientAssessment_long$item == "item2")] <- 2
```

```{r efficientAssessment, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Visual Representation of an Efficient Assessment Based on Item Characteristic Curves from Two-Parameter Logistic Model in Item Response Theory."}
ggplot(efficientAssessment_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

IRT forms the basis of [computerized adaptive testing](#cat), which is discussed in Chapter \@ref(cat).\index{item response theory}\index{brief assessment}\index{adaptive testing}
As discussed earlier, briefer measures can increase [reliability](#reliability) and [validity](#validity) of measurement if the items are tailored to the ability level of the participant.\index{brief assessment}\index{reliability}\index{validity}
The idea of [adaptive testing](#cat) is that, instead of having a standard scale for all participants, the items adapt to each person.\index{brief assessment}\index{adaptive testing}
An example of a measure that has used [computerized adaptive testing](#cat) is the Graduate Record Examination (GRE).\index{adaptive testing}

With [adaptive testing](#cat), it is important to develop a comprehensive item bank that spans the difficulty range of interest.\index{adaptive testing}
The starting construct level is the 50th percentile.
If the respondent gets the first item correct, it moves to the next item that would provide the most [information](#irtReliability) for the person, based on a split of the remaining sample (e.g., 75th percentile).\index{adaptive testing}\index{reliability}\index{item response theory!information}
And so on...\index{adaptive testing}
The goal of [adaptive testing](#cat) is to find the construct level where the respondent keeps getting items right and wrong 50% of the time.\index{adaptive testing}
[Adaptive testing](#cat) is a promising approach that saves time because it tailors which items are administered to which person (based on their construct level) to get the most [reliable](#reliability) estimate in the shortest time possible.\index{adaptive testing}\index{reliability}\index{brief assessment}
However, it assumes that if you get a more difficult item correct, that you would have gotten easier items correct, which might not be true in all contexts (especially for constructs that are not unidimensional).\index{adaptive testing}

Although most uses of IRT have been in cognitive and educational testing, IRT may also benefit other domains of assessment including clinical assessment [@Gibbons2016; @Reise2009; @Thomas2019].\index{item response theory}

#### A Good Measure {#goodMeasure}

According to IRT a good measure should:\index{item response theory}

1. fit your goals of the assessment, in terms of the range of interest regarding levels on the construct,\index{item response theory}
1. have good items that yield lots of [information](#irtReliability), and\index{item response theory}\index{item response theory!information}\index{reliability}
1. have a good set of items that densely cover the construct within the range of interest, without redundancy.\index{item response theory}

First, a good measure should fit your goals of the assessment, in terms of the "range of interest" or the "target range" of levels on the construct.\index{item response theory}
For instance, if your goal is to perform diagnosis, you would only care about the high end of the construct (e.g., 1–3 standard deviations above the mean)—there is no use discriminating between "nothing", "almost nothing", and "a little bit."\index{item response theory}
For secondary prevention, i.e., early identification of risk to prevent something from getting worse, you would be interested in finding people with elevated risk—e.g., you would need to know who is 1 or more standard deviations above the mean, but you would not need to discriminate beyond that.\index{item response theory}
For assessing individual differences, you would want items that discriminate across the full range, including at the lower end.\index{item response theory}
The items' [difficulty](#itemDifficulty) should span the range of interest.\index{item response theory}\index{item response theory!item difficulty}

Second, a good measure should have good items that yield lots of [information](#irtReliability).\index{item response theory}\index{item response theory!information}\index{reliability}
For example, the items should have strong [discrimination](#itemDiscrimination), that is, the items are strongly related to the construct.\index{item response theory}\index{item response theory!item discrimination}
The items should have sufficient variability in responses.\index{item response theory}
This can be achieved by having items with more response options (e.g., likert/multiple choice items, as opposed to binary items), items that differ in difficulty, and (at least some) items that are not too difficult or too easy (to avoid ceiling/floor effects).\index{item response theory}\index{data!dichotomous}\index{data!polytomous}\index{Likert scale}

Third, a good measure should have a good set of items that densely cover the construct within the range of interest, without redundancy.\index{item response theory}
The items should not have the same [difficulty](#itemDifficulty) or they would be considered redundant, and one of the redundant items could be dropped.\index{item response theory}\index{item response theory!item difficulty}
The items' [difficulty](#itemDifficulty) should densely cover the construct within the range of interest.\index{item response theory}\index{item response theory!item difficulty}
For instance, if the construct range of interest is 1–2 standard deviations above the mean, the items should have [difficulty](#itemDifficulty) that densely cover this range (e.g., 1.0, 1.05, 1.10, 1.15, 1.20, 1.25, 1.30, ..., 2.0).\index{item response theory}\index{item response theory!item difficulty}

With items that (1) span the range of interest, (2) have high [discrimination](#itemDiscrimination) and [information](#irtReliability), and (3) densely cover the range of interest without redundancy, the measure should have a high [information](#irtReliability) in the range of interest.\index{item response theory}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!information}\index{reliability}
This would allow it to efficiently and accurately assess the construct for the intended purpose.\index{item response theory}\index{brief assessment}

An example of a bad measure for assessing the full range of individual differences is depicted in terms of [ICCs](#icc) in Figure \@ref(fig:badMeasureICCs) and in terms of [test information](#irtReliability) in Figure \@ref(fig:badMeasureInfo).\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!test information curve}
The measure performs poorly for the intended purpose, because its items do not (a) span the range of interest (−3 to 3 standard deviations from the mean of the latent construct), (b) have high [discrimination](#itemDiscrimination) and [information](#irtReliability), and (c) densely cover the range of interest without redundancy.\index{item response theory}\index{item response theory!information}\index{item response theory!item discrimination}\index{reliability}

```{r, include = FALSE}
badMeasure <- badMeasureInfo <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

badMeasure$item1 <- fourPL(b = -2.5, a = 0.4, theta = badMeasure$theta)
badMeasure$item2 <- fourPL(b = -2.4, a = 1, theta = badMeasure$theta)
badMeasure$item3 <- fourPL(b = -2.3, a = 0.8, theta = badMeasure$theta)
badMeasure$item4 <- fourPL(b = -2.2, a = 1.5, theta = badMeasure$theta)
badMeasure$item5 <- fourPL(b = 2.0, a = 0.6, theta = badMeasure$theta)
badMeasure$item6 <- fourPL(b = 2.1, a = 1.2, theta = badMeasure$theta)
badMeasure$item7 <- fourPL(b = 2.2, a = 0.8, theta = badMeasure$theta)
badMeasure$item8 <- fourPL(b = 2.3, a = 1.3, theta = badMeasure$theta)
badMeasure$item9 <- fourPL(b = 2.4, a = 0.6, theta = badMeasure$theta)
badMeasure$item10 <- fourPL(b = 2.5, a = 0.5, theta = badMeasure$theta)

badMeasureInfo$info1 <- itemInformation(b = -2.5, a = 0.4, theta = badMeasureInfo$theta)
badMeasureInfo$info2 <- itemInformation(b = -2.4, a = 1, theta = badMeasureInfo$theta)
badMeasureInfo$info3 <- itemInformation(b = -2.3, a = 0.8, theta = badMeasureInfo$theta)
badMeasureInfo$info4 <- itemInformation(b = -2.2, a = 1.5, theta = badMeasureInfo$theta)
badMeasureInfo$info5 <- itemInformation(b = 2.0, a = 0.6, theta = badMeasureInfo$theta)
badMeasureInfo$info6 <- itemInformation(b = 2.1, a = 1.2, theta = badMeasureInfo$theta)
badMeasureInfo$info7 <- itemInformation(b = 2.2, a = 0.8, theta = badMeasureInfo$theta)
badMeasureInfo$info8 <- itemInformation(b = 2.3, a = 1.3, theta = badMeasureInfo$theta)
badMeasureInfo$info9 <- itemInformation(b = 2.4, a = 0.6, theta = badMeasureInfo$theta)
badMeasureInfo$info10 <- itemInformation(b = 2.5, a = 0.5, theta = badMeasureInfo$theta)

badMeasureInfo$information <- rowSums(badMeasureInfo[,paste("info", 1:10, sep = "")])

badMeasure_long <- pivot_longer(badMeasure, cols = item1:item10) %>%
  rename(item = name)

badMeasure_long$Item <- NA
badMeasure_long$Item[which(badMeasure_long$item == "item1")] <- 1
badMeasure_long$Item[which(badMeasure_long$item == "item2")] <- 2
badMeasure_long$Item[which(badMeasure_long$item == "item3")] <- 3
badMeasure_long$Item[which(badMeasure_long$item == "item4")] <- 4
badMeasure_long$Item[which(badMeasure_long$item == "item5")] <- 5
badMeasure_long$Item[which(badMeasure_long$item == "item6")] <- 6
badMeasure_long$Item[which(badMeasure_long$item == "item7")] <- 7
badMeasure_long$Item[which(badMeasure_long$item == "item8")] <- 8
badMeasure_long$Item[which(badMeasure_long$item == "item9")] <- 9
badMeasure_long$Item[which(badMeasure_long$item == "item10")] <- 10
```

```{r badMeasureICCs, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.cap = "Visual Representation of a Bad Measure Based on Item Characteristic Curves of Items From a Bad Measure Estimated from Two-Parameter Logistic Model in Item Response Theory."}
ggplot(badMeasure_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw() +
  theme(legend.key.size = unit(0.15, "in"))
```

```{r badMeasureInfo, echo = FALSE, results = "hide", out.width = "100%", fig.cap = "Visual Representation of a Bad Measure Based on the Test Information Curve."}
ggplot(badMeasureInfo, aes(theta, information)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Information") +
  theme_bw()
```

An example of a good measure for distinguishing clinical-range versus sub-clinical range is depicted in terms of [ICCs](#icc) in Figure \@ref(fig:goodMeasureICCs) and in terms of [test information](#irtReliability) in Figure \@ref(fig:goodMeasureInfo).\index{item response theory}\index{item response theory!information}\index{reliability}\index{item response theory!item characteristic curve}\index{item response theory!test information curve}
The measure is good for the intended purpose, in terms of having items that (a) span the range of interest (1–3 standard deviations above the mean of the latent construct), (b) have high [discrimination](#itemDiscrimination) and [information](#irtReliability), and (c) densely cover the range of interest without redundancy.\index{item response theory}\index{item response theory!information}\index{item response theory!item discrimination}\index{reliability}\index{item response theory!test information curve}

```{r, include = FALSE}
goodMeasure <- goodMeasureInfo <- data.frame(theta = seq(from = -4, to = 4, length.out = 1000))

goodMeasure$item1 <-  fourPL(b = 1.0, a = 10, theta = goodMeasure$theta)
goodMeasure$item2 <-  fourPL(b = 1.1, a = 10, theta = goodMeasure$theta)
goodMeasure$item3 <-  fourPL(b = 1.2, a = 10, theta = goodMeasure$theta)
goodMeasure$item4 <-  fourPL(b = 1.3, a = 10, theta = goodMeasure$theta)
goodMeasure$item5 <-  fourPL(b = 1.4, a = 10, theta = goodMeasure$theta)
goodMeasure$item6 <-  fourPL(b = 1.5, a = 10, theta = goodMeasure$theta)
goodMeasure$item7 <-  fourPL(b = 1.6, a = 10, theta = goodMeasure$theta)
goodMeasure$item8 <-  fourPL(b = 1.7, a = 10, theta = goodMeasure$theta)
goodMeasure$item9 <-  fourPL(b = 1.8, a = 10, theta = goodMeasure$theta)
goodMeasure$item10 <- fourPL(b = 1.9, a = 10, theta = goodMeasure$theta)
goodMeasure$item11 <- fourPL(b = 2.0, a = 10, theta = goodMeasure$theta)
goodMeasure$item12 <- fourPL(b = 2.1, a = 10, theta = goodMeasure$theta)
goodMeasure$item13 <- fourPL(b = 2.2, a = 10, theta = goodMeasure$theta)
goodMeasure$item14 <- fourPL(b = 2.3, a = 10, theta = goodMeasure$theta)
goodMeasure$item15 <- fourPL(b = 2.4, a = 10, theta = goodMeasure$theta)
goodMeasure$item16 <- fourPL(b = 2.5, a = 10, theta = goodMeasure$theta)
goodMeasure$item17 <- fourPL(b = 2.6, a = 10, theta = goodMeasure$theta)
goodMeasure$item18 <- fourPL(b = 2.7, a = 10, theta = goodMeasure$theta)
goodMeasure$item19 <- fourPL(b = 2.8, a = 10, theta = goodMeasure$theta)
goodMeasure$item20 <- fourPL(b = 2.9, a = 10, theta = goodMeasure$theta)

goodMeasureInfo$info1 <- itemInformation(b = 1.0, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info2 <- itemInformation(b = 1.1, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info3 <- itemInformation(b = 1.2, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info4 <- itemInformation(b = 1.3, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info5 <- itemInformation(b = 1.4, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info6 <- itemInformation(b = 1.5, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info7 <- itemInformation(b = 1.6, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info8 <- itemInformation(b = 1.7, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info9 <- itemInformation(b = 1.8, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info10 <- itemInformation(b = 1.9, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info11 <- itemInformation(b = 2.0, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info12 <- itemInformation(b = 2.1, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info13 <- itemInformation(b = 2.2, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info14 <- itemInformation(b = 2.3, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info15 <- itemInformation(b = 2.4, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info16 <- itemInformation(b = 2.5, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info17 <- itemInformation(b = 2.6, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info18 <- itemInformation(b = 2.7, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info19 <- itemInformation(b = 2.8, a = 10, theta = goodMeasureInfo$theta)
goodMeasureInfo$info20 <- itemInformation(b = 2.9, a = 10, theta = goodMeasureInfo$theta)

goodMeasureInfo$information <- rowSums(goodMeasureInfo[,paste("info", 1:20, sep = "")])

goodMeasure_long <- pivot_longer(goodMeasure, cols = item1:item20) %>%
  rename(item = name)

goodMeasure_long$Item <- NA
goodMeasure_long$Item[which(goodMeasure_long$item == "item1")] <- 1
goodMeasure_long$Item[which(goodMeasure_long$item == "item2")] <- 2
goodMeasure_long$Item[which(goodMeasure_long$item == "item3")] <- 3
goodMeasure_long$Item[which(goodMeasure_long$item == "item4")] <- 4
goodMeasure_long$Item[which(goodMeasure_long$item == "item5")] <- 5
goodMeasure_long$Item[which(goodMeasure_long$item == "item6")] <- 6
goodMeasure_long$Item[which(goodMeasure_long$item == "item7")] <- 7
goodMeasure_long$Item[which(goodMeasure_long$item == "item8")] <- 8
goodMeasure_long$Item[which(goodMeasure_long$item == "item9")] <- 9
goodMeasure_long$Item[which(goodMeasure_long$item == "item10")] <- 10
goodMeasure_long$Item[which(goodMeasure_long$item == "item11")] <- 11
goodMeasure_long$Item[which(goodMeasure_long$item == "item12")] <- 12
goodMeasure_long$Item[which(goodMeasure_long$item == "item13")] <- 13
goodMeasure_long$Item[which(goodMeasure_long$item == "item14")] <- 14
goodMeasure_long$Item[which(goodMeasure_long$item == "item15")] <- 15
goodMeasure_long$Item[which(goodMeasure_long$item == "item16")] <- 16
goodMeasure_long$Item[which(goodMeasure_long$item == "item17")] <- 17
goodMeasure_long$Item[which(goodMeasure_long$item == "item18")] <- 18
goodMeasure_long$Item[which(goodMeasure_long$item == "item19")] <- 19
goodMeasure_long$Item[which(goodMeasure_long$item == "item20")] <- 20
```

```{r goodMeasureICCs, echo = FALSE, results = "hide", out.width = "100%", fig.align = "center", fig.align = "center", fig.cap = "Visual Representation of a Good Measure (For Distinguishing Clinical-Range Versus Sub-clinical Range) Based on Item Characteristic Curves of Items From a Good Measure Estimated From Two-Parameter Logistic Model in Item Response Theory."}
ggplot(goodMeasure_long, aes(theta, value, group = factor(Item), color = factor(Item))) +
  geom_line(linewidth = 1.5) +
  labs(color = "Item") +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Probability of Item Endorsement") +
  theme_bw()
```

```{r goodMeasureInfo, echo = FALSE, results = "hide", out.width = "100%", fig.cap = "Visual Representation of a Good Measure (For Distinguishing Clinical-Range Versus Sub-clinical Range) Based on the Test Information Curve."}
ggplot(goodMeasureInfo, aes(theta, information)) +
  geom_line(linewidth = 1.5) +
  scale_color_viridis_d() +
  scale_x_continuous(name = expression(paste("Person's Level on the Latent Construct (", theta, ")", sep = "")), breaks = -4:4) +
  scale_y_continuous(name = "Information") +
  theme_bw()
```

### Assumptions of IRT {#assumptions-irt}

IRT has several assumptions:\index{item response theory!assumptions}

- monotonicity\index{item response theory!assumptions}
- unidimensionality\index{item response theory!assumptions}\index{unidimensional}
- item invariance\index{item response theory!assumptions}
- local independence\index{item response theory!assumptions}

#### Monotonicity {#monotonicity-irt}

The monotonicity assumption holds that a person's probability of endorsing a higher level on the item increases as a person's level on the latent construct increases.\index{item response theory!assumptions}
For instance, for each item assessing externalizing problems, as a child increases in their level of externalizing problems, they are expected to be rated with a higher level on that item.\index{item response theory!assumptions}
Monotonicity can be evaluated in multiple ways.\index{item response theory!assumptions}
For instance, monotonicity can be evaluated using visual inspection of empirical [item characteristic curves](#icc).\index{item response theory!assumptions}\index{item response theory!item characteristic curve}
Another way to evaluate monotonicity is with Mokken scale analysis, such as using the `mokken` package in `R`.\index{item response theory!assumptions}

#### Unidimensionality {#unidimensionality-irt}

The unidimensionality assumption holds that the items have one predominant dimension, which reflects the underlying (latent) construct.\index{item response theory!assumptions}\index{unidimensional}
The dimensionality of a set of items can be evaluated using [factor analysis](#factorAnalysis).\index{item response theory!assumptions}\index{factor analysis}
Although items that are intended to assess a given latent latent construct are expected to be unidimensional, models have been developed that allow multiple latent dimensions, as shown in Section \@ref(irt-twoPLmultidimensional).\index{item response theory!assumptions}\index{multidimensional}\index{unidimensional}
These [multidimensional IRT models](#irt-twoPLmultidimensional) allow borrowing information from a given latent factor in the estimation of other latent factor(s) to account for the covariation.\index{item response theory!assumptions}\index{multidimensional}

#### Item Invariance {#itemInvariance-irt}

The item invariance assumption holds that the items function similarly (i.e., have the same parameters) for all people and subgroups in the population.\index{item response theory!assumptions}
The extent to which items may violate the item invariance assumption can be evaluated empirically using tests of [differential item functioning](#dif) (DIF).\index{item response theory!assumptions}\index{item response theory!differential item functioning}
Tests of [measurement invariance](#measurementInvariance) are the equivalent of tests of [differential item functioning](#dif) for [factor analysis](#factorAnalysis)/[structural equation models](#sem).\index{item response theory!assumptions}\index{item response theory!differential item functioning}\index{structural equation modeling!measurement invariance}\index{factor analysis}\index{structural equation modeling}
Test of [differential item functioning](#dif) and [measurement invariance](#measurementInvariance) are described in the chapter on [test bias](#bias).\index{item response theory!assumptions}\index{item response theory!differential item functioning}\index{structural equation modeling!measurement invariance}

#### Local Independence {#localIndependence-irt}

The local independence assumptions holds that the items are uncorrelated when controlling for the latent dimension.\index{item response theory!assumptions}
That is, IRT models assume that the items' errors (residuals) are uncorrelated with each other.\index{item response theory!assumptions}
[Factor analysis](#factorAnalysis) and [structural equation models](#sem) can relax this assumption and allow items' error terms to correlate with each other.\index{item response theory!assumptions}\index{structural equation modeling!residual!correlated}\index{factor analysis}\index{structural equation modeling}

## Getting Started {#gettingStarted-irt}

### Load Libraries {#loadLibraries-irt}

```{r}
library("petersenlab") #to install: install.packages("remotes"); remotes::install_github("DevPsyLab/petersenlab")
library("mirt")
library("lavaan")
library("semTools")
library("semPlot")
library("lme4")
library("MOTE")
library("tidyverse")
library("here")
library("tinytex")
```

### Load Data {#loadData-irt}

`LSAT7` is a data set from the `mirt` package [@R-mirt] that contains five items from the Law School Admissions Test.

```{r}
mydataIRT <- expand.table(LSAT7)
```

### Descriptive Statistics {#descriptiveStats-IRT}

```{r}
itemstats(mydataIRT, ts.tables = TRUE)
```

## Comparison of Scoring Approaches {#scoringApproaches}

A measure that is a raw symptom count (i.e., a count of how many symptoms a person endorses) is low in precision and has a high standard error of measurement.\index{reliability}\index{reliability!precision}\index{reliability!standard error of measurement}\index{scoring}
Some diagnostic measures provide an ordinal response scale for each symptom.\index{scoring}
For example, the Structured Clinical Interview of Mental Disorders (SCID) provides a response scale from 0 to 2, where 0 = the symptom is absent, 1 = the symptom is sub-threshold, and 2 = the symptom is present.\index{scoring}
If your measure was a raw symptom sum, as opposed to a count of how many symptoms were present, the measure would be slightly more precise and have a somewhat smaller standard error of measurement.\index{reliability}\index{reliability!precision}\index{reliability!standard error of measurement}\index{scoring}

A weighted symptom sum is the [classical test theory](#ctt) analog of IRT.\index{scoring}\index{classical test theory}\index{item response theory}
In [classical test theory](#ctt), proportion correct (or endorsed) would correspond to item [difficulty](#itemDifficulty) and the [item–total correlation](#itemTotalCorrelation-reliability) (i.e., a point-biserial correlation) would correspond to item [discrimination](#itemDiscrimination).\index{scoring}\index{classical test theory}\index{item response theory!item difficulty}\index{reliability!internal consistency!average item–total correlation}
If we were to compute a weighted sum of each item according to its strength of association with the construct (i.e., the [item–total correlation](#itemTotalCorrelation-reliability)), this measure would be somewhat more precise than the raw symptom sum, but it is not a latent variable method.\index{scoring}\index{reliability!internal consistency!average item–total correlation}\index{latent variable}

In IRT analysis, the weight for each item influences the estimate of a person's level on the construct.\index{item response theory}
IRT down-weights the poorly [discriminating](#itemDiscrimination) items and up-weights the strongly [discriminating](#itemDiscrimination) items.\index{item response theory}\index{item response theory!item discrimination}
This leads to greater [precision](#reliability) and a lower [standard error of measurement](#standardErrorOfMeasurement) than non-latent scoring approaches.\index{scoring}\index{item response theory}\index{latent variable}\index{reliability}\index{reliability!precision}\index{reliability!standard error of measurement}

According to @Embretson1996, many perspectives have changed because of IRT.\index{item response theory}
First, according to [classical test theory](#ctt), longer tests are more [reliable](#reliability) than shorter tests, as described in Section \@ref(splitHalf-reliability) in the chapter on [reliability](#reliability).\index{classical test theory}\index{reliability}
However, according to IRT, shorter tests (i.e., tests with fewer items) can be more [reliable](#reliability) than longer tests.\index{item response theory}\index{brief assessment}\index{reliability}
Item selection using IRT can lead to briefer assessments that have greater [reliability](#reliability) than longer scales.\index{item response theory}\index{brief assessment}\index{reliability}
For example, [adaptive tests](#cat) that tailor the [difficulty](#itemDifficulty) of the items to the ability level of the participant.\index{item response theory}\index{brief assessment}\index{reliability}\index{adaptive testing}\index{item response theory!item difficulty}

Second, in [classical test theory](#ctt), a score's meaning is tied to its location in a distribution (i.e., the [norm-referenced](#norm) standard).\index{classical test theory}
In IRT, however, the people and items are calibrated on a common scale.\index{item response theory}
Based on a child's IRT-estimated ability level (i.e., level on the construct), we can have a better sense of what the child knows and does not know, because it indicates the [difficulty](#itemDifficulty) level at which they would tend to get items correct 50% of the time; the person would likely fail items with a higher [difficulty](#itemDifficulty) compared to this level, whereas the person would likely pass items with a lower [difficulty](#itemDifficulty) compared to this level.\index{item response theory}\index{item response theory!item difficulty}\index{item response theory!theta}
Consider Binet's distribution of ability that arranges the items from easiest to most difficult.
Based on the item [difficulty](#itemDifficulty) and content of the items and the child's performance, we can have a better indication that a child can perform items successfully in a particular range (e.g., count to 10) but might not be able to perform more difficult items (e.g., tie their shoes).\index{item response theory}\index{item response theory!item difficulty}
From an intervention perspective, this would allow working in the "window of opportunity" or the zone of proximal development.
Thus, IRT can provide more meaningful understanding of a person's ability compared to traditional [classical test theory](#ctt) interpretations such as the child being at the "63rd percentile" for a child of their age, which lacks conceptual meaning.\index{item response theory}\index{classical test theory}\index{data!percentile rank}

According to @Cooper2009a, our current diagnostic system relies heavily on how many symptoms a person endorses as an index of severity, but this assumes that all symptom endorsements have the same overall weight (severity).\index{scoring}
Using IRT, we can determine the relative [severity](#itemDifficulty) of each item (symptom)—and it is clear that some symptoms indicate more severity than others.\index{scoring}\index{item response theory}\index{item response theory!item difficulty}
From this analysis, a respondent can endorse fewer, more severe items, and have overall more severe psychopathology than an individual who endorses more, less [severe](#itemDifficulty) items.\index{scoring}\index{item response theory}\index{item response theory!item difficulty}
Basically, not all items are equally [severe](#itemDifficulty)—know your items!\index{scoring}\index{item response theory}\index{item response theory!item difficulty}

## Rasch Model (1-Parameter Logistic) {#irt-onePL}

A one-parameter logistic (1PL) item response theory (IRT) model is a model fit to dichotomous data, which estimates a different [difficulty](#itemDifficulty) ($b$) parameter for each item.\index{item response theory!one-parameter model}\index{item response theory!item difficulty}
[Discrimination](#itemDiscrimination) ($a$) is not estimated (i.e., it is fixed at the same value—one—across items).\index{item response theory!one-parameter model}\index{item response theory!item discrimination}
Rasch models were fit using the `mirt` package [@R-mirt].\index{item response theory!one-parameter model}

### Fit Model {#irt-onePLfit}

```{r, results = "hide"}
raschModel <- mirt(
  data = mydataIRT,
  model = 1,
  itemtype = "Rasch",
  SE = TRUE)
```

### Model Summary {#irt-onePLoutput}

```{r}
summary(raschModel)
coef(raschModel, simplify = TRUE, IRTpars = TRUE)
```

### Factor Scores {#irt-onePLfactorScores}

One can obtain factor scores (i.e., theta; and their associated standard errors) for each participant using the `fscores()` function.

```{r}
raschModel_factorScores <- fscores(raschModel, full.scores.SE = TRUE)
```

### Plots {#irt-onePLplots}

#### Test Curves {#irt-onePLtestCurves}

The test curves suggest that the measure is most [reliable](#reliability) (i.e., provides the most [information](#irtReliability) has the smallest [standard error of measurement](#irtReliability)) at lower levels of the construct.\index{item response theory!information}\index{item response theory!standard error of measurement}\index{reliability!standard error of measurement}

##### Test Characteristic Curve {#irt-onePLtcc}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:onePLtcc).\index{item response theory!item characteristic curve}

```{r onePLtcc, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Rasch Item Response Theory Model."}
plot(raschModel, type = "score")
```

##### Test Information Curve {#irt-onePLtif}

A plot of [test information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:onePLtif).\index{item response theory!information}\index{item response theory!test information curve}

```{r onePLtif, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Rasch Item Response Theory Model."}
plot(raschModel, type = "info")
```

##### Test Reliability {#irt-onePLreliability}

The estimate of marginal [reliability](#irtReliability) is below:\index{reliability}

```{r}
marginal_rxx(raschModel)
```

A plot of test [reliability](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:onePLreliability).\index{reliability}

```{r onePLreliability, out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Rasch Item Response Theory Model."}
plot(raschModel, type = "rxx")
```

##### Test Standard Error of Measurement {#irt-onePLsem}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:onePLsem).\index{reliability!standard error of measurement}

```{r onePLsem, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Rasch Item Response Theory Model."}
plot(raschModel, type = "SE")
```

##### Test Information Curve and Test Standard Error of Measurement {#irt-onePLtifSEM}

A plot of [test information](#irtReliability) and [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:onePLtifSEM).\index{item response theory!information}\index{item response theory!standard error of measurement}\index{reliability!standard error of measurement}\index{item response theory!test information curve}

```{r onePLtifSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve and Standard Error of Measurement From Rasch Item Response Theory Model."}
plot(raschModel, type = "infoSE")
```

#### Item Curves {#irt-onePLitemCurves}

##### Item Characteristic Curves {#irt-onePLicc}

Item characteristic curve ([ICC](#icc)) plots of the probability of item endorsement (or getting the item correct) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:onePLicc) and \@ref(fig:onePLiccFacet).\index{item response theory!item characteristic curve}

```{r onePLicc, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Rasch Item Response Theory Model."}
plot(raschModel, type = "itemscore", facet_items = FALSE)
```

```{r onePLiccFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Rasch Item Response Theory Model."}
plot(raschModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-onePLiif}

Plots of [item information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:onePLiif) and \@ref(fig:onePLiifFacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r onePLiif, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves from Rasch Item Response Theory Model."}
plot(raschModel, type = "infotrace", facet_items = FALSE)
```

```{r onePLiifFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves from Rasch Item Response Theory Model."}
plot(raschModel, type = "infotrace", facet_items = TRUE)
```

### CFA {#irt-onePLcfa}

A one-parameter logistic model can also be fit in a [CFA](#cfa) framework, sometimes called item factor analysis.\index{factor analysis!confirmatory}
The item factor analysis models were fit in the `lavaan` package [@R-lavaan].\index{item response theory!one-parameter model}

```{r}
onePLModel_cfa <- '
# Factor Loadings (i.e., discrimination parameters)
latent =~ loading*Item.1 + loading*Item.2 + loading*Item.3 + 
  loading*Item.4 + loading*Item.5

# Item Thresholds (i.e., difficulty parameters)
Item.1 | threshold1*t1
Item.2 | threshold2*t1
Item.3 | threshold3*t1
Item.4 | threshold4*t1
Item.5 | threshold5*t1
'

onePLModel_cfa_fit = sem(
  model = onePLModel_cfa,
  data = mydataIRT,
  ordered = c("Item.1", "Item.2", "Item.3", "Item.4","Item.5"),
  mimic = "Mplus",
  estimator = "WLSMV",
  std.lv = TRUE,
  parameterization = "theta")

summary(
  onePLModel_cfa_fit,
  fit.measures = TRUE,
  rsquare = TRUE,
  standardized = TRUE)

fitMeasures(
  onePLModel_cfa_fit,
  fit.measures = c(
    "chisq", "df", "pvalue",
    "baseline.chisq","baseline.df","baseline.pvalue",
    "rmsea", "cfi", "tli", "srmr"))

residuals(onePLModel_cfa_fit, type = "cor")

modificationindices(onePLModel_cfa_fit, sort. = TRUE)

compRelSEM(onePLModel_cfa_fit)
AVE(onePLModel_cfa_fit)

onePLModel_cfa_factorScores <- lavPredict(onePLModel_cfa_fit)
```

A path diagram of the one-parameter item factor analysis is in Figure \@ref(fig:onePLifa).\index{item response theory!one-parameter model}

```{r onePLifa, out.width = "100%", fig.align = "center", fig.cap = "Item Factor Analysis Diagram of One-Parameter Logistic Model."}
semPaths(
  onePLModel_cfa_fit,
  what = "std",
  layout = "tree2",
  edge.label.cex = 1.5)
```

### Mixed Model {#irt-onePLmixed}

A Rasch model can also be fit in a mixed model framework.\index{mixed model}\index{item response theory!one-parameter model}
The Rasch model below was fit using the `lme4` package [@R-lme4].\index{mixed model}\index{item response theory!one-parameter model}

First, we convert the data from wide form to long form for the mixed model:

```{r}
mydataIRT_long <- mydataIRT %>% 
  mutate(ID = 1:nrow(mydataIRT)) %>% 
  pivot_longer(cols = Item.1:Item.5) %>% 
  rename(
    item = name,
    response = value)
```

Then, we can estimate the Rasch model using a logit or probit link:

```{r}
raschModel_mixed_logit <- glmer(
  response ~ -1 + item + (1|ID),
  mydataIRT_long, 
  family = binomial(link = "logit"))

summary(raschModel_mixed_logit)

raschModel_mixed_probit <- glmer(
  response ~ -1 + item + (1|ID),
  mydataIRT_long, 
  family = binomial(link = "probit"))

summary(raschModel_mixed_probit)
```

One can extract item difficulty and people's factor scores (i.e., theta), as adapted from James Uanhoro (https://www.jamesuanhoro.com/post/2018/01/02/using-glmer-to-perform-rasch-analysis/; archived at: https://perma.cc/84WP-TQBG):

```{r}
# Item difficulty
item.diff <- -1 * coef(summary(raschModel_mixed_logit))[,"Estimate"] # Regression coefficients * -1
item.diff <- data.frame(
  item = paste("Item", 1:5, sep = "."),
  item.diff = as.numeric(item.diff))

item.diff

# Factor Scores (Theta)
raschModel_mixed_logit_theta <- ranef(raschModel_mixed_logit)$ID[,"(Intercept)"]
```

## Two-Parameter Logistic Model {#irt-twoPL}

A two-parameter logistic (2PL) IRT model is a model fit to dichotomous data, which estimates a different [difficulty](#itemDifficulty) ($b$) and [discrimination](#itemDiscrimination) ($a$) parameter for each item.\index{item response theory!two-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
2PL models were fit using the `mirt` package [@R-mirt].\index{item response theory!two-parameter model}

### Fit Model {#irt-twoPLfit}

```{r, results = "hide"}
twoPLModel <- mirt(
  data = mydataIRT,
  model = 1,
  itemtype = "2PL",
  SE = TRUE)
```

### Model Summary {#irt-twoPLoutput}

```{r}
summary(twoPLModel)
coef(twoPLModel, simplify = TRUE, IRTpars = TRUE)
```

### Factor Scores {#irt-twoPLfactorScores}

```{r}
twoPLModel_factorScores <- fscores(twoPLModel, full.scores.SE = TRUE)
```

### Plots {#irt-twoPLplots}

#### Test Curves {#irt-twoPLtestCurves}

The test curves suggest that the measure is most [reliable](#reliability) (i.e., provides the most [information](#irtReliability) has the smallest [standard error of measurement](#irtReliability)) at lower levels of the construct.\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}

##### Test Characteristic Curve {#irt-twoPLtcc}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLtcc).\index{item response theory!item characteristic curve}

```{r twoPLtcc, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "score")
```

##### Test Information Curve {#irt-twoPLtif}

A plot of [test information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLtif).\index{item response theory!information}\index{item response theory!test information curve}

```{r twoPLtif, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "info")
```

##### Test Reliability {#irt-twoPLreliability}

The estimate of marginal [reliability](#irtReliability) is below:\index{reliability}

```{r}
marginal_rxx(twoPLModel)
```

A plot of test [reliability](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLreliability).\index{reliability}

```{r twoPLreliability, out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "rxx")
```

##### Test Standard Error of Measurement {#irt-twoPLsem}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLsem).\index{item response theory!standard error of measurement}

```{r twoPLsem, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "SE")
```

##### Test Information Curve and Standard Errors {#irt-twoPLtifSEM}

A plot of [test information](#irtReliability) and [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLtifSEM).\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

```{r twoPLtifSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve and Standard Error of Measurement From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "infoSE")
```

#### Item Curves {#irt-twoPLitemCurves}

##### Item Characteristic Curves {#irt-twoPLicc}

Item characteristic curve ([ICC](#icc)) plots of the probability of item endorsement (or getting the item correct) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:twoPLicc) and \@ref(fig:twoPLiccFacet).\index{item response theory!item characteristic curve}

```{r twoPLicc, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "itemscore", facet_items = FALSE)
```

```{r twoPLiccFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-twoPLiif}

Plots of [item information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:twoPLiif) and \@ref(fig:twoPLiifFacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r twoPLiif, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "infotrace", facet_items = FALSE)
```

```{r twoPLiifFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Two-Parameter Logistic Item Response Theory Model."}
plot(twoPLModel, type = "infotrace", facet_items = TRUE)
```

#### Convert Discrimination To Factor Loading {#irt-twoPLdiscriminationFactorLoading}

As described by [Aiden Loe](https://aidenloe.github.io/introToIRT.html#(alpha{})_par_to_std_loading) (archived at https://perma.cc/H3QN-JAWW), one can convert a discrimination parameter to a standardized factor loading using Equation \@ref(eq:discriminationFactorLoading):\index{item response theory!item discrimination}\index{structural equation modeling!factor loading}

\begin{equation}
f = \frac{a}{\sqrt{1 + a^2}}
(\#eq:discriminationFactorLoading)
\end{equation}

where $a$ is equal to: $\text{discrimination}/1.702$.\index{item response theory!item discrimination}\index{structural equation modeling!factor loading}

The [`petersenlab`](https://github.com/DevPsyLab/petersenlab) package [@R-petersenlab] contains the `discriminationToFactorLoading()` function that converts discrimination parameters to standardized factor loadings.\index{petersenlab package}

```{r}
discriminationParameters <- coef(
  twoPLModel,
  simplify = TRUE)$items[,1]

discriminationParameters
discriminationToFactorLoading(discriminationParameters)
```

### CFA {#irt-twoPLcfa}

A two-parameter logistic model can also be fit in a [CFA](#cfa) framework, sometimes called item factor analysis.\index{factor analysis}
The item factor analysis models were fit in the `lavaan` package [@R-lavaan].\index{factor analysis}

```{r}
twoPLModel_cfa <- '
# Factor Loadings (i.e., discrimination parameters)
latent =~ loading1*Item.1 + loading2*Item.2 + loading3*Item.3 + 
  loading4*Item.4 + loading5*Item.5

# Item Thresholds (i.e., difficulty parameters)
Item.1 | threshold1*t1
Item.2 | threshold2*t1
Item.3 | threshold3*t1
Item.4 | threshold4*t1
Item.5 | threshold5*t1
'

twoPLModel_cfa_fit = sem(
  model = twoPLModel_cfa,
  data = mydataIRT,
  ordered = c("Item.1", "Item.2", "Item.3", "Item.4","Item.5"),
  mimic = "Mplus",
  estimator = "WLSMV",
  std.lv = TRUE,
  parameterization = "theta")

summary(
  twoPLModel_cfa_fit,
  fit.measures = TRUE,
  rsquare = TRUE,
  standardized = TRUE)

fitMeasures(
  twoPLModel_cfa_fit,
  fit.measures = c(
    "chisq", "df", "pvalue",
    "baseline.chisq","baseline.df","baseline.pvalue",
    "rmsea", "cfi", "tli", "srmr"))

residuals(twoPLModel_cfa_fit, type = "cor")

modificationindices(twoPLModel_cfa_fit, sort. = TRUE)

compRelSEM(twoPLModel_cfa_fit)
AVE(twoPLModel_cfa_fit)

twoPLModel_cfa_factorScores <- lavPredict(twoPLModel_cfa_fit)
```

```{r, out.width = "100%", fig.align = "center", fig.cap = "Item Factor Analysis Diagram of Two-Parameter Logistic Model."}
semPaths(
  twoPLModel_cfa_fit,
  what = "std",
  layout = "tree2",
  edge.label.cex = 1.5)
```

## Two-Parameter Multidimensional Logistic Model {#irt-twoPLmultidimensional}

A 2PL multidimensional IRT model is a model that allows multiple dimensions (latent factors) and is fit to dichotomous data, which estimates a different [difficulty](#itemDifficulty) ($b$) and [discrimination](#itemDiscrimination) ($a$) parameter for each item.\index{item response theory!two-parameter model}\index{item response theory!multidimensional model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
Multidimensional IRT models were fit using the `mirt` package [@R-mirt].\index{item response theory!multidimensional model}
In this example, I estimate a 2PL multidimensional IRT model by estimating two factors.\index{item response theory!two-parameter model}\index{item response theory!multidimensional model}

### Fit Model {#irt-twoPLmultidimensionalFit}

```{r, results = "hide"}
twoPL2FactorModel <- mirt(
  data = mydataIRT,
  model = 2,
  itemtype = "2PL",
  SE = TRUE)
```

### Model Summary {#irt-twoPLmultidimensionalOutput}

```{r}
summary(twoPL2FactorModel)
coef(twoPL2FactorModel, simplify = TRUE)
```

### Factor Scores {#irt-twoPLmultidimensionalFactorScores}

```{r}
twoPL2FactorModel_factorScores <- fscores(twoPL2FactorModel, full.scores.SE = TRUE)
```

### Compare model fit {#irt-twoPLmultidimensionalCompare}

The modified model with two factors and the original one-factor model are considered "nested" models.\index{nested model}\index{item response theory!multidimensional model}
The original model is nested within the modified model because the modified model includes all of the terms of the original model along with additional terms.\index{nested model}
Model fit of nested models can be compared with a chi-square difference test.\index{nested model}\index{item response theory!chi-square difference test}\index{chi-square!difference test}

```{r}
anova(twoPLModel, twoPL2FactorModel)
```

Using a chi-square difference test to compare two nested models, the two-factor model fits significantly better than the one-factor model.\index{nested model}\index{item response theory!chi-square difference test}\index{item response theory!multidimensional model}\index{chi-square!difference test}

### Plots {#irt-twoPLmultidimensionalPlots}

#### Test Curves {#irt-twoPLmultidimensionalTestCurves}

##### Test Characteristic Curve {#irt-twoPLmultidimensionalTCC}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on each latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLmultidimensionalTCC).\index{item response theory!item characteristic curve}

```{r twoPLmultidimensionalTCC, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "score")
```

##### Test Information Curve {#irt-twoPLmultidimensionalTIF}

A plot of [test information](#irtReliability) as a function of a person's level on each latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLmultidimensionalTIF).\index{item response theory!information}\index{item response theory!test information curve}

```{r twoPLmultidimensionalTIF, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "info")
```

##### Test Standard Error of Measurement {#irt-twoPLmultidimensionalSEM}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on each latent construct (theta; $\theta$) is in Figure \@ref(fig:twoPLmultidimensionalSEM).\index{item response theory!standard error of measurement}

```{r twoPLmultidimensionalSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "SE")
```

#### Item Curves {#irt-twoPLmultidimensionalItemCurves}

##### Item Characteristic Curves {#irt-twoPLmultidimensionalICC}

Item characteristic curve ([ICC](#icc)) plots of the probability of item endorsement (or getting the item correct) as a function of a person's level on each latent construct (theta; $\theta$) are in Figures \@ref(fig:twoPLmultidimensionalICC) and \@ref(fig:twoPLmultidimensionalICCfacet).\index{item response theory!item characteristic curve}

```{r twoPLmultidimensionalICC, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "itemscore", facet_items = FALSE)
```

```{r twoPLmultidimensionalICCfacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-twoPLmultidimensionalIIF}

Plots of [item information](#irtReliability) as a function of a person's level on each latent construct (theta; $\theta$) are in Figures \@ref(fig:twoPLmultidimensionalIIF) and \@ref(fig:twoPLmultidimensionalIIFfacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r twoPLmultidimensionalIIF, out.width = "100%", fig.align = "center", fig.align = "center", fig.cap = "Item Information Curves From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "infotrace", facet_items = FALSE)
```

```{r twoPLmultidimensionalIIFfacet, out.width = "100%", fig.align = "center", fig.align = "center", fig.cap = "Item Information Curves From Two-Parameter Multidimensional Item Response Theory Model."}
plot(twoPL2FactorModel, type = "infotrace", facet_items = TRUE)
```

### CFA {#irt-twoPLmultidimensionalCFA}

A two-parameter multidimensional model can also be fit in a [CFA](#cfa) framework, sometimes called item factor analysis.\index{factor analysis!confirmatory}
The item factor analysis models were fit in the `lavaan` package [@R-lavaan].

```{r}
twoPLModelMultidimensional_cfa <- '
# Factor Loadings (i.e., discrimination parameters)
latent1 =~ loading1*Item.1 + loading4*Item.4 + loading5*Item.5
latent2 =~ loading2*Item.2 + loading3*Item.3

# Item Thresholds (i.e., difficulty parameters)
Item.1 | threshold1*t1
Item.2 | threshold2*t1
Item.3 | threshold3*t1
Item.4 | threshold4*t1
Item.5 | threshold5*t1
'

twoPLModelMultidimensional_cfa_fit = sem(
  model = twoPLModelMultidimensional_cfa,
  data = mydataIRT,
  ordered = c("Item.1", "Item.2", "Item.3", "Item.4","Item.5"),
  mimic = "Mplus",
  estimator = "WLSMV",
  std.lv = TRUE,
  parameterization = "theta")

summary(
  twoPLModelMultidimensional_cfa_fit,
  fit.measures = TRUE,
  rsquare = TRUE,
  standardized = TRUE)

fitMeasures(
  twoPLModelMultidimensional_cfa_fit,
  fit.measures = c(
    "chisq", "df", "pvalue",
    "baseline.chisq","baseline.df","baseline.pvalue",
    "rmsea", "cfi", "tli", "srmr"))

residuals(twoPLModelMultidimensional_cfa_fit, type = "cor")

modificationindices(twoPLModelMultidimensional_cfa_fit, sort. = TRUE)

compRelSEM(twoPLModelMultidimensional_cfa_fit)
AVE(twoPLModelMultidimensional_cfa_fit)

twoPLModelMultidimensional_cfa_factorScores <- lavPredict(twoPLModelMultidimensional_cfa_fit)
```

```{r, out.width = "100%", fig.align = "center", fig.cap = "Item Factor Analysis Diagram of Two-Parameter Multidimensional Logistic Model."}
semPaths(
  twoPLModelMultidimensional_cfa_fit,
  what = "std",
  layout = "tree2",
  edge.label.cex = 1.5)
```

## Three-Parameter Logistic Model {#irt-threePL}

A three-parameter logistic (3PL) IRT model is a model fit to dichotomous data, which estimates a different [difficulty](#itemDifficulty) ($b$), [discrimination](#itemDiscrimination) ($a$), and [guessing](#itemGuessing) parameter for each item.\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}
3PL models were fit using the `mirt` package [@R-mirt].\index{item response theory!three-parameter model}

### Fit Model {#irt-threePLfit}

```{r, results = "hide"}
threePLModel <- mirt(
  data = mydataIRT,
  model = 1,
  itemtype = "3PL",
  SE = TRUE)
```

### Model Summary {#irt-threePLoutput}

```{r}
summary(threePLModel)
coef(threePLModel, simplify = TRUE, IRTpars = TRUE)
```

### Factor Scores {#irt-threePLfactorScores}

```{r}
threePLModel_factorScores <- fscores(threePLModel, full.scores.SE = TRUE)
```

### Plots {#irt-threePLplots}

#### Test Curves {#irt-threePLtestCurves}

The test curves suggest that the measure is most [reliable](#reliability) (i.e., provides the most [information](#irtReliability) has the smallest [standard error of measurement](#irtReliability)) at lower levels of the construct.\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}

##### Test Characteristic Curve {#irt-threePLtcc}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:threePLtcc).\index{item response theory!item characteristic curve}

```{r threePLtcc, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "score")
```

##### Test Information Curve {#irt-threePLtif}

A plot of [test information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:threePLtif).\index{item response theory!information}

```{r threePLtif, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "info")
```

##### Test Reliability {#irt-threePLreliability}

The estimate of marginal [reliability](#irtReliability) is below:\index{reliability}

```{r}
marginal_rxx(threePLModel)
```

A plot of test [reliability](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:threePLreliability).\index{reliability}

```{r threePLreliability, out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "rxx")
```

##### Test Standard Error of Measurement {#irt-threePLsem}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:threePLsem).\index{item response theory!standard error of measurement}

```{r threePLsem, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "SE")
```

##### Test Information Curve and Standard Errors {#irt-threePLtifSEM}

A plot of [test information](#irtReliability) and [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:threePLtifSEM).\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

```{r threePLtifSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve and Standard Error of Measurement From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "infoSE")
```

#### Item Curves {#irt-threePLitemCurves}

##### Item Characteristic Curves {#irt-threePLicc}

Item characteristic curve ([ICC](#icc)) plots of the probability of item endorsement (or getting the item correct) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:threePLicc) and \@ref(fig:threePLiccFacet).\index{item response theory!item characteristic curve}

```{r threePLicc, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "itemscore", facet_items = FALSE)
```

```{r threePLiccFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-threePLiif}

Plots of [item information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:threePLiif) and \@ref(fig:threePLiifFacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r threePLiif, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "infotrace", facet_items = FALSE)
```

```{r threePLiifFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Three-Parameter Logistic Item Response Theory Model."}
plot(threePLModel, type = "infotrace", facet_items = TRUE)
```

## Four-Parameter Logistic Model {#irt-fourPL}

A four-parameter logistic (4PL) IRT model is a model fit to dichotomous data, which estimates a different [difficulty](#itemDifficulty) ($b$), [discrimination](#itemDiscrimination) ($a$), [guessing](#itemGuessing), and [careless errors](#itemCarelessErrors) parameter for each item.\index{item response theory!three-parameter model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}\index{item response theory!item guessing}\index{item response theory!item careless errors}
4PL models were fit using the `mirt` package [@R-mirt].\index{item response theory!four-parameter model}

### Fit Model {#irt-fourPLfit}

```{r, results = "hide"}
fourPLModel <- mirt(
  data = mydataIRT,
  model = 1,
  itemtype = "4PL",
  SE = TRUE,
  technical = list(NCYCLES = 2000))
```

### Model Summary {#irt-fourPLoutput}

```{r}
summary(fourPLModel)
coef(fourPLModel, simplify = TRUE, IRTpars = TRUE)
```

### Factor Scores {#irt-fourPLfactorScores}

```{r}
fourPLModel_factorScores <- fscores(fourPLModel, full.scores.SE = TRUE)
```

### Plots {#irt-fourPLplots}

#### Test Curves {#irt-fourPLtestCurves}

The test curves suggest that the measure is most [reliable](#reliability) (i.e., provides the most [information](#irtReliability) has the smallest [standard error of measurement](#irtReliability)) at middle to lower levels of the construct.\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}

##### Test Characteristic Curve {#irt-fourPLtcc}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:fourPLtcc).\index{item response theory!item characteristic curve}

```{r fourPLtcc, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "score")
```

##### Test Information Curve {#irt-fourPLtif}

A plot of [test information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:fourPLtif).\index{item response theory!information}\index{item response theory!test information curve}

```{r fourPLtif, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "info")
```

##### Test Reliability {#irt-fourPLreliability}

The estimate of marginal [reliability](#irtReliability) is below:\index{reliability}

```{r}
marginal_rxx(fourPLModel)
```

A plot of test [reliability](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:fourPLreliability).\index{reliability}

```{r fourPLreliability, out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "rxx")
```

##### Test Standard Error of Measurement {#irt-fourPLsem}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:fourPLsem).\index{item response theory!standard error of measurement}

```{r fourPLsem, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "SE")
```

##### Test Information Curve and Standard Errors {#irt-fourPLtifSEM}

A plot of [test information](#irtReliability) and [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:fourPLtifSEM).\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

```{r fourPLtifSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve and Standard Error of Measurement From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "infoSE")
```

#### Item Curves {#irt-fourPLitemCurves}

##### Item Characteristic Curves {#irt-fourPLicc}

Item characteristic curve ([ICC](#icc)) plots of the probability of item endorsement (or getting the item correct) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:fourPLicc) and \@ref(fig:fourPLiccFacet).\index{item response theory!item characteristic curve}

```{r fourPLicc, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "itemscore", facet_items = FALSE)
```

```{r fourPLiccFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-fourPLiif}

Plots of [item information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:fourPLiif) and \@ref(fig:fourPLiifFacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r fourPLiif, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "infotrace", facet_items = FALSE)
```

```{r fourPLiifFacet, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Four-Parameter Logistic Item Response Theory Model."}
plot(fourPLModel, type = "infotrace", facet_items = TRUE)
```

## Graded Response Model {#irt-gradedResponseModel}

A two-parameter graded response model (GRM) is an IRT model fit to polytomous data (in this case, a 1–4 likert scale), which estimates a different [difficulty](#itemDifficulty) ($b$) and [discrimination](#itemDiscrimination) ($a$) parameter for each item.\index{item response theory!graded response model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
It estimates four parameters for each item: [difficulty](#itemDifficulty) [for each of three threshold transitions: 1–2 ($b_1$), 2–3 ($b_2$), and 3–4 ($b_3$)] and [discrimination](#itemDiscrimination) ($a$).\index{item response theory!graded response model}\index{item response theory!item difficulty}\index{item response theory!item discrimination}
GRM models were fit using the `mirt` package [@R-mirt].\index{item response theory!graded response model}

### Fit Model {#irt-gradedResponseModelFit}

`Science` is a data set from the `mirt` package [@R-mirt] that contains four items evaluating people's attitudes to science and technology on a 1–4 Likert scale.\index{Likert scale}
The data are from the Consumer Protection and Perceptions of Science and Technology section of the 1992 Euro-Barometer Survey of people in Great Britain.

```{r, results = "hide"}
gradedResponseModel <- mirt(
  data = Science,
   model = 1,
   itemtype = "graded",
   SE = TRUE)
```

### Model Summary {#irt-gradedResponseModelOutput}

```{r}
summary(gradedResponseModel)
coef(gradedResponseModel, simplify = TRUE, IRTpars = TRUE)
```

### Factor Scores {#irt-gradedResponseModelFactorScores}

```{r}
gradedResponseModel_factorScores <- fscores(gradedResponseModel, full.scores.SE = TRUE)
```

### Plots {#irt-gradedResponseModelPlots}

#### Test Curves {#irt-gradedResponseModelTestCurves}

The test curves suggest that the measure is most [reliable](#reliability) (i.e., provides the most [information](#irtReliability) and has the smallest [standard error of measurement](#irtReliability)) across a wide range of construct.\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}
In general, this measure with polytomous (Likert-scale) items provides more information than the measure with binary items that were examined above.\index{data!dichotomous}\index{data!polytomous}\index{Likert scale}
This is consistent with the idea that polytomous items tend to provide more information than binary/dichotomous items.\index{data!dichotomous}\index{data!polytomous}\index{item response theory!information}

##### Test Characteristic Curve {#irt-gradedResponseModelTCC}

A test characteristic curve ([TCC](#icc)) plot of the expected total score as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelTCC).\index{item response theory!item characteristic curve}

```{r gradedResponseModelTCC, out.width = "100%", fig.align = "center", fig.cap = "Test Characteristic Curve From Graded Response Model."}
plot(gradedResponseModel, type = "score")
```

##### Test Information Curve {#irt-gradedResponseModelTIF}

A plot of [test information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelTIF).\index{item response theory!information}\index{item response theory!test information curve}

```{r gradedResponseModelTIF, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve From Graded Response Model."}
plot(gradedResponseModel, type = "info")
```

##### Test Reliability {#irt-gradedResponseModelReliability}

The estimate of marginal [reliability](#irtReliability) is below:\index{reliability}

```{r}
marginal_rxx(gradedResponseModel)
```

A plot of test [reliability](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelReliability).\index{reliability}

```{r gradedResponseModelReliability, out.width = "100%", fig.align = "center", fig.cap = "Test Reliability From Graded Response Model."}
plot(gradedResponseModel, type = "rxx")
```

##### Test Standard Error of Measurement {#irt-gradedResponseModelSEM}

A plot of test [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelSEM).\index{item response theory!standard error of measurement}

```{r gradedResponseModelSEM, out.width = "100%", fig.align = "center", fig.cap = "Test Standard Error of Measurement From Graded Response Model."}
plot(gradedResponseModel, type = "SE")
```

##### Test Information Curve and Standard Errors {#irt-gradedResponseModelTIFsem}

A plot of [test information](#irtReliability) and [standard error of measurement](#irtReliability) (SEM) as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelTIFsem).\index{item response theory!information}\index{reliability}\index{item response theory!standard error of measurement}\index{item response theory!test information curve}

```{r gradedResponseModelTIFsem, out.width = "100%", fig.align = "center", fig.cap = "Test Information Curve and Standard Error of Measurement From Graded Response Model."}
plot(gradedResponseModel, type = "infoSE")
```

#### Item Curves {#irt-gradedResponseModelItemCurves}

##### Item Characteristic Curves {#irt-gradedResponseModelICC}

Item characteristic curve ([ICC](#icc)) plots of the expected score on the item as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:gradedResponseModelICC) and \@ref(fig:gradedResponseModelICCfacet).\index{item response theory!item characteristic curve}

```{r gradedResponseModelICC, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Graded Response Model."}
plot(gradedResponseModel, type = "itemscore", facet_items = FALSE)
```

```{r gradedResponseModelICCfacet, out.width = "100%", fig.align = "center", fig.cap = "Item Characteristic Curves From Graded Response Model."}
plot(gradedResponseModel, type = "itemscore", facet_items = TRUE)
```

##### Item Information Curves {#irt-gradedResponseModelIIF}

Plots of [item information](#irtReliability) as a function of a person's level on the latent construct (theta; $\theta$) are in Figures \@ref(fig:gradedResponseModelIIF) and \@ref(fig:gradedResponseModelIIFfacet).\index{item response theory!information}\index{item response theory!item information curve}

```{r gradedResponseModelIIF, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Graded Response Model."}
plot(gradedResponseModel, type = "infotrace", facet_items = FALSE)
```

```{r gradedResponseModelIIFfacet, out.width = "100%", fig.align = "center", fig.cap = "Item Information Curves From Graded Response Model."}
plot(gradedResponseModel, type = "infotrace", facet_items = TRUE)
```

##### Item Response Category Characteristic Curves {#irt-gradedResponseModelIRCCC}

A plot of the probability of item threshold endorsement as a function of a person's level on the latent construct (theta; $\theta$) is in Figure \@ref(fig:gradedResponseModelIRCCC).\index{item response theory!item response category characteristic curve}

```{r gradedResponseModelIRCCC, out.width = "100%", fig.align = "center", fig.cap = "Item Response Category Characteristic Curves From Graded Response Model."}
plot(gradedResponseModel, type = "trace")
```

##### Item Boundary Characteristic Curves (aka Item Operation Characteristic Curves) {#irt-gradedResponseModelIOCC}

A plot of item boundary characteristic curves is in Figure \@ref(fig:gradedResponseModelIOCC).\index{item response theory!item boundary characteristic curve}
The plot of item boundary characteristic curves was adapted from an example by Aiden Loe:\index{item response theory!item boundary characteristic curve} https://aidenloe.github.io/irtplots.html (archived at https://perma.cc/D4YH-RV6N)

```{r gradedResponseModelIOCC, out.width = "100%", fig.align = "center", fig.cap = "Item Boundary Category Characteristic Curves From Graded Response Model."}
modelCoefficients <- coef(
  gradedResponseModel,
  IRTpars = TRUE,
  simplify = TRUE)$items

theta <- seq(from = -6, to = 6, by = .1)

difficultyThresholds <- grep(
  "b",
  dimnames(modelCoefficients)[[2]],
  value = TRUE)
numberDifficultyThresholds <- length(difficultyThresholds)
items <- dimnames(modelCoefficients)[[1]]
numberOfItems <- length(items)

lst <- lapply(
  1:numberOfItems,
  function(x) data.frame(
    matrix(ncol = numberDifficultyThresholds + 1,
           nrow = length(theta),
           dimnames = list(NULL, c("theta", difficultyThresholds)))))

for(i in 1:numberOfItems){
  for(j in 1:numberDifficultyThresholds){
    lst[[i]][,1] <- theta
    lst[[i]][,j + 1] <- fourPL(
      a = modelCoefficients[i,1],
      b = modelCoefficients[i,j + 1],
      theta = theta)
  }
}

names(lst) <- items
dat <- bind_rows(lst, .id = "item")
longer_data <- pivot_longer(
  dat,
  cols = all_of(difficultyThresholds))

ggplot(
  longer_data,
  aes(theta, value, group = interaction(item, name), color = item)) +
  geom_line() +
  ylab("Probability of Endorsing an Item Response Category that is Higher than the Boundary") +
  theme_bw() +
  theme(axis.title.y = element_text(size = 10))
```

## Conclusion {#conclusion-irt}

Item response theory is a measurement theory and advanced modeling approach that allows estimating latent variables as the common variance from multiple items, and it allows estimating how the items relate to the construct (latent variable).\index{item response theory}\index{latent variable}
IRT holds promise to enable the development of briefer assessments, including short forms and [adaptive assessments](#cat), that have strong [reliability](#reliability) and [validity](#validity).\index{item response theory}\index{brief assessment}\index{adaptive testing}\index{reliability}\index{validity}
However, there are situations where IRT models may not be preferable, such as when assessing a [formative construct](#formativeConstruct), when using [small sample sizes](#sampleSize-irt), or when [assumptions of IRT](#assumptions-irt) are violated.

## Suggested Readings {#readings-irt}

If you are interested in learning more about IRT, I highly recommend the book by @Embretson2000.\index{item response theory}

## Exercises {#exercises-irt}

```{r, include = FALSE}
library("MOTE")
```

```{r, include = FALSE}
# Load Data ---------------------------------------------------------------

cnlsy <- read_csv(here("Data", "cnlsy.csv"))
```

```{r, include = FALSE}
# Rasch Model (1-parameter logistic)

## Fit Model
raschModel_ex <- mirt(data = cnlsy[,c("bpi_antisocialT1_1","bpi_antisocialT1_2","bpi_antisocialT1_3","bpi_antisocialT1_4","bpi_antisocialT1_5","bpi_antisocialT1_6","bpi_antisocialT1_7")],
                   model = 1,
                   itemtype = "Rasch",
                   SE = TRUE)
```

```{r, include = FALSE}
## Model Summary

summary(raschModel_ex)
coef(raschModel_ex, simplify = TRUE, IRTpars = TRUE)

raschModelCoefficients_ex <- coef(raschModel_ex, simplify = TRUE, IRTpars = TRUE)$items
raschModelSmallestB1_ex <- min(raschModelCoefficients_ex[,"b1"], na.rm = TRUE)
raschModelLargestB2_ex <- max(raschModelCoefficients_ex[,"b2"], na.rm = TRUE)
```

```{r, include = FALSE}
## Plots

### Test Curves

#### Test Characteristic Curve
#plot(raschModel_ex, type = "score")

#### Test Information Curve
#plot(raschModel_ex, type = "info")

#### Test Reliability
#plot(raschModel_ex, type = "rxx")

#### Test Standard Error of Measurement
#plot(raschModel_ex, type = "SE")

#### Test Information Curve and Test Standard Error of Measurement
#plot(raschModel_ex, type = "infoSE")

### Item Curves

#### Item Characteristic Curves
#plot(raschModel_ex, type = "itemscore", facet_items = FALSE)
#plot(raschModel_ex, type = "itemscore", facet_items = TRUE)

#### Item Information Curves
#plot(raschModel_ex, type = "infotrace", facet_items = FALSE)
#plot(raschModel_ex, type = "infotrace", facet_items = TRUE)
```

```{r, include = FALSE}
# Graded Response Model

## Fit Model
gradedResponseModel_ex <- mirt(data = cnlsy[,c("bpi_antisocialT1_1","bpi_antisocialT1_2","bpi_antisocialT1_3","bpi_antisocialT1_4","bpi_antisocialT1_5","bpi_antisocialT1_6","bpi_antisocialT1_7")],
                            model = 1,
                            itemtype = "graded",
                            SE = TRUE)
```

```{r, include = FALSE}
## Model Summary

summary(gradedResponseModel_ex)
coef(gradedResponseModel_ex, simplify = TRUE, IRTpars = TRUE)

gradedResponseModelCoefficients_ex <- coef(gradedResponseModel_ex, simplify = TRUE, IRTpars = TRUE)$items
gradedResponseModelSmallestA_ex <- min(gradedResponseModelCoefficients_ex[,"a"], na.rm = TRUE)
gradedResponseModelLargestA_ex <- max(gradedResponseModelCoefficients_ex[,"a"], na.rm = TRUE)
```

```{r, include = FALSE}
## Plots

#### Test Characteristic Curve
#plot(gradedResponseModel_ex, type = "score")

#### Test Information Curve
#plot(gradedResponseModel_ex, type = "info")

#### Test Reliability
#plot(gradedResponseModel_ex, type = "rxx")

#### Test Standard Error of Measurement
#plot(gradedResponseModel_ex, type = "SE")

#### Test Information Curve and Standard Errors
#plot(gradedResponseModel_ex, type = "infoSE")

### Item Curves

#### Item Characteristic Curves
#plot(gradedResponseModel_ex, type = "itemscore", facet_items = FALSE)
#plot(gradedResponseModel_ex, type = "itemscore", facet_items = TRUE)

#### Item Information Curves
#plot(gradedResponseModel_ex, type = "infotrace", facet_items = FALSE)
#plot(gradedResponseModel_ex, type = "infotrace", facet_items = TRUE)

#### Item Information Curves Category Characteristic Curves
#plot(gradedResponseModel_ex, type = "trace")
```

```{r, include = FALSE}
#### Item Boundary Characteristic Curves (aka Item Operation Characteristic Curves)

difficultyThresholds_ex <- grep("b", dimnames(gradedResponseModelCoefficients_ex)[[2]], value = TRUE)
numberDifficultyThresholds_ex <- length(difficultyThresholds_ex)
items_ex <- dimnames(gradedResponseModelCoefficients_ex)[[1]]
numberOfItems_ex <- length(items_ex)

lst_ex <- lapply(1:numberOfItems_ex, function(x) data.frame(matrix(ncol = numberDifficultyThresholds_ex + 1, nrow = length(theta), dimnames = list(NULL, c("theta", difficultyThresholds_ex)))))

for(i in 1:numberOfItems_ex){
  for(j in 1:numberDifficultyThresholds_ex){
    lst_ex[[i]][,1] <- theta
    lst_ex[[i]][,j+1] <- fourPL(a = gradedResponseModelCoefficients_ex[i,1], b = gradedResponseModelCoefficients_ex[i,j+1], theta = theta)
  }
}

names(lst_ex) <- items_ex
dat_ex <- bind_rows(lst_ex, .id = "item")
longerData_ex <- pivot_longer(dat_ex, cols = all_of(difficultyThresholds_ex))
```

```{r, include = FALSE}
ggplot(longerData_ex, aes(theta, value, group = interaction(item, name), color = item)) +
  geom_line() +
  ylab("Probability of Endorsing an Item Response Category that is Higher than the Boundary")
```

```{r, include = FALSE}
# Multidimensional graded response model ---------------------------------

multidimensionalModel_ex <- mirt(data = cnlsy[,c("bpi_antisocialT1_1","bpi_antisocialT1_2","bpi_antisocialT1_3","bpi_antisocialT1_4","bpi_antisocialT1_5","bpi_antisocialT1_6","bpi_antisocialT1_7")],
                              model = 2,
                              itemtype = "graded",
                              SE = TRUE)
```

```{r, include = FALSE}
## Model Summary

summary(multidimensionalModel_ex)
coef(multidimensionalModel_ex, simplify = TRUE)
```

```{r, include = FALSE}
anova(gradedResponseModel_ex, multidimensionalModel_ex)

multidimensionalModelDiffTest <- anova(gradedResponseModel_ex, multidimensionalModel_ex)
multidimensionalModelChiSquareDiff <- multidimensionalModelDiffTest$"X2"[2]
multidimensionalModelDFDiff <- multidimensionalModelDiffTest$"df"[2]
```

```{r, include = FALSE}
## Plots

#### Test Characteristic Curve
#plot(multidimensionalModel_ex, type = "score")

#### Test Information Curve
#plot(multidimensionalModel_ex, type = "info")

#### Test Reliability
#plot(multidimensionalModel_ex, type = "rxx")

#### Test Standard Error of Measurement
#plot(multidimensionalModel_ex, type = "SE")

#### Test Information Curve and Standard Errors
#plot(multidimensionalModel_ex, type = "infoSE")

### Item Curves

#### Item Characteristic Curves
#plot(multidimensionalModel_ex, type = "itemscore", facet_items = FALSE)
#plot(multidimensionalModel_ex, type = "itemscore", facet_items = TRUE)

#### Item Information Curves
#plot(multidimensionalModel_ex, type = "infotrace", facet_items = FALSE)
#plot(multidimensionalModel_ex, type = "infotrace", facet_items = TRUE)

#### Item Information Curves Category Characteristic Curves
#plot(multidimensionalModel_ex, type = "trace")
```

### Questions {#exercisesQuestions-irt}

Note: Several of the following questions use data from the Children of the National Longitudinal Survey of Youth Survey (CNLSY).
The CNLSY is a publicly available longitudinal data set provided by the Bureau of Labor Statistics (https://www.bls.gov/nls/nlsy79-children.htm#topical-guide; archived at https://perma.cc/EH38-HDRN).
The CNLSY data file for these exercises is located on the book's page of the Open Science Framework (https://osf.io/3pwza).
Children's behavior problems were rated in 1988 (time 1: T1) and then again in 1990 (time 2: T2) on the Behavior Problems Index (BPI).
Below are the items corresponding to the Antisocial subscale of the BPI:

1) cheats or tells lies
2) bullies or is cruel/mean to others
3) does not seem to feel sorry after misbehaving
4) breaks things deliberately
5) is disobedient at school
6) has trouble getting along with teachers
7) has sudden changes in mood or feeling

1. Fit a one-parameter (Rasch) model to the seven items of the Antisocial subscale of the BPI at T1.
This will estimate the difficulty for each item threshold (one threshold from 0 to 1, and one threshold from 1 to 2), while constraining the discrimination for each item to be the same.
    a. Which item has the lowest difficulty (i.e., severity) in terms of endorsing a score of one (i.e., "sometimes true") as opposed to zero (i.e., "not true")?
Which item has the highest difficulty in terms of endorsing a score of 2 (i.e., "often true")?
What do these estimates of item difficulty indicate?
2. Fit a graded response model to the seven items of the Antisocial subscale of the BPI at T1.
This will estimate the difficulty for each item threshold (one threshold from 0 to 1, and one threshold from 1 to 2), while allowing each item to have a different discrimination.
    a. Provide a figure of the item characteristic curves.
    b. Provide a figure of the item boundary characteristic curves.
    c. Which item has the lowest discrimination?
Which item has the highest discrimination?
What do these estimates of item discrimination indicate?
    d. Provide a figure of the item information curves.
    e. Examining the item information curves, which item provides the most information at upper construct levels (2–4 standard deviations above the mean)?
Which item provides the most information at lower construct levels (2–4 standard deviations below the mean)?
    f. Provide a figure of the test information curve.
    g. Examining the test information curve, where (at what construct levels) does the measure do the best job of assessing?
Based on its information curve, describe what purposes the test would be better- or worse-suited for.
3.
Fit a multidimensional graded response model to the seven items of the Antisocial subscale of the BPI at T1, by estimating two latent factors.
    a. Which items loaded onto Factor 1?
Which items loaded onto Factor 2?
Provide a possible explanation as two why some of the items "broke off" (from Factor 1) and loaded onto a separate factor (Factor 2).
    b. The one-factor graded response model (in #2) and the two-factor graded response model are considered "nested" models.
	The one-factor model is nested within the two-factor model because the two-factor model includes all of the terms of the one-factor model along with additional terms.
	Model fit of nested models can be directly compared with a chi-square difference test.
	Did the two-factor model fit better than the one-factor model?

### Answers {#exercisesAnswers-irt}

1.
    a. Item 7 (“sudden changes in mood or feeling”) has the lowest difficulty in terms of endorsing a score of one $(b_1 = `r apa(raschModelSmallestB1_ex, decimals = 2)`)$.
	Item 5 (“disobedient at school”) has the highest difficulty in terms of endorsing a score of two $(b_2 = `r apa(raschModelLargestB2_ex, decimals = 2)`)$.
	The difficulty parameter indicates the construct-level at the inflection point of the item characteristic curve.
	In a one- or two-parameter model, the inflection point occurs where 50% of respondents endorse the item.
	Thus, in this model, the difficulty parameter indicates the construct-level at which 50% of respondents endorse the item.
	It takes a very high level of antisocial behavior for a child to be endorsed as being often disobedient at school, whereas it does not take a high construct-level for a child to be endorsed as sometimes showing sudden changes in mood.
2.
    a. Below is a figure of item characteristic curves:

```{r, echo = FALSE, out.width = "100%", fig.align = "center", fig.cap = c("Exercise 1a: Item Characteristic Curves.")}
plot(gradedResponseModel_ex, type = "itemscore", facet_items = FALSE, main = "Item Characteristic Curves")
```

2.
    b. Below is a figure of item boundary characteristic curves:
    
```{r, echo = FALSE, out.width = "100%", fig.align = "center", fig.cap = c("Exercise 2b: Item Boundary Characteristic Curves.")}
ggplot(longerData_ex, aes(theta, value, group = interaction(item, name), color = item)) +
  geom_line() +
  ylab("Probability of Item Boundary Endorsement") +
  theme_bw()
```

2.
    c. Item 7 ("sudden changes in mood or feeling") has the lowest discrimination $(a = `r apa(gradedResponseModelSmallestA_ex, decimals = 2)`)$.
	Item 6 ("has trouble getting along with teachers") has the highest discrimination $(a = `r apa(gradedResponseModelLargestA_ex, decimals = 2)`)$.
	The discrimination parameter represents the steepness of the slope of the item characteristic curve.
	It indicates how strongly endorsing an item discriminates (differentiates) between lower versus higher construct levels.
	In other words, it indicates how strongly the item is associated with the construct.
	Item 7 shows the weakest association with the construct, whereas item 6 shows the strongest association with the construct.
	That suggests that "trouble getting along with teachers" is more core to the construct of antisocial behavior than "sudden changes in mood."
    d. Below is a figure of item information curves:

```{r, echo = FALSE, out.width = "100%", fig.align = "center", fig.cap = c("Exercise 2c: Item Information Curves.")}
plot(gradedResponseModel_ex, type = "infotrace", facet_items = FALSE, main = "Item Information Curves")
```

2.
    e. Item 6 ("has trouble getting along with teachers") provides the most information at upper construct levels (2–4 standard deviations above the mean).
	Item 7 ("has trouble getting along with teachers") provides the most information at lower construct levels (2–4 standard deviations below the mean).
	Item 1 ("cheats or tells lies") provides the most information at somewhat low construct levels (0–2 standard deviations below the mean).
    f.
    
```{r, echo = FALSE, out.width = "100%", fig.align = "center", fig.cap = c("Exercise 2e: Test Information Curve.")}
plot(gradedResponseModel_ex, type = "info", main = "Test Information Curve")
```

2.
    g. The measure does the best job of assessing (i.e., provides the most information) at construct levels from 1–3 standard deviations above the mean.
	Because the measure provides the most information at upper construct levels and provides little information at lower construct levels, the measure would be best used for assessing clinical versus sub-clinical levels of antisocial behavior rather than assessing individual differences in antisocial behavior across a community sample.
3.
    a. Items 1, 2, 3, 4, and 7 loaded onto Factor 1.
	Items 5 and 6 loaded onto Factor 2.
	Items 5 ("disobedient at school") and 6 ("trouble getting along with teachers") both deal with school-related antisocial behavior.
	Thus, the items assessing school-related antisocial behavior may share variance owing to the shared context of the behavior (school).
    b. Yes, the two-factor model fit significantly better than the one-factor model according to a chi-square difference test $(\Delta\chi^2[df = `r apa(multidimensionalModelDFDiff, decimals = 2)`] = `r apa(multidimensionalModelChiSquareDiff, decimals = 2)`, p < .001)$.
	Thus, antisocial behavior may not be a monolithic construct, but may depend on the context in which the behavior occurs.