tests/testthat/test-difNLR.R
In drabinova/difNLR: DIF and DDF Detection by Non-Linear Regression Models
test_that("difNLR - examples at help page", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# testing both DIF effects with adjacent category logit model
expect_snapshot((fit1 <- difNLR(Data, group, focal.name = 1, model = "3PLcg")))
# saveRDS(fit1, file = "tests/testthat/fixtures/difNLR_fit1.rds")
fit1_expected <- readRDS(test_path("fixtures", "difNLR_fit1.rds"))
expect_equal(fit1, fit1_expected)
# graphical devices
fit1_plot1 <- plot(fit1, item = "Item1")[[1]]
vdiffr::expect_doppelganger("difNLR_fit1_plot1", fit1_plot1)
fit1_plot2 <- plot(fit1, item = 1, group.names = c("Group 1", "Group 2"))[[1]]
vdiffr::expect_doppelganger("difNLR_fit1_plot2", fit1_plot2)
fit1_plot3 <- plot(fit1, plot.type = "stat")
vdiffr::expect_doppelganger("difNLR_fit1_plot3", fit1_plot3)
# estimated parameters
# saveRDS(coef(fit1), file = "tests/testthat/fixtures/difNLR_fit1_coef1.rds")
fit1_coef1_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef1.rds"))
expect_equal(coef(fit1), fit1_coef1_expected)
# saveRDS(coef(fit1, SE = TRUE), file = "tests/testthat/fixtures/difNLR_fit1_coef2.rds")
fit1_coef2_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef2.rds"))
expect_equal(coef(fit1, SE = TRUE), fit1_coef2_expected) # with SE
# saveRDS(coef(fit1, SE = TRUE, simplify = TRUE), file = "tests/testthat/fixtures/difNLR_fit1_coef3.rds")
fit1_coef3_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef3.rds"))
expect_equal(coef(fit1, SE = TRUE, simplify = TRUE), fit1_coef3_expected) # with SE, simplified
# fitted values
expect_snapshot(summary(fitted(fit1)))
expect_snapshot(fitted(fit1, item = 1))
# residuals
expect_snapshot(summary(residuals(fit1)))
expect_snapshot(residuals(fit1, item = 1))
# predicted values
expect_snapshot(summary(predict(fit1)))
expect_snapshot(predict(fit1, item = 1))
expect_equal(predict(fit1, item = 1)$prob, as.vector(fitted(fit1, item = 1)))
# predicted values for new subjects
expect_snapshot(predict(fit1, item = 1, match = 0, group = c(0, 1)))
# AIC, BIC, log-likelihood
expect_snapshot(AIC(fit1))
expect_snapshot(BIC(fit1))
expect_snapshot(logLik(fit1))
# AIC, BIC, log-likelihood for the first item
expect_snapshot(AIC(fit1, item = 1))
expect_snapshot(BIC(fit1, item = 1))
expect_snapshot(logLik(fit1, item = 1))
# testing both DIF effects using Wald test and
# 3PL model with fixed guessing for groups
expect_snapshot((fit2 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", test = "W")))
# saveRDS(fit2, file = "tests/testthat/fixtures/difNLR_fit2.rds")
fit2_expected <- readRDS(test_path("fixtures", "difNLR_fit2.rds"))
expect_equal(fit2, fit2_expected)
# testing both DIF effects using F test and
# 3PL model with fixed guessing for groups
expect_snapshot((fit3 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", test = "F")))
# saveRDS(fit3, file = "tests/testthat/fixtures/difNLR_fit3.rds")
fit3_expected <- readRDS(test_path("fixtures", "difNLR_fit3.rds"))
expect_equal(fit3, fit3_expected)
# testing both DIF effects using
# 3PL model with fixed guessing for groups and sandwich estimator
# of the covariance matrices
expect_snapshot((fit4 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", sandwich = TRUE)))
# saveRDS(fit4, file = "tests/testthat/fixtures/difNLR_fit4.rds")
fit4_expected <- readRDS(test_path("fixtures", "difNLR_fit4.rds"))
expect_equal(fit4, fit4_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# and Benjamini-Hochberg correction
expect_snapshot((fit5 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", p.adjust.method = "BH")))
# saveRDS(fit5, file = "tests/testthat/fixtures/difNLR_fit5.rds")
fit5_expected <- readRDS(test_path("fixtures", "difNLR_fit5.rds"))
expect_equal(fit5, fit5_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# and item purification
expect_snapshot((fit6 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", purify = TRUE)))
# saveRDS(fit6, file = "tests/testthat/fixtures/difNLR_fit6.rds")
fit6_expected <- readRDS(test_path("fixtures", "difNLR_fit6.rds"))
expect_equal(fit6, fit6_expected)
# testing both DIF effects using 3PL model with fixed guessing for groups
# and total score as matching criterion
expect_snapshot((fit7 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", match = "score")))
# saveRDS(fit7, file = "tests/testthat/fixtures/difNLR_fit7.rds")
fit7_expected <- readRDS(test_path("fixtures", "difNLR_fit7.rds"))
expect_equal(fit7, fit7_expected)
# testing uniform DIF effects using 4PL model with the same
# guessing and inattention
expect_snapshot((fit8 <- difNLR(Data, group, focal.name = 1, model = "4PLcgdg", type = "udif")))
# saveRDS(fit8, file = "tests/testthat/fixtures/difNLR_fit8.rds")
fit8_expected <- readRDS(test_path("fixtures", "difNLR_fit8.rds"))
expect_equal(fit8, fit8_expected)
# testing non-uniform DIF effects using 2PL model
expect_snapshot((fit9 <- difNLR(Data, group, focal.name = 1, model = "2PL", type = "nudif")))
# saveRDS(fit9, file = "tests/testthat/fixtures/difNLR_fit9.rds")
fit9_expected <- readRDS(test_path("fixtures", "difNLR_fit9.rds"))
expect_equal(fit9, fit9_expected)
# testing difference in parameter b using 4PL model with fixed
# a and c parameters
expect_snapshot((fit10 <- difNLR(Data, group, focal.name = 1, model = "4PL", constraints = "ac", type = "b")))
# saveRDS(fit10, file = "tests/testthat/fixtures/difNLR_fit10.rds")
fit10_expected <- readRDS(test_path("fixtures", "difNLR_fit10.rds"))
expect_equal(fit10, fit10_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# using maximum likelihood estimation with
# the L-BFGS-B algorithm, the EM algorithm, and the PLF algorithm
expect_snapshot((fit11 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "mle")))
# saveRDS(fit11, file = "tests/testthat/fixtures/difNLR_fit11.rds")
fit11_expected <- readRDS(test_path("fixtures", "difNLR_fit11.rds"))
expect_equal(fit11, fit11_expected)
# expect_snapshot((fit12 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "em")))
# # saveRDS(fit12, file = "tests/testthat/fixtures/difNLR_fit12.rds")
# fit12_expected <- readRDS(test_path("fixtures", "difNLR_fit12.rds"))
# expect_equal(fit12, fit12_expected)
expect_snapshot((fit13 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "plf")))
# saveRDS(fit13, file = "tests/testthat/fixtures/difNLR_fit13.rds")
fit13_expected <- readRDS(test_path("fixtures", "difNLR_fit13.rds"))
expect_equal(fit13, fit13_expected)
# testing both DIF effects using LR test and 2PL model
# using maximum likelihood estimation with iteratively reweighted least squares algorithm
expect_snapshot((fit14 <- difNLR(Data, group, focal.name = 1, model = "2PL", method = "irls")))
# saveRDS(fit14, file = "tests/testthat/fixtures/difNLR_fit14.rds")
fit14_expected <- readRDS(test_path("fixtures", "difNLR_fit14.rds"))
expect_equal(fit14, fit14_expected)
})
test_that("difNLR - checking inputs", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# different dimensions
expect_error(difNLR(Data, group[-c(1:3)], focal.name = 1, model = "3PL"))
expect_error(difNLR(Data, group, match = group[-c(1:3)], focal.name = 1, model = "3PL"))
expect_error(difNLR(Data[1:1999, 1], group, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data = rep(NA, 2000), group, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data = c(Data[1:1000, 1], rep(NA, 1000)), group = c(rep(NA, 1000), group[1:1000]), focal.name = 1, model = "3PL"))
# invalid model
expect_error(difNLR(Data, group, focal.name = 1, model = "5PL"))
expect_error(difNLR(Data, group, focal.name = 1))
# invalid combination of DIF type and model
expect_error(difNLR(Data, group, focal.name = 1, model = "1PL", type = "nudif"))
expect_error(difNLR(Data, group, focal.name = 1, model = "Rasch", type = "nudif"))
# invalid combination of purification and external matching
expect_error(difNLR(Data, group, match = group, focal.name = 1, model = "3PL", purify = TRUE))
# invalid test
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", test = "XXX"))
# invalid significance level
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", alpha = 30))
# invalid number of nrBo with initboot
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", initboot = TRUE, nrBo = -4))
# invalid method
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", method = "ffff"))
# invalid length of type
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", type = c("udif", "nudif")))
# invalid type
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", type = c("abx")))
# invalid length of constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = c("a", "b")))
# invalid constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = c("abx")))
# invalid combination of type and constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = "a", type = "a"))
# # invalid combination of method and sandwich
# expect_warning(difNLR(Data, group, focal.name = 1, model = "3PL", method = "plf", sandwich = TRUE))
# different ways to input group
fit1 <- difNLR(GMAT[, 1:20], GMAT$group, focal.name = 1, model = "3PL")
fit2 <- difNLR(GMAT[, 1:21], "group", focal.name = 1, model = "3PL")
fit3 <- difNLR(GMAT[, 1:21], 21, focal.name = 1, model = "3PL")
expect_equal(fit1, fit2)
expect_equal(fit1, fit3)
# invalid group
set.seed(42)
expect_error(difNLR(Data, rbinom(nrow(Data), 4, prob = runif(nrow(Data))), focal.name = 1, model = "3PL"))
# invalid dimensions
expect_error(difNLR(Data[-c(1:4), 1], group, match = GMAT$criterion, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data[-c(1:4), ], group, focal.name = 1, model = "3PL"))
# invalid length of model
expect_error(difNLR(Data, group, focal.name = 1, model = c("3PL", "2PL")))
# invalid length of start, specifying starting values
start <- startNLR(Data, group, model = "3PL", match = scale(apply(Data, 1, sum)), parameterization = "is")
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", start = start[1:19]))
fit4 <- difNLR(Data, group, focal.name = 1, model = "3PL", start = start)
fit5 <- difNLR(Data, group, focal.name = 1, model = "3PL")
expect_equal(fit4, fit5)
start <- startNLR(Data, group, model = "3PL", match = scale(apply(Data, 1, sum)), parameterization = "irt")
fit6 <- difNLR(Data, group, focal.name = 1, model = "3PL", start = start)
expect_equal(fit5$DIFitems, fit6$DIFitems)
names(start[[1]]) <- letters[1:6]
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", start = start))
})
test_that("difNLR S3 methods - checking inputs", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# testing both DIF effects using likelihood-ratio test and
# 3PL model with fixed guessing for groups
fit1 <- difNLR(Data, group, focal.name = 1, model = "3PL")
# coef
expect_error(coef(fit1, item = 35))
expect_error(coef(fit1, item = "Item45"))
expect_error(coef(fit1, item = list()))
expect_error(coef(fit1, SE = list()))
expect_error(coef(fit1, simplify = numeric()))
expect_error(coef(fit1, IRTpars = integer()))
expect_error(coef(fit1, CI = 8))
# fitted values
expect_error(fitted(fit1, item = 35))
expect_error(fitted(fit1, item = "xxx"))
expect_error(fitted(fit1, item = FALSE))
# residuals
expect_error(residuals(fit1, item = c(2, 77)))
expect_error(residuals(fit1, item = "xxx"))
expect_error(residuals(fit1, item = FALSE))
# predicted values
expect_error(predict(fit1, item = c(2, 77)))
expect_error(predict(fit1, item = "xxx"))
expect_error(predict(fit1, item = TRUE))
expect_error(predict(fit1, item = 3, group = c(0, 0, 1), match = c(-3, 2)))
expect_error(predict(fit1, CI = 5))
expect_warning(predict(fit1, interval = "xxx"))
# AIC
expect_error(AIC(fit1, item = c(2, 77)))
expect_error(AIC(fit1, item = "xxx"))
expect_error(AIC(fit1, item = list()))
# BIC
expect_error(BIC(fit1, item = c(5, 2, 88)))
expect_error(BIC(fit1, item = "xxx"))
expect_error(BIC(fit1, item = list("Item1")))
# logLik
expect_error(logLik(fit1, item = "Item55"))
expect_error(logLik(fit1, item = c(5, 2, 88)))
expect_error(logLik(fit1, item = list("Item1")))
# plot
expect_warning(plot(fit1, item = 5, group.names = c("A", "B", "C"))[[1]])
expect_warning(plot(fit1, item = 5, group.names = c("A"))[[1]])
expect_error(plot(fit1, item = 25)[[1]])
expect_error(plot(fit1, item = "Item25")[[1]])
expect_error(plot(fit1, item = list("Item1")))
expect_error(plot(fit1, plot.type = "XXX"))
})
test_that("testing paper code - R Journal 2020 - generated data", {
# skip_on_cran()
# skip_on_os("linux")
#-----------------------------------------------------------------------------
# DIF DETECTION AMONG BINARY DATA
#-----------------------------------------------------------------------------
#-----------------
# DATA GENERATION
#-----------------
# setting parameters
# discrimination
a <- matrix(rep(c(
1.00, 1.12, 1.45, 1.25, 1.32, 1.38, 1.44, 0.89, 1.15,
1.30, 1.29, 1.46, 1.16, 1.26, 0.98
), 2), ncol = 2)
# difficulty
b <- matrix(rep(c(
1.34, 0.06, 1.62, 0.24, -1.45, -0.10, 1.76, 1.96, -1.53,
-0.44, -1.67, 1.91, 1.62, 1.79, -0.21
), 2), ncol = 2)
# guessing
c <- matrix(rep(c(
0.00, 0.00, 0.00, 0.00, 0.00, 0.17, 0.18, 0.05, 0.10,
0.11, 0.15, 0.20, 0.21, 0.23, 0.24
), 2), ncol = 2)
# inattention
d <- matrix(rep(c(
1.00, 1.00, 1.00, 0.92, 0.87, 1.00, 1.00, 0.88, 0.93,
0.94, 0.81, 0.98, 0.87, 0.96, 0.85
), 2), ncol = 2)
# introducing DIF in items 5, 8, 11 and 15
b[5, 2] <- b[5, 2] + 1
a[8, 2] <- a[8, 2] + 1
d[11, 2] <- 1
c[15, 2] <- 0
# generating dichotomous data with parameters a, b, c, d
set.seed(42)
df <- genNLR(N = 1000, a = a, b = b, c = c, d = d)
expect_snapshot(head(df[, c(1:5, 16)]))
DataDIF <- df[, 1:15]
groupDIF <- df[, 16]
#-----------------
# BASIC DIF DETECTION
#-----------------
# performing DIF detection based on 4PL model
expect_snapshot((fit1 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = "4PL", type = "all")))
# saveRDS(fit1, file = "tests/testthat/fixtures/difNLR_RJournal_fit1.rds")
fit1_expected <- readRDS(test_path("fixtures", "difNLR_RJournal_fit1.rds"))
expect_equal(fit1, fit1_expected)
# estimated parameters
expect_snapshot(round(coef(fit1, simplify = TRUE), 3))
# estimated parameters with SE for item 5
expect_snapshot(round(coef(fit1, SE = TRUE)[[5]], 3))
# plot of characteristic curves of DIF items
fit1_plot1 <- plot(fit1, item = 5)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot1", fit1_plot1)
fit1_plot2 <- plot(fit1, item = 8)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot2", fit1_plot2)
fit1_plot3 <- plot(fit1, item = 11)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot3", fit1_plot3)
fit1_plot4 <- plot(fit1, item = 15)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot4", fit1_plot4)
# performing DIF detection with item specific models, types and/or constraints
# item specific model
model <- c("1PL", rep("2PL", 2), rep("3PL", 2), rep("3PLd", 2), rep("4PL", 8))
expect_snapshot((fit2 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = model, type = "all")))
expect_equal(fit2$DIFitems, c(5, 8, 11, 15))
# item specific type
type <- rep("all", 15)
type[5] <- "b"
type[8] <- "a"
type[11] <- "c"
type[15] <- "d"
expect_snapshot((fit3 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = model, type = type)))
expect_equal(fit3$DIFitems, 5)
# item specific constraints
constraints <- rep(NA, 15)
constraints[5] <- "ac"
constraints[8] <- "bcd"
constraints[11] <- "abd"
constraints[15] <- "abc"
expect_snapshot((fit4 <- difNLR(DataDIF, groupDIF,
focal.name = 1, model = model,
constraints = constraints, type = type
)))
expect_equal(fit4$DIFitems, c(5, 8, 11, 15))
# fit measures - AIC, BIC
expect_snapshot((df <- data.frame(
AIC = c(AIC(fit2), AIC(fit3), AIC(fit4)),
BIC = c(BIC(fit2), BIC(fit3), BIC(fit4)),
Fit = paste("fit", rep(2:4, each = 15), sep = ""),
Item = as.factor(rep(1:15, 3))
)))
# library(ggplot2)
# (plot1 <- ggplot(df, aes(x = Item, y = AIC, col = Fit)) +
# geom_point())
# vdiffr::expect_doppelganger("difNLR_RJournal_plot1", plot1)
# (plot2 <- ggplot(df, aes(x = Item, y = BIC, col = Fit)) +
# geom_point())
# vdiffr::expect_doppelganger("difNLR_RJournal_plot2", plot2)
# fit measures are item specific
expect_snapshot(logLik(fit3, item = 8))
expect_snapshot(logLik(fit4, item = 8))
# predicted values
expect_snapshot(predict(fit1, item = 5, group = c(0, 1), match = 0))
# FURTHER FEATURES
#-----------------------------------------------------------------------------
#-----------------
# ANCHOR ITEMS
#-----------------
fit8a <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all"
)
expect_equal(fit8a$DIFitems, c(5, 6))
fit8b <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = 1:4
)
expect_equal(fit8b$DIFitems, 5)
#-----------------
# ITEM PURIFICATION
#-----------------
fit9 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", purify = TRUE
)
# purification scheme
expect_snapshot(fit9$difPur)
#-----------------
# MULTIPLE COMPARISON CORRECTIONS
#-----------------
# Holm's p-value adjustment
fit10 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", p.adjust.method = "holm"
)
expect_equal(fit10$DIFitems, 5)
# combining item purification and Holm's p-value adjustment
fit11 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", p.adjust.method = "holm",
purify = TRUE
)
expect_equal(fit11$DIFitems, 5)
# comparing significance
expect_equal(round(fit9$pval, 3), c(0.144, 0.974, 0.244, 0.507, 0.000, 0.126))
expect_equal(round(fit10$adj.pval, 3), c(1.000, 1.000, 1.000, 0.747, 0.000, 0.137))
expect_equal(round(fit11$adj.pval, 3), c(0.629, 1.000, 0.733, 1.000, 0.000, 0.629))
#-----------------------------------------------------------------------------
# TROUBLE SHOOTING
#-----------------------------------------------------------------------------
# issues with convergence
# sampled data
set.seed(42)
sam <- sample(1:1000, 420)
# using re-calculation of starting values
expect_message(expect_message(fit12a <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all"
)))
# turn off option of re-calculating starting values
expect_warning(fit12b <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE
))
# with maximum likelihood estimation
# expect_warning(
# expect_message(
# expect_message(
# expect_message(fit13 <- difNLR(DataDIF[sam, ], groupDIF[sam], focal.name = 1, model = "4PL",
# type = "all", method = "likelihood")))))
# issues with item purification
expect_warning(fit14 <- difNLR(DataDIF[, 1:12], groupDIF,
focal.name = 1, model = "4PL",
type = "all", purify = TRUE
))
expect_snapshot(fit14$difPur)
})
test_that("testing paper code - R Journal 2020 - generated data", {
# skip_on_cran()
# skip_on_os("linux")
data("LearningToLearn", package = "ShinyItemAnalysis")
# dichotomous items for Grade 6
LtL6_gr6 <- LearningToLearn[, c("track", paste0("Item6", LETTERS[1:8], "_6"))]
# standardized total score achieved in Grade 6
zscore6 <- scale(LearningToLearn$score_6)
fitex1 <- difNLR(
Data = LtL6_gr6, group = "track", focal.name = "AS", model = "3PL",
match = zscore6
)
expect_equal(fitex1$DIFitems, 8)
fitex2 <- difNLR(
Data = LtL6_gr6[, c(1, 9)], group = "track", focal.name = "AS",
model = "3PL", type = "c", match = zscore6
)
expect_equal(fitex2$DIFitems, 1)
plot3 <- plot(fitex2, item = fitex2$DIFitems)
vdiffr::expect_doppelganger("difNLR_RJournal_plot3", plot3)
# dichotomous items for Grade 9
LtL6_gr9 <- LearningToLearn[, c("track", paste0("Item6", LETTERS[1:8], "_9"))]
fitex3 <- difNLR(
Data = LtL6_gr9, group = "track", focal.name = "AS", model = "3PL",
match = zscore6
)
expect_equal(fitex3$DIFitems, c(1, 2))
expect_snapshot(predict(
fitex3,
match = rep(c(-1, 0, 1), 2),
group = rep(c(0, 1), each = 3),
item = 1,
interval = "confidence"
))
})
test_that("testing paper code - R Journal 2020 - special cases (not included)", {
# skip_on_cran()
# skip_on_os("linux")
# setting parameters
# discrimination
a <- matrix(rep(c(
1.00, 1.12, 1.45, 1.25, 1.32, 1.38, 1.44, 0.89, 1.15,
1.30, 1.29, 1.46, 1.16, 1.26, 0.98
), 2), ncol = 2)
# difficulty
b <- matrix(rep(c(
1.34, 0.06, 1.62, 0.24, -1.45, -0.10, 1.76, 1.96, -1.53,
-0.44, -1.67, 1.91, 1.62, 1.79, -0.21
), 2), ncol = 2)
# guessing
c <- matrix(rep(c(
0.00, 0.00, 0.00, 0.00, 0.00, 0.17, 0.18, 0.05, 0.10,
0.11, 0.15, 0.20, 0.21, 0.23, 0.24
), 2), ncol = 2)
# inattention
d <- matrix(rep(c(
1.00, 1.00, 1.00, 0.92, 0.87, 1.00, 1.00, 0.88, 0.93,
0.94, 0.81, 0.98, 0.87, 0.96, 0.85
), 2), ncol = 2)
# introducing DIF in items 5, 8, 11 and 15
b[5, 2] <- b[5, 2] + 1
a[8, 2] <- a[8, 2] + 1
d[11, 2] <- 1
c[15, 2] <- 0
# generating dichotomous data with parameters a, b, c, d
set.seed(42)
df <- genNLR(N = 1000, a = a, b = b, c = c, d = d)
expect_snapshot(head(df[, c(1:5, 16)]))
DataDIF <- df[, 1:15]
groupDIF <- df[, 16]
# issues with convergence
# sampled data
set.seed(42)
sam <- sample(1:1000, 420)
# turn off option of re-calculating starting values
expect_warning(fit12b <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE
))
# saveRDS(fit12b, file = "tests/testthat/fixtures/difNLR_RJournal_fit12b.rds")
fit12b_expected <- readRDS(test_path("fixtures", "difNLR_RJournal_fit12b.rds"))
expect_equal(fit12b, fit12b_expected)
# plots
expect_error(plot(fit12b, item = 14))
expect_warning(plot(fit12b, item = c(1, 14)))
expect_warning(plot(fit12b, plot.type = "stat"))
expect_snapshot(coef(fit12b, item = 14))
# fitted
expect_error(fitted(fit12b, item = 14))
expect_warning(fitted(fit12b, item = paste0("Item", c(2, 14))))
# predict
expect_error(predict(fit12b, item = 14, match = c(0, 1), group = 0))
expect_warning(predict(fit12b, item = paste0("Item", c(3, 14)), match = c(0, 1), group = 0))
# fitted
expect_error(logLik(fit12b, item = 14))
expect_warning(logLik(fit12b, item = paste0("Item", c(2, 14))))
# AIC
expect_error(AIC(fit12b, item = 14))
expect_warning(AIC(fit12b, item = paste0("Item", c(15, 14))))
# BIC
expect_error(AIC(fit12b, item = 14))
expect_warning(AIC(fit12b, item = paste0("Item", c(4, 6, 10, 14))))
# residuals
expect_error(residuals(fit12b, item = 14))
expect_warning(residuals(fit12b, item = paste0("Item", c(10, 14))))
# different tests with convergence issues
expect_warning(fit12c <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE, test = "W"
))
expect_snapshot(fit12c)
expect_warning(plot(fit12c, plot.type = "stat"))
expect_warning(fit12d <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE, test = "LR"
))
expect_snapshot(fit12d)
expect_warning(plot(fit12d, plot.type = "stat"))
# warning with the old "likelihood" option
expect_message(difNLR(DataDIF, groupDIF, focal.name = 1, model = "4PL", method = "likelihood"))
# anchoring
fit8b <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = c(1:4, 6)
)
fit8c <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = paste0("Item", c(1:4, 6))
)
expect_equal(fit8c, fit8b)
fit8d <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", purify = TRUE
)
fit8c_plot1 <- plot(fit8c, item = 5)
fit8d_plot1 <- plot(fit8d, item = 5)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8c_plot1", fit8c_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8d_plot1", fit8d_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8c_plot1", fit8d_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8d_plot1", fit8c_plot1)
# no DIF items
expect_snapshot((fit15a <- difNLR(DataDIF[, -c(5, 8, 11, 15)], groupDIF,
focal.name = 1,
model = "4PL", type = "all"
)))
expect_equal(fit15a$DIFitems, "No DIF item detected")
# no DIF items, purification
expect_snapshot((fit15b <- difNLR(DataDIF[, -c(5, 8, 11, 15)], groupDIF,
focal.name = 1,
model = "4PL", type = "all", purify = TRUE
)))
expect_equal(fit15b$DIFitems, "No DIF item detected")
})
drabinova/difNLR documentation built on June 12, 2025, 4:47 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("difNLR - examples at help page", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# testing both DIF effects with adjacent category logit model
expect_snapshot((fit1 <- difNLR(Data, group, focal.name = 1, model = "3PLcg")))
# saveRDS(fit1, file = "tests/testthat/fixtures/difNLR_fit1.rds")
fit1_expected <- readRDS(test_path("fixtures", "difNLR_fit1.rds"))
expect_equal(fit1, fit1_expected)
# graphical devices
fit1_plot1 <- plot(fit1, item = "Item1")[[1]]
vdiffr::expect_doppelganger("difNLR_fit1_plot1", fit1_plot1)
fit1_plot2 <- plot(fit1, item = 1, group.names = c("Group 1", "Group 2"))[[1]]
vdiffr::expect_doppelganger("difNLR_fit1_plot2", fit1_plot2)
fit1_plot3 <- plot(fit1, plot.type = "stat")
vdiffr::expect_doppelganger("difNLR_fit1_plot3", fit1_plot3)
# estimated parameters
# saveRDS(coef(fit1), file = "tests/testthat/fixtures/difNLR_fit1_coef1.rds")
fit1_coef1_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef1.rds"))
expect_equal(coef(fit1), fit1_coef1_expected)
# saveRDS(coef(fit1, SE = TRUE), file = "tests/testthat/fixtures/difNLR_fit1_coef2.rds")
fit1_coef2_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef2.rds"))
expect_equal(coef(fit1, SE = TRUE), fit1_coef2_expected) # with SE
# saveRDS(coef(fit1, SE = TRUE, simplify = TRUE), file = "tests/testthat/fixtures/difNLR_fit1_coef3.rds")
fit1_coef3_expected <- readRDS(test_path("fixtures", "difNLR_fit1_coef3.rds"))
expect_equal(coef(fit1, SE = TRUE, simplify = TRUE), fit1_coef3_expected) # with SE, simplified
# fitted values
expect_snapshot(summary(fitted(fit1)))
expect_snapshot(fitted(fit1, item = 1))
# residuals
expect_snapshot(summary(residuals(fit1)))
expect_snapshot(residuals(fit1, item = 1))
# predicted values
expect_snapshot(summary(predict(fit1)))
expect_snapshot(predict(fit1, item = 1))
expect_equal(predict(fit1, item = 1)$prob, as.vector(fitted(fit1, item = 1)))
# predicted values for new subjects
expect_snapshot(predict(fit1, item = 1, match = 0, group = c(0, 1)))
# AIC, BIC, log-likelihood
expect_snapshot(AIC(fit1))
expect_snapshot(BIC(fit1))
expect_snapshot(logLik(fit1))
# AIC, BIC, log-likelihood for the first item
expect_snapshot(AIC(fit1, item = 1))
expect_snapshot(BIC(fit1, item = 1))
expect_snapshot(logLik(fit1, item = 1))
# testing both DIF effects using Wald test and
# 3PL model with fixed guessing for groups
expect_snapshot((fit2 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", test = "W")))
# saveRDS(fit2, file = "tests/testthat/fixtures/difNLR_fit2.rds")
fit2_expected <- readRDS(test_path("fixtures", "difNLR_fit2.rds"))
expect_equal(fit2, fit2_expected)
# testing both DIF effects using F test and
# 3PL model with fixed guessing for groups
expect_snapshot((fit3 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", test = "F")))
# saveRDS(fit3, file = "tests/testthat/fixtures/difNLR_fit3.rds")
fit3_expected <- readRDS(test_path("fixtures", "difNLR_fit3.rds"))
expect_equal(fit3, fit3_expected)
# testing both DIF effects using
# 3PL model with fixed guessing for groups and sandwich estimator
# of the covariance matrices
expect_snapshot((fit4 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", sandwich = TRUE)))
# saveRDS(fit4, file = "tests/testthat/fixtures/difNLR_fit4.rds")
fit4_expected <- readRDS(test_path("fixtures", "difNLR_fit4.rds"))
expect_equal(fit4, fit4_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# and Benjamini-Hochberg correction
expect_snapshot((fit5 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", p.adjust.method = "BH")))
# saveRDS(fit5, file = "tests/testthat/fixtures/difNLR_fit5.rds")
fit5_expected <- readRDS(test_path("fixtures", "difNLR_fit5.rds"))
expect_equal(fit5, fit5_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# and item purification
expect_snapshot((fit6 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", purify = TRUE)))
# saveRDS(fit6, file = "tests/testthat/fixtures/difNLR_fit6.rds")
fit6_expected <- readRDS(test_path("fixtures", "difNLR_fit6.rds"))
expect_equal(fit6, fit6_expected)
# testing both DIF effects using 3PL model with fixed guessing for groups
# and total score as matching criterion
expect_snapshot((fit7 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", match = "score")))
# saveRDS(fit7, file = "tests/testthat/fixtures/difNLR_fit7.rds")
fit7_expected <- readRDS(test_path("fixtures", "difNLR_fit7.rds"))
expect_equal(fit7, fit7_expected)
# testing uniform DIF effects using 4PL model with the same
# guessing and inattention
expect_snapshot((fit8 <- difNLR(Data, group, focal.name = 1, model = "4PLcgdg", type = "udif")))
# saveRDS(fit8, file = "tests/testthat/fixtures/difNLR_fit8.rds")
fit8_expected <- readRDS(test_path("fixtures", "difNLR_fit8.rds"))
expect_equal(fit8, fit8_expected)
# testing non-uniform DIF effects using 2PL model
expect_snapshot((fit9 <- difNLR(Data, group, focal.name = 1, model = "2PL", type = "nudif")))
# saveRDS(fit9, file = "tests/testthat/fixtures/difNLR_fit9.rds")
fit9_expected <- readRDS(test_path("fixtures", "difNLR_fit9.rds"))
expect_equal(fit9, fit9_expected)
# testing difference in parameter b using 4PL model with fixed
# a and c parameters
expect_snapshot((fit10 <- difNLR(Data, group, focal.name = 1, model = "4PL", constraints = "ac", type = "b")))
# saveRDS(fit10, file = "tests/testthat/fixtures/difNLR_fit10.rds")
fit10_expected <- readRDS(test_path("fixtures", "difNLR_fit10.rds"))
expect_equal(fit10, fit10_expected)
# testing both DIF effects using LR test,
# 3PL model with fixed guessing for groups
# using maximum likelihood estimation with
# the L-BFGS-B algorithm, the EM algorithm, and the PLF algorithm
expect_snapshot((fit11 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "mle")))
# saveRDS(fit11, file = "tests/testthat/fixtures/difNLR_fit11.rds")
fit11_expected <- readRDS(test_path("fixtures", "difNLR_fit11.rds"))
expect_equal(fit11, fit11_expected)
# expect_snapshot((fit12 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "em")))
# # saveRDS(fit12, file = "tests/testthat/fixtures/difNLR_fit12.rds")
# fit12_expected <- readRDS(test_path("fixtures", "difNLR_fit12.rds"))
# expect_equal(fit12, fit12_expected)
expect_snapshot((fit13 <- difNLR(Data, group, focal.name = 1, model = "3PLcg", method = "plf")))
# saveRDS(fit13, file = "tests/testthat/fixtures/difNLR_fit13.rds")
fit13_expected <- readRDS(test_path("fixtures", "difNLR_fit13.rds"))
expect_equal(fit13, fit13_expected)
# testing both DIF effects using LR test and 2PL model
# using maximum likelihood estimation with iteratively reweighted least squares algorithm
expect_snapshot((fit14 <- difNLR(Data, group, focal.name = 1, model = "2PL", method = "irls")))
# saveRDS(fit14, file = "tests/testthat/fixtures/difNLR_fit14.rds")
fit14_expected <- readRDS(test_path("fixtures", "difNLR_fit14.rds"))
expect_equal(fit14, fit14_expected)
})
test_that("difNLR - checking inputs", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# different dimensions
expect_error(difNLR(Data, group[-c(1:3)], focal.name = 1, model = "3PL"))
expect_error(difNLR(Data, group, match = group[-c(1:3)], focal.name = 1, model = "3PL"))
expect_error(difNLR(Data[1:1999, 1], group, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data = rep(NA, 2000), group, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data = c(Data[1:1000, 1], rep(NA, 1000)), group = c(rep(NA, 1000), group[1:1000]), focal.name = 1, model = "3PL"))
# invalid model
expect_error(difNLR(Data, group, focal.name = 1, model = "5PL"))
expect_error(difNLR(Data, group, focal.name = 1))
# invalid combination of DIF type and model
expect_error(difNLR(Data, group, focal.name = 1, model = "1PL", type = "nudif"))
expect_error(difNLR(Data, group, focal.name = 1, model = "Rasch", type = "nudif"))
# invalid combination of purification and external matching
expect_error(difNLR(Data, group, match = group, focal.name = 1, model = "3PL", purify = TRUE))
# invalid test
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", test = "XXX"))
# invalid significance level
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", alpha = 30))
# invalid number of nrBo with initboot
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", initboot = TRUE, nrBo = -4))
# invalid method
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", method = "ffff"))
# invalid length of type
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", type = c("udif", "nudif")))
# invalid type
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", type = c("abx")))
# invalid length of constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = c("a", "b")))
# invalid constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = c("abx")))
# invalid combination of type and constraints
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", constraints = "a", type = "a"))
# # invalid combination of method and sandwich
# expect_warning(difNLR(Data, group, focal.name = 1, model = "3PL", method = "plf", sandwich = TRUE))
# different ways to input group
fit1 <- difNLR(GMAT[, 1:20], GMAT$group, focal.name = 1, model = "3PL")
fit2 <- difNLR(GMAT[, 1:21], "group", focal.name = 1, model = "3PL")
fit3 <- difNLR(GMAT[, 1:21], 21, focal.name = 1, model = "3PL")
expect_equal(fit1, fit2)
expect_equal(fit1, fit3)
# invalid group
set.seed(42)
expect_error(difNLR(Data, rbinom(nrow(Data), 4, prob = runif(nrow(Data))), focal.name = 1, model = "3PL"))
# invalid dimensions
expect_error(difNLR(Data[-c(1:4), 1], group, match = GMAT$criterion, focal.name = 1, model = "3PL"))
expect_error(difNLR(Data[-c(1:4), ], group, focal.name = 1, model = "3PL"))
# invalid length of model
expect_error(difNLR(Data, group, focal.name = 1, model = c("3PL", "2PL")))
# invalid length of start, specifying starting values
start <- startNLR(Data, group, model = "3PL", match = scale(apply(Data, 1, sum)), parameterization = "is")
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", start = start[1:19]))
fit4 <- difNLR(Data, group, focal.name = 1, model = "3PL", start = start)
fit5 <- difNLR(Data, group, focal.name = 1, model = "3PL")
expect_equal(fit4, fit5)
start <- startNLR(Data, group, model = "3PL", match = scale(apply(Data, 1, sum)), parameterization = "irt")
fit6 <- difNLR(Data, group, focal.name = 1, model = "3PL", start = start)
expect_equal(fit5$DIFitems, fit6$DIFitems)
names(start[[1]]) <- letters[1:6]
expect_error(difNLR(Data, group, focal.name = 1, model = "3PL", start = start))
})
test_that("difNLR S3 methods - checking inputs", {
# skip_on_cran()
# skip_on_os("linux")
# loading data
data(GMAT)
Data <- GMAT[, 1:20] # items
group <- GMAT[, "group"] # group membership variable
# testing both DIF effects using likelihood-ratio test and
# 3PL model with fixed guessing for groups
fit1 <- difNLR(Data, group, focal.name = 1, model = "3PL")
# coef
expect_error(coef(fit1, item = 35))
expect_error(coef(fit1, item = "Item45"))
expect_error(coef(fit1, item = list()))
expect_error(coef(fit1, SE = list()))
expect_error(coef(fit1, simplify = numeric()))
expect_error(coef(fit1, IRTpars = integer()))
expect_error(coef(fit1, CI = 8))
# fitted values
expect_error(fitted(fit1, item = 35))
expect_error(fitted(fit1, item = "xxx"))
expect_error(fitted(fit1, item = FALSE))
# residuals
expect_error(residuals(fit1, item = c(2, 77)))
expect_error(residuals(fit1, item = "xxx"))
expect_error(residuals(fit1, item = FALSE))
# predicted values
expect_error(predict(fit1, item = c(2, 77)))
expect_error(predict(fit1, item = "xxx"))
expect_error(predict(fit1, item = TRUE))
expect_error(predict(fit1, item = 3, group = c(0, 0, 1), match = c(-3, 2)))
expect_error(predict(fit1, CI = 5))
expect_warning(predict(fit1, interval = "xxx"))
# AIC
expect_error(AIC(fit1, item = c(2, 77)))
expect_error(AIC(fit1, item = "xxx"))
expect_error(AIC(fit1, item = list()))
# BIC
expect_error(BIC(fit1, item = c(5, 2, 88)))
expect_error(BIC(fit1, item = "xxx"))
expect_error(BIC(fit1, item = list("Item1")))
# logLik
expect_error(logLik(fit1, item = "Item55"))
expect_error(logLik(fit1, item = c(5, 2, 88)))
expect_error(logLik(fit1, item = list("Item1")))
# plot
expect_warning(plot(fit1, item = 5, group.names = c("A", "B", "C"))[[1]])
expect_warning(plot(fit1, item = 5, group.names = c("A"))[[1]])
expect_error(plot(fit1, item = 25)[[1]])
expect_error(plot(fit1, item = "Item25")[[1]])
expect_error(plot(fit1, item = list("Item1")))
expect_error(plot(fit1, plot.type = "XXX"))
})
test_that("testing paper code - R Journal 2020 - generated data", {
# skip_on_cran()
# skip_on_os("linux")
#-----------------------------------------------------------------------------
# DIF DETECTION AMONG BINARY DATA
#-----------------------------------------------------------------------------
#-----------------
# DATA GENERATION
#-----------------
# setting parameters
# discrimination
a <- matrix(rep(c(
1.00, 1.12, 1.45, 1.25, 1.32, 1.38, 1.44, 0.89, 1.15,
1.30, 1.29, 1.46, 1.16, 1.26, 0.98
), 2), ncol = 2)
# difficulty
b <- matrix(rep(c(
1.34, 0.06, 1.62, 0.24, -1.45, -0.10, 1.76, 1.96, -1.53,
-0.44, -1.67, 1.91, 1.62, 1.79, -0.21
), 2), ncol = 2)
# guessing
c <- matrix(rep(c(
0.00, 0.00, 0.00, 0.00, 0.00, 0.17, 0.18, 0.05, 0.10,
0.11, 0.15, 0.20, 0.21, 0.23, 0.24
), 2), ncol = 2)
# inattention
d <- matrix(rep(c(
1.00, 1.00, 1.00, 0.92, 0.87, 1.00, 1.00, 0.88, 0.93,
0.94, 0.81, 0.98, 0.87, 0.96, 0.85
), 2), ncol = 2)
# introducing DIF in items 5, 8, 11 and 15
b[5, 2] <- b[5, 2] + 1
a[8, 2] <- a[8, 2] + 1
d[11, 2] <- 1
c[15, 2] <- 0
# generating dichotomous data with parameters a, b, c, d
set.seed(42)
df <- genNLR(N = 1000, a = a, b = b, c = c, d = d)
expect_snapshot(head(df[, c(1:5, 16)]))
DataDIF <- df[, 1:15]
groupDIF <- df[, 16]
#-----------------
# BASIC DIF DETECTION
#-----------------
# performing DIF detection based on 4PL model
expect_snapshot((fit1 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = "4PL", type = "all")))
# saveRDS(fit1, file = "tests/testthat/fixtures/difNLR_RJournal_fit1.rds")
fit1_expected <- readRDS(test_path("fixtures", "difNLR_RJournal_fit1.rds"))
expect_equal(fit1, fit1_expected)
# estimated parameters
expect_snapshot(round(coef(fit1, simplify = TRUE), 3))
# estimated parameters with SE for item 5
expect_snapshot(round(coef(fit1, SE = TRUE)[[5]], 3))
# plot of characteristic curves of DIF items
fit1_plot1 <- plot(fit1, item = 5)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot1", fit1_plot1)
fit1_plot2 <- plot(fit1, item = 8)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot2", fit1_plot2)
fit1_plot3 <- plot(fit1, item = 11)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot3", fit1_plot3)
fit1_plot4 <- plot(fit1, item = 15)[[1]]
vdiffr::expect_doppelganger("difNLR_RJournal_fit1_plot4", fit1_plot4)
# performing DIF detection with item specific models, types and/or constraints
# item specific model
model <- c("1PL", rep("2PL", 2), rep("3PL", 2), rep("3PLd", 2), rep("4PL", 8))
expect_snapshot((fit2 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = model, type = "all")))
expect_equal(fit2$DIFitems, c(5, 8, 11, 15))
# item specific type
type <- rep("all", 15)
type[5] <- "b"
type[8] <- "a"
type[11] <- "c"
type[15] <- "d"
expect_snapshot((fit3 <- difNLR(DataDIF, groupDIF, focal.name = 1, model = model, type = type)))
expect_equal(fit3$DIFitems, 5)
# item specific constraints
constraints <- rep(NA, 15)
constraints[5] <- "ac"
constraints[8] <- "bcd"
constraints[11] <- "abd"
constraints[15] <- "abc"
expect_snapshot((fit4 <- difNLR(DataDIF, groupDIF,
focal.name = 1, model = model,
constraints = constraints, type = type
)))
expect_equal(fit4$DIFitems, c(5, 8, 11, 15))
# fit measures - AIC, BIC
expect_snapshot((df <- data.frame(
AIC = c(AIC(fit2), AIC(fit3), AIC(fit4)),
BIC = c(BIC(fit2), BIC(fit3), BIC(fit4)),
Fit = paste("fit", rep(2:4, each = 15), sep = ""),
Item = as.factor(rep(1:15, 3))
)))
# library(ggplot2)
# (plot1 <- ggplot(df, aes(x = Item, y = AIC, col = Fit)) +
# geom_point())
# vdiffr::expect_doppelganger("difNLR_RJournal_plot1", plot1)
# (plot2 <- ggplot(df, aes(x = Item, y = BIC, col = Fit)) +
# geom_point())
# vdiffr::expect_doppelganger("difNLR_RJournal_plot2", plot2)
# fit measures are item specific
expect_snapshot(logLik(fit3, item = 8))
expect_snapshot(logLik(fit4, item = 8))
# predicted values
expect_snapshot(predict(fit1, item = 5, group = c(0, 1), match = 0))
# FURTHER FEATURES
#-----------------------------------------------------------------------------
#-----------------
# ANCHOR ITEMS
#-----------------
fit8a <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all"
)
expect_equal(fit8a$DIFitems, c(5, 6))
fit8b <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = 1:4
)
expect_equal(fit8b$DIFitems, 5)
#-----------------
# ITEM PURIFICATION
#-----------------
fit9 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", purify = TRUE
)
# purification scheme
expect_snapshot(fit9$difPur)
#-----------------
# MULTIPLE COMPARISON CORRECTIONS
#-----------------
# Holm's p-value adjustment
fit10 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", p.adjust.method = "holm"
)
expect_equal(fit10$DIFitems, 5)
# combining item purification and Holm's p-value adjustment
fit11 <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", p.adjust.method = "holm",
purify = TRUE
)
expect_equal(fit11$DIFitems, 5)
# comparing significance
expect_equal(round(fit9$pval, 3), c(0.144, 0.974, 0.244, 0.507, 0.000, 0.126))
expect_equal(round(fit10$adj.pval, 3), c(1.000, 1.000, 1.000, 0.747, 0.000, 0.137))
expect_equal(round(fit11$adj.pval, 3), c(0.629, 1.000, 0.733, 1.000, 0.000, 0.629))
#-----------------------------------------------------------------------------
# TROUBLE SHOOTING
#-----------------------------------------------------------------------------
# issues with convergence
# sampled data
set.seed(42)
sam <- sample(1:1000, 420)
# using re-calculation of starting values
expect_message(expect_message(fit12a <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all"
)))
# turn off option of re-calculating starting values
expect_warning(fit12b <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE
))
# with maximum likelihood estimation
# expect_warning(
# expect_message(
# expect_message(
# expect_message(fit13 <- difNLR(DataDIF[sam, ], groupDIF[sam], focal.name = 1, model = "4PL",
# type = "all", method = "likelihood")))))
# issues with item purification
expect_warning(fit14 <- difNLR(DataDIF[, 1:12], groupDIF,
focal.name = 1, model = "4PL",
type = "all", purify = TRUE
))
expect_snapshot(fit14$difPur)
})
test_that("testing paper code - R Journal 2020 - generated data", {
# skip_on_cran()
# skip_on_os("linux")
data("LearningToLearn", package = "ShinyItemAnalysis")
# dichotomous items for Grade 6
LtL6_gr6 <- LearningToLearn[, c("track", paste0("Item6", LETTERS[1:8], "_6"))]
# standardized total score achieved in Grade 6
zscore6 <- scale(LearningToLearn$score_6)
fitex1 <- difNLR(
Data = LtL6_gr6, group = "track", focal.name = "AS", model = "3PL",
match = zscore6
)
expect_equal(fitex1$DIFitems, 8)
fitex2 <- difNLR(
Data = LtL6_gr6[, c(1, 9)], group = "track", focal.name = "AS",
model = "3PL", type = "c", match = zscore6
)
expect_equal(fitex2$DIFitems, 1)
plot3 <- plot(fitex2, item = fitex2$DIFitems)
vdiffr::expect_doppelganger("difNLR_RJournal_plot3", plot3)
# dichotomous items for Grade 9
LtL6_gr9 <- LearningToLearn[, c("track", paste0("Item6", LETTERS[1:8], "_9"))]
fitex3 <- difNLR(
Data = LtL6_gr9, group = "track", focal.name = "AS", model = "3PL",
match = zscore6
)
expect_equal(fitex3$DIFitems, c(1, 2))
expect_snapshot(predict(
fitex3,
match = rep(c(-1, 0, 1), 2),
group = rep(c(0, 1), each = 3),
item = 1,
interval = "confidence"
))
})
test_that("testing paper code - R Journal 2020 - special cases (not included)", {
# skip_on_cran()
# skip_on_os("linux")
# setting parameters
# discrimination
a <- matrix(rep(c(
1.00, 1.12, 1.45, 1.25, 1.32, 1.38, 1.44, 0.89, 1.15,
1.30, 1.29, 1.46, 1.16, 1.26, 0.98
), 2), ncol = 2)
# difficulty
b <- matrix(rep(c(
1.34, 0.06, 1.62, 0.24, -1.45, -0.10, 1.76, 1.96, -1.53,
-0.44, -1.67, 1.91, 1.62, 1.79, -0.21
), 2), ncol = 2)
# guessing
c <- matrix(rep(c(
0.00, 0.00, 0.00, 0.00, 0.00, 0.17, 0.18, 0.05, 0.10,
0.11, 0.15, 0.20, 0.21, 0.23, 0.24
), 2), ncol = 2)
# inattention
d <- matrix(rep(c(
1.00, 1.00, 1.00, 0.92, 0.87, 1.00, 1.00, 0.88, 0.93,
0.94, 0.81, 0.98, 0.87, 0.96, 0.85
), 2), ncol = 2)
# introducing DIF in items 5, 8, 11 and 15
b[5, 2] <- b[5, 2] + 1
a[8, 2] <- a[8, 2] + 1
d[11, 2] <- 1
c[15, 2] <- 0
# generating dichotomous data with parameters a, b, c, d
set.seed(42)
df <- genNLR(N = 1000, a = a, b = b, c = c, d = d)
expect_snapshot(head(df[, c(1:5, 16)]))
DataDIF <- df[, 1:15]
groupDIF <- df[, 16]
# issues with convergence
# sampled data
set.seed(42)
sam <- sample(1:1000, 420)
# turn off option of re-calculating starting values
expect_warning(fit12b <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE
))
# saveRDS(fit12b, file = "tests/testthat/fixtures/difNLR_RJournal_fit12b.rds")
fit12b_expected <- readRDS(test_path("fixtures", "difNLR_RJournal_fit12b.rds"))
expect_equal(fit12b, fit12b_expected)
# plots
expect_error(plot(fit12b, item = 14))
expect_warning(plot(fit12b, item = c(1, 14)))
expect_warning(plot(fit12b, plot.type = "stat"))
expect_snapshot(coef(fit12b, item = 14))
# fitted
expect_error(fitted(fit12b, item = 14))
expect_warning(fitted(fit12b, item = paste0("Item", c(2, 14))))
# predict
expect_error(predict(fit12b, item = 14, match = c(0, 1), group = 0))
expect_warning(predict(fit12b, item = paste0("Item", c(3, 14)), match = c(0, 1), group = 0))
# fitted
expect_error(logLik(fit12b, item = 14))
expect_warning(logLik(fit12b, item = paste0("Item", c(2, 14))))
# AIC
expect_error(AIC(fit12b, item = 14))
expect_warning(AIC(fit12b, item = paste0("Item", c(15, 14))))
# BIC
expect_error(AIC(fit12b, item = 14))
expect_warning(AIC(fit12b, item = paste0("Item", c(4, 6, 10, 14))))
# residuals
expect_error(residuals(fit12b, item = 14))
expect_warning(residuals(fit12b, item = paste0("Item", c(10, 14))))
# different tests with convergence issues
expect_warning(fit12c <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE, test = "W"
))
expect_snapshot(fit12c)
expect_warning(plot(fit12c, plot.type = "stat"))
expect_warning(fit12d <- difNLR(DataDIF[sam, ], groupDIF[sam],
focal.name = 1, model = "4PL",
type = "all", initboot = FALSE, test = "LR"
))
expect_snapshot(fit12d)
expect_warning(plot(fit12d, plot.type = "stat"))
# warning with the old "likelihood" option
expect_message(difNLR(DataDIF, groupDIF, focal.name = 1, model = "4PL", method = "likelihood"))
# anchoring
fit8b <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = c(1:4, 6)
)
fit8c <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", anchor = paste0("Item", c(1:4, 6))
)
expect_equal(fit8c, fit8b)
fit8d <- difNLR(DataDIF[, 1:6], groupDIF,
focal.name = 1, match = "score",
model = "4PL", type = "all", purify = TRUE
)
fit8c_plot1 <- plot(fit8c, item = 5)
fit8d_plot1 <- plot(fit8d, item = 5)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8c_plot1", fit8c_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8d_plot1", fit8d_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8c_plot1", fit8d_plot1)
vdiffr::expect_doppelganger("difNLR_RJournal_fit8d_plot1", fit8c_plot1)
# no DIF items
expect_snapshot((fit15a <- difNLR(DataDIF[, -c(5, 8, 11, 15)], groupDIF,
focal.name = 1,
model = "4PL", type = "all"
)))
expect_equal(fit15a$DIFitems, "No DIF item detected")
# no DIF items, purification
expect_snapshot((fit15b <- difNLR(DataDIF[, -c(5, 8, 11, 15)], groupDIF,
focal.name = 1,
model = "4PL", type = "all", purify = TRUE
)))
expect_equal(fit15b$DIFitems, "No DIF item detected")
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.