In this tutorial, we’ll try running a couple of many-facet Rasch models on data from McNamara et al. (2020) Ch. 5 using TAM.

TAM is one of the few packages that can run MFRMs in a manner similar to Facets. It can do a decent job, but the effort involved is a bit more. I’m still learning how to get the kind of output I want, but the core stuff - person reliability, element estimates, fit statistics, etc. - can all be extracted without too much difficulty.

Set-up

Load pacakages and data:

library(tidyverse)
library(TAM)
library(WrightMap)
library(cowplot)

d <- read_csv("writing assessment.csv")

The cowplot package provides some additional tools for plotting that we’ll play with later.

Reshape data

I generally prefer working with long data when doing MFRM analyses. Facets allows you to work with long data, and it seems preferable for TAM, too.

Another thing we’re going to do is make the lowest score category 0. TAM estimates based on a 0 category existing. In this case, there were no scores below 3, so we’ll sutract 3 from each score.

d <- d %>% pivot_longer(content:voc, names_to = "crit", values_to = "score") %>%
  mutate(score = score - 3)

MFRM with a Rating Scale Model

To run MFRM in TAM, we use the tam.mml.mfr() function. This function requires you to specify a model formula, and these are specified using the general R format.

Other than that, you just need to tell the function what the score column is, what the (non-person) facet columns are, and what your person id column is.

formula <- ~ crit + step + rater

mfrm <- tam.mml.mfr(resp = d$score, 
                    facets = select(d, rater:crit), 
                    pid = d$candidate,
                    formulaA = formula)

Now we can use some other functions to get person and item statistics in helpful formats.

person.fit <- tam.personfit(mfrm)
person.mod <- tam.wle(mfrm)
## Iteration in WLE/MLE estimation  1   | Maximal change  1.2951 
## Iteration in WLE/MLE estimation  2   | Maximal change  0.1074 
## Iteration in WLE/MLE estimation  3   | Maximal change  0.0017 
## Iteration in WLE/MLE estimation  4   | Maximal change  0 
## ----
##  WLE Reliability= 0.975
item.fit <- msq.itemfit(mfrm)

thresholds <- tam.threshold(mfrm)

Now we’ll try a Wright Map using the WrightMap package.

IRT.WrightMap(mfrm)

So uh, yeah, that’s not very pretty. It would take a lot of work and tinkering around to get this function to put out something decent-looking for MFRM.

Manually creating a Wright Map

I was not pleased with the IRT.WrightMap() output. I found some helpful code to get me started from a paper by Primi et al. (2019 - https://psycnet.apa.org/doi/10.1037/aca0000230) and made some modifications from there.

First, we’ll make separate plots using the measures (or thresholds) from the facets of interest.

f1 <- ggplot(data = person.mod, aes(x = theta))+
  geom_dotplot(binwidth = .1, stackdir = "down") +
  theme_bw()  +
  scale_y_continuous(name = "", breaks = NULL) +
  scale_x_continuous(breaks=seq(-6, 4, .5), limits=c(-6, 4), 
                     position =  "top") + 
  theme(axis.title.y = element_blank(), 
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())+
  labs(title = "Persons") + 
  coord_flip()

f2 <- mfrm$xsi.facets %>%
  filter(str_starts(parameter, "rater")) %>%
  ggplot(aes(x = xsi)) +
  geom_dotplot(binwidth = .1) +
  theme_bw()  +
  scale_y_continuous(name = "", breaks = NULL) +
  scale_x_continuous(breaks=seq(-6, 4, .5), limits=c(-6, 4), 
                     position =  "top") + 
  theme(axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.title.x= element_blank())+
  labs(title = "Raters") + 
  coord_flip()

f3 <- mfrm$xsi.facets %>%
  filter(str_starts(parameter, "crit")) %>%
  ggplot(aes(x = xsi)) +
    geom_dotplot(binwidth = .1) +
    theme_bw()  +
    scale_y_continuous(name = "", breaks = NULL) +
    scale_x_continuous(breaks=seq(-6, 4, .5), limits=c(-6, 4),
                       position =  "top") + 
    theme(axis.title.y=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks.y=element_blank(),
          axis.title.x= element_blank())+
    labs(title = "Criteria") + 
    coord_flip()

f4 <- mfrm$xsi.facets %>%
  filter(str_starts(parameter, "crit")) %>%
  ggplot(aes(x = xsi)) +
  geom_vline(xintercept = mfrm$xsi.facets$xsi[1:6]) +
  theme_bw()  +
  scale_y_continuous(name = "", breaks = NULL) +
  scale_x_continuous(breaks=seq(-6, 4, .5), limits=c(-6, 4), 
                     position =  "top") + 
  theme(axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.title.x= element_blank())+
  labs(title = "Scale") + 
  coord_flip()

Now we’ll use plot_grid() from the cowplot package to put everything together:

plot_grid(f1, f2, f3, f4, nrow = 1, rel_widths = c(.5, .25, .25, .25))

This looks a bit better. It could still use a bit of customization, like labels for the score categories and maybe raters/criteria, too. But it’s readable.

MFRM with a Partial Credit Model

We can also implement the PCM in TAM. This is done by creating an interaction between rubric criteria and steps in the rating scale crit*step.

formula.pcm <- ~ crit*step + rater

mfrm.pcm <- tam.mml.mfr(resp = d$score, 
                        facets = select(d, rater:crit), 
                        pid = d$candidate, formulaA = formula.pcm)

person.fit.pcm <- tam.personfit(mfrm.pcm)
person.mod.pcm <- tam.wle(mfrm.pcm)

item.fit.pcm <- msq.itemfit(mfrm.pcm)