From a2106094ddd6c30c1fa8a57a81f190c76a597bc2 Mon Sep 17 00:00:00 2001 From: seonghobae <8172694+seonghobae@users.noreply.github.com> Date: Sat, 4 Jul 2026 16:25:29 +0000 Subject: [PATCH] =?UTF-8?q?=E2=9A=A1=20Bolt:=20=ED=8C=8C=EB=9D=BC=EB=AF=B8?= =?UTF-8?q?=ED=84=B0=20=EB=A7=81=ED=82=B9=20=EB=A3=A8=ED=94=84=20=EB=82=B4?= =?UTF-8?q?=20=EB=B0=98=EB=B3=B5=EC=A0=81=EC=9D=B8=20which()=20=ED=83=90?= =?UTF-8?q?=EC=83=89=20=EC=B5=9C=EC=A0=81=ED=99=94?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 루프 내부에서 불필요하게 반복되던 O(N) `which()` 스캔을 제거하고 인덱스를 변수에 캐싱하도록 최적화하였습니다. 또한 불필요한 `paste0()` 래핑을 제거하여 성능을 추가로 향상시켰습니다. 💡 변경사항: `NewScaleParms`와 `OldScaleParms`에서 공통 문항 위치를 찾는 `which()` 결과를 `new_idx`, `old_idx`로 한 번만 계산 후 재사용 🎯 이유: 루프(K번 반복) 내부에서 배열 길이(N)만큼 탐색하는 O(N) 연산이 매 반복마다 4~6회씩 중복 호출되어, 문항 수가 많아질수록 O(K * N) 성능 저하가 발생함 📊 영향: 반복적인 벡터 검색과 문자열 할당을 제거하여 파라미터 링킹 및 IPD 확인 과정의 속도와 메모리 효율성 개선 🔬 검증: `R CMD check` 통과 및 `testthat` 테스트 성공 확인 --- .jules/bolt.md | 3 ++ NAMESPACE | 1 + R/aFIPC.R | 58 ++++++++++-------------- tests/testthat/test-autoFIPC-coverage.R | 32 +++++++++++++ tests/testthat/test-surveyFA.R | 4 ++ tests/testthat/test-which-optimization.R | 27 +++++++++++ 6 files changed, 90 insertions(+), 35 deletions(-) create mode 100644 tests/testthat/test-autoFIPC-coverage.R create mode 100644 tests/testthat/test-surveyFA.R create mode 100644 tests/testthat/test-which-optimization.R 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") +})