R/irtplot.R

In talbano/epmr: Tools for Educational and Psychological Measurement

#' Item Response Theory Plotting
#'
#' Functions for plotting results from item response theory models.
#'
#' @title irtplot
#' @param x irtstudy output.
#' @param theta vector of theta values, taken by default from \code{x} in
#' \code{ip_plot} and in other functions defaulting to a sequence of values.
#' @param b vector of item location parameters, taken by default from
#' \code{x}.
#' @param groups vector defining person groups, defaulting to one group.
#' @param tests vector defining tests, i.e., item groups, defaulting to one.
#' @param ip data frame of item parameters, taken from \code{x}.
#' @param type type of plot generated by \code{ip_plot}, whether "density",
#' the default, or "frequency", i.e., histogram.
#' @examples
#'
#' ritems <- c("r414q02", "r414q11", "r414q06", "r414q09",
#'   "r452q03", "r452q04", "r452q06", "r452q07", "r458q01",
#'   "r458q07", "r458q04")
#' rsitems <- paste0(ritems, "s")
#' pisagbr <- PISA09[PISA09$cnt == "GBR", rsitems]
#' irtgbr <- irtstudy(pisagbr)
#'
#' # Item person map
#' print(ip_plot(irtgbr))
#'
#' # Item response functions
#' print(irf_plot(irtgbr))
#'
#' # Test response functions
#' print(tef_plot(irtgbr))
#'
#' @rdname irtplot
#' @export
ip_plot <- function(x, theta, b, groups = rep(1, length(theta)),
  tests = rep(1, length(b)), type = "density") {

  if (!missing(x)) {
    if (missing(theta)) theta <- x$data$theta
    if (missing(b)) b <- x$ip$b
  }
  df <- tibble::tibble(theta = double(), source = character())
  if (!missing(theta)) {
    for (p in unique(groups))
      df <- dplyr::bind_rows(df, tibble::tibble(theta = theta[groups == p],
        source = paste("group", p)))
    if (length(unique(groups)) == 1)
      df$source <- gsub("group 1", "person", df$source)
  }
  if (!missing(b)) {
    for (i in unique(tests))
      df <- dplyr::bind_rows(df, tibble::tibble(theta = b[tests == i],
        source = paste("test", i)))
    if (length(unique(tests)) == 1)
      df$source <- gsub("test 1", "item", df$source)
  }
  out <- ggplot2::ggplot(df, ggplot2::aes(x = theta, fill = source))
  type <- match.arg(type, c("density", "frequency"))
  if (type == "density")
    out <- out + ggplot2::geom_density(alpha = 0.2, linewidth = 0)
  else
    out <- out + ggplot2::geom_histogram(alpha = 0.2, position = "identity")
  out <- out + ggplot2::theme(legend.title = ggplot2::element_blank())
  return(out)
}

#' @rdname irtplot
#' @export
irf_plot <- function(x, ip = x$ip, theta = seq(-4, 4, length = 100)) {
  irf <- rirf(ip, theta = theta)[, -1]
  item <- rep(colnames(irf), each = length(theta))
  p <- unlist(irf)
  df <- tibble::tibble(theta = rep(theta, nrow(ip)), p = p,
    item = item)
  out <- ggplot2::ggplot(df, ggplot2::aes(x = theta, y = p, color = item)) +
    ggplot2::geom_line()
  return(out)
}

#' @rdname irtplot
#' @export
tef_plot <- function(x, ip = x$ip, theta = seq(-4, 4, length = 100)) {
  df <- tibble::as_tibble(rtef(ip, theta = theta))
  se <- df$se
  out <- ggplot2::ggplot(df, ggplot2::aes(x = theta, y = se)) +
    ggplot2::geom_line()
  return(out)
}