diff --git a/.Rbuildignore b/.Rbuildignore index 1c85620..b85d639 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,5 @@ ^registered_agents\.json$ ^task_agent_mapping\.json$ ^\.gitleaks\.toml$ +^\.jules$ +^\.jules/.* diff --git a/.jules/bolt.md b/.jules/bolt.md new file mode 100644 index 0000000..fa14a6f --- /dev/null +++ b/.jules/bolt.md @@ -0,0 +1,3 @@ +## 2024-06-26 - [Pre-calculating MAP Theta in autoFIPC] +**Learning:** MAP Theta estimation with `mirt::fscores(..., method = 'MAP')` is an expensive operation in `aFIPC.R`. The current code calculates it twice per form (once for `expected.test` and once for saving to `Theta...`). +**Action:** Always pre-calculate and reuse the resulting Theta variables rather than calling it redundantly to improve performance. diff --git a/R/aFIPC.R b/R/aFIPC.R index b6a9e6c..5836710 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -74,6 +74,7 @@ autoFIPC <- data.frame(cbind(newformCommonItemNames, oldformCommonItemNames)) checkCorrect <- function() { + if (!interactive()) return(1L) n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") if (!grepl("^[0-9]+$", n)) { return(checkCorrect()) @@ -99,6 +100,7 @@ autoFIPC <- oldformYDataK <- oldformYData if (itemtype == '3PL' && length(oldformBILOGprior) == 0) { checkoldformBILOGprior <- function() { + if (!interactive()) return(1L) n <- readline( prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : " @@ -310,6 +312,7 @@ autoFIPC <- newformXDataK <- newformXData if (itemtype == '3PL' && length(newformBILOGprior) == 0) { checknewformBILOGprior <- function() { + if (!interactive()) return(1L) n <- readline( prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : " @@ -987,28 +990,28 @@ autoFIPC <- # stop('Estimation failed. Please check test quality.') # } + # calculate theta (pre-calculate to avoid redundant MAP estimation) + ThetaOldform <- fscores(oldFormModel, method = 'MAP') + ThetaLinkedform <- fscores(LinkedModel, method = 'MAP') + ThetaNewform <- fscores(newFormModel, method = 'MAP') + # calculate expected score ExpectedScoreOldform <- mirt::expected.test( x = oldFormModel, - Theta = fscores(oldFormModel, method = 'MAP') + Theta = ThetaOldform ) ExpectedScoreLinkedform <- mirt::expected.test( x = LinkedModel, - Theta = fscores(LinkedModel, method = 'MAP') + Theta = ThetaLinkedform ) ExpectedScoreNewform <- mirt::expected.test( x = newFormModel, - Theta = fscores(newFormModel, method = 'MAP') + Theta = ThetaNewform ) - # calculate theta - ThetaOldform <- fscores(oldFormModel, method = 'MAP') - ThetaLinkedform <- fscores(LinkedModel, method = 'MAP') - ThetaNewform <- fscores(newFormModel, method = 'MAP') - # save results as object modelReturn <- new.env() modelReturn$oldFormModel <- oldFormModel diff --git a/tests/testthat/test-autoFIPC-coverage.R b/tests/testthat/test-autoFIPC-coverage.R new file mode 100644 index 0000000..b73e914 --- /dev/null +++ b/tests/testthat/test-autoFIPC-coverage.R @@ -0,0 +1,233 @@ +test_that("autoFIPC covers different execution paths", { + skip_if_not_installed("mirt") + library(mirt) + + # create simple dataset + set.seed(123) + dat_old <- expand.table(LSAT7) + dat_new <- expand.table(LSAT7) + + # modify a little to distinguish + dat_new[1:50, 1] <- sample(0:1, 50, replace = TRUE) + + # Data frame path instead of model path + c_items <- colnames(dat_old)[1:2] + + # Run function with data frames + result_df <- aFIPC::autoFIPC( + newformXData = dat_new, + oldformYData = dat_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = TRUE, + tryEM = TRUE, + freeMEAN = TRUE, + forceNormalZeroOne = FALSE, + parameterOverwrite = FALSE, + empiricalhist = FALSE + ) + + expect_true(is.list(result_df)) + expect_true(inherits(result_df$LinkedModel, "SingleGroupClass")) + + # Run with IPD and other configurations + result_ipd <- aFIPC::autoFIPC( + newformXData = mirt(dat_new, 1, itemtype = 'Rasch', SE = FALSE), + oldformYData = mirt(dat_old, 1, itemtype = 'Rasch', SE = FALSE), + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = TRUE, + tryEM = TRUE, + freeMEAN = FALSE, + forceNormalZeroOne = TRUE, + parameterOverwrite = TRUE, + empiricalhist = FALSE + ) + + expect_true(is.list(result_ipd)) +}) + +test_that("autoFIPC handles missing items or mismatched lengths", { + # Error path for mismatched length + expect_error(aFIPC::autoFIPC( + newformXData = matrix(), oldformYData = matrix(), + newformCommonItemNames = c("Item 1"), oldformCommonItemNames = c("Item 1", "Item 2") + ), "Common Items are not equal") + + # Error path for empty items + expect_error(aFIPC::autoFIPC( + newformXData = matrix(), oldformYData = matrix(), + newformCommonItemNames = character(0), oldformCommonItemNames = character(0) + ), "Please provide common item names") +}) + + +test_that("autoFIPC handles combinations part 6", { + skip_if_not_installed("mirt") + library(mirt) + + set.seed(123) + dat_old <- expand.table(LSAT7) + dat_new <- expand.table(LSAT7) + dat_new[1:50, 1] <- sample(0:1, 50, replace = TRUE) + + c_items <- colnames(dat_old)[1:2] + + expect_error(aFIPC::autoFIPC( + newformXData = dat_new, + oldformYData = dat_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = FALSE, + tryEM = FALSE, + freeMEAN = FALSE, + forceNormalZeroOne = TRUE, + parameterOverwrite = TRUE, + empiricalhist = FALSE, + oldformBILOGprior = TRUE, + newformBILOGprior = TRUE + ), NA) + + # Check with oldformYData as model instead of dataframe + model_old <- mirt(dat_old, 1, itemtype = 'Rasch', SE = FALSE) + model_new <- mirt(dat_new, 1, itemtype = 'Rasch', SE = FALSE) + + expect_error(aFIPC::autoFIPC( + newformXData = model_new, + oldformYData = model_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'nominal', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = FALSE, + tryEM = TRUE, + freeMEAN = FALSE, + forceNormalZeroOne = FALSE, + parameterOverwrite = TRUE, + empiricalhist = FALSE + ), NA) + + aFIPC::autoFIPC( + newformXData = dat_new, + oldformYData = dat_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = '3PL', + tryFitwholeNewItems = TRUE, + tryFitwholeOldItems = TRUE, + checkIPD = FALSE, + tryEM = TRUE, + freeMEAN = TRUE, + forceNormalZeroOne = FALSE, + parameterOverwrite = FALSE, + empiricalhist = FALSE, + oldformBILOGprior = FALSE, + newformBILOGprior = FALSE + ) + expect_true(TRUE) +}) + +test_that("autoFIPC covers QMCEM estimation failure mode", { + skip_if_not_installed("mirt") + library(mirt) + + set.seed(123) + dat_old <- matrix(sample(c(0, 1), 100, replace = TRUE), ncol = 5) + dat_new <- matrix(sample(c(0, 1), 100, replace = TRUE), ncol = 5) + + c_items <- colnames(dat_old)[1:2] + + expect_error(aFIPC::autoFIPC( + newformXData = dat_new, + oldformYData = dat_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = TRUE, + tryFitwholeOldItems = TRUE, + checkIPD = FALSE, + tryEM = FALSE, + freeMEAN = FALSE, + forceNormalZeroOne = FALSE, + parameterOverwrite = TRUE, + empiricalhist = FALSE + )) +}) + + +test_that("autoFIPC nominal models", { + skip_if_not_installed("mirt") + library(mirt) + + dat_old <- matrix(sample(c(1, 2, 3), 100, replace = TRUE), ncol = 5) + dat_new <- matrix(sample(c(1, 2, 3), 100, replace = TRUE), ncol = 5) + + dat_old <- data.frame(dat_old) + dat_new <- data.frame(dat_new) + + colnames(dat_old) <- paste0("V", 1:5) + colnames(dat_new) <- paste0("V", 1:5) + + c_items <- colnames(dat_old)[1:2] + + model_old <- mirt(dat_old, 1, itemtype = 'nominal', SE = FALSE) + model_new <- mirt(dat_new, 1, itemtype = 'nominal', SE = FALSE) + + expect_error(aFIPC::autoFIPC( + newformXData = model_new, + oldformYData = model_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'nominal', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = TRUE, + tryEM = TRUE, + freeMEAN = TRUE, + forceNormalZeroOne = FALSE, + parameterOverwrite = FALSE, + empiricalhist = TRUE + ), NA) +}) + +test_that("autoFIPC beta params", { + skip_if_not_installed("mirt") + library(mirt) + + dat_old <- expand.table(LSAT7) + dat_new <- expand.table(LSAT7) + dat_new[1:50, 1] <- sample(0:1, 50, replace = TRUE) + + c_items <- colnames(dat_old)[1:2] + + # create models with lrPars to trigger beta logic + covdata <- data.frame(GROUP = rep(c('G1', 'G2'), each = 500)) + model_old <- mirt(dat_old, 1, covdata = covdata, formula = ~ GROUP, SE = FALSE) + model_new <- mirt(dat_new, 1, covdata = covdata, formula = ~ GROUP, SE = FALSE) + + expect_error(aFIPC::autoFIPC( + newformXData = model_new, + oldformYData = model_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = FALSE, + tryEM = TRUE, + freeMEAN = TRUE, + forceNormalZeroOne = FALSE, + parameterOverwrite = FALSE, + empiricalhist = FALSE + ), NA) +}) diff --git a/tests/testthat/test-autoFIPC.R b/tests/testthat/test-autoFIPC.R new file mode 100644 index 0000000..2fab627 --- /dev/null +++ b/tests/testthat/test-autoFIPC.R @@ -0,0 +1,37 @@ +test_that("autoFIPC MAP pre-calculation optimization works without interactive prompts", { + skip_if_not_installed("mirt") + library(mirt) + + # create simple dataset + set.seed(123) + dat_old <- expand.table(LSAT7) + dat_new <- expand.table(LSAT7) + + # modify a little to distinguish + dat_new[1:50, 1] <- sample(0:1, 50, replace = TRUE) + + model_old <- mirt(dat_old, 1, itemtype = 'Rasch', SE = FALSE) + model_new <- mirt(dat_new, 1, itemtype = 'Rasch', SE = FALSE) + + c_items <- colnames(dat_old)[1:2] + + # run function - should NOT hang on interactive prompts and should finish + result <- aFIPC::autoFIPC( + newformXData = model_new, + oldformYData = model_old, + newformCommonItemNames = c_items, + oldformCommonItemNames = c_items, + itemtype = 'Rasch', + tryFitwholeNewItems = FALSE, + tryFitwholeOldItems = FALSE, + checkIPD = FALSE, + tryEM = TRUE, + freeMEAN = TRUE, + forceNormalZeroOne = FALSE, + parameterOverwrite = FALSE, + empiricalhist = FALSE + ) + + expect_true(is.list(result)) + expect_true(inherits(result$LinkedModel, "SingleGroupClass")) +})