tests/testthat/test-sample.R

In rpf: Response Probability Functions

library(testthat)
library(rpf)

context("sample")

unfactor <- function(data) {
  for(s in ls(data)) {
    if (is.factor(data[[s]])) {
      data[[s]] <- unclass(data[[s]])
    }
  }
}

compare.df <- function(df1, df2) {
  df1 <- unfactor(df1)
  df2 <- unfactor(df2)
  expect_identical(dim(df1), dim(df2))
  expect_identical(df1, df2)
}

set.seed(1)

test_that("1 dimensional items", {
  i1 <- rpf.drm()
  i1.p <- rpf.rparam(i1, version=1)
  i2 <- rpf.nrm(outcomes=3)
  i2.p <- rpf.rparam(i2, version=1)
  data <- rpf.sample(3, list(i1,i2), list(i1.p, i2.p))
  compare.df(unclass(data), data.frame(i1=c(2,1,1), i2=c(3,3,3)))

  data <- rpf.sample(runif(3), list(i1,i2), list(i1.p, i2.p))
  compare.df(unclass(data), data.frame(i1=c(2,1,2), i2=c(3,2,3)))
})

test_that("multidimension, no design", {
	set.seed(1)
  numItems <- 3
  items <- vector("list", numItems)
  correct <- vector("list", numItems)

  i1 <- rpf.drm(factors=2)
  for (ix in 1:numItems) {
    items[[ix]] <- i1
    correct[[ix]] <- rpf.rparam(i1, version=1)
  }

  data <- rpf.sample(3, items, correct)
  expect_identical(c(simplify2array(data)),
                   c("2", "1", "2", "2", "1", "1", "1", "2", "2"),
                   info=paste(deparse(simplify2array(data)), collapse="\n"))
})

test_that("1d and 2d", {
  numItems <- 4
  i1 <- rpf.drm()
  i2 <- rpf.drm(factors=2)
  items <- vector("list", numItems)
  for (ix in seq(1,numItems,2)) items[[ix]] <- i1
  for (ix in seq(2,numItems,2)) items[[ix]] <- i2
  correct <- lapply(items, rpf.rparam, version=1)
  data <- rpf.sample(4, items, correct)
  expect_true(all(dim(data) == c(4,4)))
})