diff --git a/.jules/bolt.md b/.jules/bolt.md index cfa2846..7c64cbb 100644 --- a/.jules/bolt.md +++ b/.jules/bolt.md @@ -21,3 +21,6 @@ ## 2026-06-30 - Preserve NA handling when removing factor conversions **Learning:** `levels(as.factor(x))` excludes missing responses from the category count, so a faster replacement must not count `NA` as an extra response category. **Action:** Keep `na.omit(unique(x))` rather than plain `unique(x)` in response-category comparisons. +## 2025-01-20 - Optimize redundant which() array scans +**Learning:** Calling `which(NewScaleParms$item == paste0(newformCommonItemNames[i]))` inside a loop repeatedly executes O(N) array scans unnecessarily. The strings are also redundantly wrapped in `paste0()`. +**Action:** Calculate the target indexes (`which(...)`) once per loop iteration, cache them into variables (`new_idx`, `old_idx`), and reuse those variables for all subsequent modifications or extractions. Remove redundant `paste0()` wrapping for simple scalars to further optimize. diff --git a/NAMESPACE b/NAMESPACE index 9f3114a..36e3074 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,3 +4,4 @@ export(autoFIPC) export(surveyFA) import(mirt) importFrom(stats,factanal) +importFrom(stats, na.omit) diff --git a/R/aFIPC.R b/R/aFIPC.R index d0329f2..7c431e7 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -538,9 +538,9 @@ autoFIPC <- OldScaleParms[, "est"] <- TRUE } - NewScaleParms[which(NewScaleParms$item == paste0('GROUP')), "est"] <- + NewScaleParms[which(NewScaleParms$item == 'GROUP'), "est"] <- FALSE - OldScaleParms[which(OldScaleParms$item == paste0('GROUP')), "est"] <- + OldScaleParms[which(OldScaleParms$item == 'GROUP'), "est"] <- FALSE NewScaleParms[which(NewScaleParms$name == "COV_11"), "est"] <- @@ -725,64 +725,49 @@ autoFIPC <- ) { message( 'applying ', - paste0(newformCommonItemNames[i]), + newformCommonItemNames[i], ' <<< ', - paste0(oldformCommonItemNames[i]), + oldformCommonItemNames[i], ' as common item use' ) + new_idx <- which(NewScaleParms$item == newformCommonItemNames[i]) + old_idx <- which(OldScaleParms$item == oldformCommonItemNames[i]) + message( ' Newform Parms: ', paste0( - NewScaleParms[ - which(NewScaleParms$item == paste0(newformCommonItemNames[i])), - "value" - ], + NewScaleParms[new_idx, "value"], ' ' ) ) message( ' Oldform Parms: ', paste0( - OldScaleParms[ - which(OldScaleParms$item == paste0(oldformCommonItemNames[i])), - "value" - ], + OldScaleParms[old_idx, "value"], ' ' ) ) - NewScaleParms[ - which(NewScaleParms$item == paste0(newformCommonItemNames[i])), - "value" - ] <- - OldScaleParms[ - which(OldScaleParms$item == paste0(oldformCommonItemNames[i])), - "value" - ] + NewScaleParms[new_idx, "value"] <- + OldScaleParms[old_idx, "value"] + message( ' Linkedform Parms: ', paste0( - NewScaleParms[ - which(NewScaleParms$item == paste0(newformCommonItemNames[i])), - "value" - ], + NewScaleParms[new_idx, "value"], ' ' ), '\n' ) - NewScaleParms[ - which(NewScaleParms$item == paste0(newformCommonItemNames[i])), - "est" - ] <- - FALSE + NewScaleParms[new_idx, "est"] <- FALSE } else { message( 'skipping ', - paste0(newformCommonItemNames[i]), + newformCommonItemNames[i], ' <<< ', - paste0(oldformCommonItemNames[i]), + oldformCommonItemNames[i], ' as common item use' ) } @@ -792,9 +777,12 @@ autoFIPC <- length(attr(newFormModel@ParObjects$lrPars, 'parnum')) != 0 && length(attr(oldFormModel@ParObjects$lrPars, 'parnum')) != 0 ) { - NewScaleParms[which(NewScaleParms$item == paste0('BETA')), "value"] <- - OldScaleParms[which(OldScaleParms$item == paste0('BETA')), "value"] - NewScaleParms[which(NewScaleParms$item == paste0('BETA')), "est"] <- + beta_new_idx <- which(NewScaleParms$item == 'BETA') + beta_old_idx <- which(OldScaleParms$item == 'BETA') + + NewScaleParms[beta_new_idx, "value"] <- + OldScaleParms[beta_old_idx, "value"] + NewScaleParms[beta_new_idx, "est"] <- FALSE message('applying BETA parameter as linking') @@ -802,7 +790,7 @@ autoFIPC <- message( ' Linkedform Parms: ', paste0( - NewScaleParms[which(NewScaleParms$item == paste0('BETA')), "value"], + NewScaleParms[beta_new_idx, "value"], ' ' ), '\n' diff --git a/tests/testthat/test-autoFIPC-coverage.R b/tests/testthat/test-autoFIPC-coverage.R new file mode 100644 index 0000000..ecc095b --- /dev/null +++ b/tests/testthat/test-autoFIPC-coverage.R @@ -0,0 +1,32 @@ +test_that("autoFIPC non-interactive error checks", { + skip_if_not_installed("mirt") + set.seed(42) + dat_old <- mirt::simdata(matrix(runif(5, 0.8, 2)), matrix(rnorm(5)), N = 50, itemtype = "2PL") + dat_new <- mirt::simdata(matrix(runif(5, 0.8, 2)), matrix(rnorm(5)), N = 50, itemtype = "2PL") + colnames(dat_old) <- paste0("I", 1:5) + colnames(dat_new) <- paste0("I", 1:5) + old_mod <- mirt::mirt(dat_old, 1, itemtype = "2PL", SE = FALSE, verbose = FALSE) + new_mod <- mirt::mirt(dat_new, 1, itemtype = "2PL", SE = FALSE, verbose = FALSE) + + expect_error( + aFIPC::autoFIPC( + newformXData = new_mod, + oldformYData = old_mod, + newformCommonItemNames = c("I1", "I2"), + oldformCommonItemNames = c("I1"), + confirmCommonItems = TRUE + ), + "Common Items are not equal" + ) + + expect_error( + aFIPC::autoFIPC( + newformXData = new_mod, + oldformYData = old_mod, + newformCommonItemNames = character(0), + oldformCommonItemNames = character(0), + confirmCommonItems = TRUE + ), + "Please provide common item names" + ) +}) diff --git a/tests/testthat/test-surveyFA.R b/tests/testthat/test-surveyFA.R new file mode 100644 index 0000000..3c88ff8 --- /dev/null +++ b/tests/testthat/test-surveyFA.R @@ -0,0 +1,4 @@ +test_that("surveyFA stub works", { + expect_message(surveyFA(), "surveyFA is currently a stub.") + expect_null(surveyFA()) +}) diff --git a/tests/testthat/test-which-optimization.R b/tests/testthat/test-which-optimization.R new file mode 100644 index 0000000..7726732 --- /dev/null +++ b/tests/testthat/test-which-optimization.R @@ -0,0 +1,27 @@ +test_that("which optimization correctly matches items", { + skip_if_not_installed("mirt") + + # A small dummy test to just run autoFIPC and verify it doesn't crash + # with the new variables `new_idx` and `old_idx` we introduced. + set.seed(42) + dat_old <- mirt::simdata(matrix(runif(5, 0.8, 2)), matrix(rnorm(5)), N = 50, itemtype = "2PL") + dat_new <- mirt::simdata(matrix(runif(5, 0.8, 2)), matrix(rnorm(5)), N = 50, itemtype = "2PL") + + colnames(dat_old) <- paste0("I", 1:5) + colnames(dat_new) <- paste0("I", 1:5) + + old_mod <- mirt::mirt(dat_old, 1, itemtype = "2PL", SE = FALSE, verbose = FALSE) + new_mod <- mirt::mirt(dat_new, 1, itemtype = "2PL", SE = FALSE, verbose = FALSE) + + res <- aFIPC::autoFIPC( + newformXData = new_mod, + oldformYData = old_mod, + newformCommonItemNames = c("I1", "I2"), + oldformCommonItemNames = c("I1", "I2"), + itemtype = "2PL", + checkIPD = FALSE, + confirmCommonItems = TRUE + ) + + expect_type(res, "list") +})