Nothing
#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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.