R/make_aberrant.R

In Pflegermeister/wizirt2: A United API for IRT in R

make_aberrant <- function(N_abb = amount[[a]]*N,
                          at = NULL,
                          len = length[[l]],
                          step = step[[l]],
                          N = NULL,
                          seed = NULL){
  set.seed(seed = seed)
  disc <- rep(1, len)
  diff <- seq(from = -2, to = 2, by = step)

  ability <- runif(N - N_abb, -2, 2)

  data <- mirt::simdata(a = disc,
                        d = diff,
                        Theta = matrix(ability),
                        itemtype = 'dich')

  if (at =="cheat") {
    abilities <- runif(N_abb, -2, -.5)
    responses <- mirt::simdata(a = disc,
                               d = diff,
                               Theta = matrix(abilities),
                               itemtype = 'dich')
    responses[,which(diff %in%
                       sort(diff,
                            decreasing = T)[1:round(len*.18)])] = 1
  } else if (at =="create") {
    abilities <- runif(N_abb, .5, 2)
    responses <- mirt::simdata(a = disc,
                               d = diff,
                               Theta = matrix(abilities),
                               itemtype = 'dich')
    responses[,which(diff %in%
                       sort(diff)[1:round(len*.18)])] = 0
  } else if (at =="guess") {
    abilities <- runif(N_abb, -2, -.5)
    responses <- mirt::simdata(a = disc,
                               d = diff,
                               Theta = matrix(abilities),
                               itemtype = 'dich')

    intmd <- responses[,which(diff %in%
                                sort(diff,
                                     decreasing = T)[1:round(len*.41)])]

    ir <- matrix(sample(0:1,
                        length(intmd),
                        replace = T,
                        prob = c(.75, .25)
    ), ncol = ncol(intmd),
    dimnames = list(rownames(responses),
                    colnames(intmd)))

    responses[,colnames(ir)] = ir

  } else if (at =="careless") {
    abilities <- runif(N_abb, .5, 2)
    responses <- mirt::simdata(a = disc,
                               d = diff,
                               Theta = matrix(abilities),
                               itemtype = 'dich')

    intmd <- responses[,which(diff %in%
                                sort(diff)[1:round(len*.41)])]

    ir <- matrix(sample(0:1,
                        length(intmd),
                        replace = T,
                        prob = c(.5, .5)
    ), ncol = ncol(intmd),
    dimnames = list(rownames(responses),
                    colnames(intmd)))

    responses[,colnames(ir)] = ir

  } else if (at =="random") {
    responses <- t(sapply(1:N_abb, function(x)
    {sample(0:1,
            size = len,
            replace = T,
            prob = c(.75, .25))}))
  } else {
    rlang::abort(glue::glue('Aberrance type "{at}" not recognized.'))
  }
  rbind(cbind(data, aberrant = 0), cbind(responses, aberrant = 1))
}