tests/testthat/test-multinomial.R

In rpf: Response Probability Functions

#options(error = browser)
library(testthat)
library(rpf)

suppressWarnings(RNGversion("3.5"))

context("multinomialFit")

test_that("multinomialFit full info, simple", {
  require(rpf)
  set.seed(7)
  grp <- list(spec=list())
  grp$spec[1:10] <- list(rpf.grm())
  grp$param <- sapply(grp$spec, rpf.rparam)
  colnames(grp$param) <- paste("i", 1:10, sep="")
  grp$mean <- 0
  grp$cov <- diag(1)
  grp$uniqueFree <- sum(grp$param != 0)
  grp$data <- compressDataFrame(rpf.sample(1500, grp=grp), .asNumeric=TRUE)
  grp$weightColumn <- 'freq'
  grp$observedStats <- nrow(grp$data) - 1
  
  # screw up fit
  grp$param[2,] <- grp$param[2,] + runif(10, -.75, .75)

  got <- multinomialFit(grp, method="pearson")
  expect_equal(got$statistic, 1287.46, tolerance=.01)
  expect_equal(got$df, 209)
  expect_equal(got$pval, -354, tolerance=.1)

  got <- multinomialFit(grp, method="lr")
  expect_equal(got$statistic, 914.35, tolerance=.01)
  expect_equal(got$df, 209)
  expect_equal(got$pval, -202, tolerance=.1)
})

test_that("multinomialFit full info, simple w/ missingness", {
  require(rpf)
  require(testthat)
  
  set.seed(7)
  grp <- list(spec=list())
  grp$spec[1:10] <- list(rpf.grm())
  grp$param <- sapply(grp$spec, rpf.rparam)
  colnames(grp$param) <- paste("i", 1:10, sep="")
  grp$mean <- 0
  grp$cov <- diag(1)
  grp$free <- grp$param != 0
  grp$labels <- matrix(NA, nrow(grp$param), ncol(grp$param))
  grp$uniqueFree <- sum(grp$param != 0)
  grp$data <- compressDataFrame(rpf.sample(1500, grp=grp, mcar=.1), .asNumeric=TRUE)
  grp$weightColumn <- 'freq'
  grp$observedStats <- nrow(grp$data) - 1
  
  got <- multinomialFit(grp, method="pearson")
  expect_equal(got$statistic, 1115.63, tolerance=.01)
  expect_equal(got$df, 710)
  expect_equal(got$pval, -45.7, tolerance=.1)

  got <- multinomialFit(grp, method="lr")
  expect_equal(got$statistic, 414.691, tolerance=.01)
  expect_equal(got$df, 710)
  expect_equal(got$pval, 0, tolerance=.01)
  expect_equal(got$n, 521)

  got <- multinomialFit(omitMostMissing(grp, 1), method="lr")
  expect_equal(got$statistic, 253.39, tolerance=.01)
  expect_equal(got$df, 585)
  expect_equal(got$pval, 0, tolerance=.01)
  expect_equal(got$n, 598)
})

test_that("multinomialFit full info, two-tier", {
  require(rpf)
  spec <- list()
  spec[1:5] <- list(rpf.drm(factors=3))
  gen.param <- sapply(spec, rpf.rparam)
  gen.param['a2', 1:2] <- 0
  gen.param['a3', 3] <- 0
  gen.param[c('a2','a3'), 4:5] <- 0
  colnames(gen.param) <- paste("i", 1:ncol(gen.param), sep="")
  resp <- rpf.sample(1500, spec, gen.param)
  grp <- list(spec=spec, param=gen.param, mean=runif(3, 0, 1), cov=diag(runif(3,1,2)),
              data=resp, uniqueFree=sum(gen.param!=0), qwidth=5, qpoints=21)
  
  got1 <- multinomialFit(grp, .twotier = FALSE)
  got2 <- multinomialFit(grp, .twotier = TRUE)
  expect_equal(got1$statistic, got2$statistic, tolerance=.001)
  expect_equal(got1$df, got2$df)
  expect_equal(got1$pval, got2$pval, tolerance=.001)
})

if (0) {
  # matches flexmirt exactly
  library(mirt)
  dat <- expand.table(LSAT7)
  (mod1 <- mirt(dat, 1, calcNull=TRUE))
  i1 <- extract.item(mod1, 1)
  expected.item(i1, seq(-4,4,.5), min=0L)
  M2(mod1)
  M2(mod1@null.mod)
  write.table(dat, file = "LSAT7.csv", row.names = FALSE, col.names=FALSE)
}