⚡ Bolt: 파라미터 링킹 루프 내 반복적인 which() 탐색 최적화

.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.

NAMESPACE

@@ -4,3 +4,4 @@ export(autoFIPC)
 export(surveyFA)
 import(mirt)
 importFrom(stats,factanal)
+importFrom(stats, na.omit)

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,17 +777,20 @@ 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')
 
       message(
         '   Linkedform Parms: ',
         paste0(
-          NewScaleParms[which(NewScaleParms$item == paste0('BETA')), "value"],
+          NewScaleParms[beta_new_idx, "value"],
           ' '
         ),
         '\n'

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"
+  )
+})

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())
+})

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")
+})