diff --git a/.jules/bolt.md b/.jules/bolt.md new file mode 100644 index 0000000..379e5cd --- /dev/null +++ b/.jules/bolt.md @@ -0,0 +1,3 @@ +## 2024-05-18 - R 언어에서 루프 내 정규식 탐색 병목 최적화 +**Learning:** R에서 데이터 프레임의 크기가 커질수록 루프 내에서 컬럼명을 추출하고 정규식을 이용해(`grep`) 문자열을 탐색하는 작업이 상당한 성능 오버헤드를 발생시킨다. 특히 O(N) 탐색을 루프 안에서 반복할 경우 O(N^2)의 비효율성을 초래한다. +**Action:** 루프 내부에서 자주 호출되는 컬럼명이나 데이터 프레임 구조 탐색을 루프 밖으로 빼서 한 번만 계산하여 벡터로 저장하도록 한다. 정규식보다는 완전 일치 탐색(`%in%`, `match`)이 가능하도록 벡터 연산을 활용해 O(1) 수준으로 성능을 끌어올려야 한다. diff --git a/R/aFIPC.R b/R/aFIPC.R index e9da38f..d14dcaa 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -17,6 +17,7 @@ #' @param forceNormalZeroOne set the prior distribution follows N(0,1) distribution. default is TRUE #' @param parameterOverwrite don't touch it #' @param empiricalhist do you want to use empirical histogram method when tryEM = TRUE? default is FALSE +#' @param confirmCommonItems set TRUE to accept the supplied common-item pairs without an interactive prompt. #' @param ... Additional arguments reserved for future extensions. #' #' @return the model list of the base form, new form, linked form @@ -43,6 +44,7 @@ autoFIPC <- forceNormalZeroOne = F, parameterOverwrite = F, empiricalhist = F, + confirmCommonItems = NULL, ... ) { # print credits @@ -75,7 +77,18 @@ autoFIPC <- data.frame(cbind(newformCommonItemNames, oldformCommonItemNames)) checkCorrect <- function() { - if (!interactive()) stop("Interactive session required for checking correct items") + if (isTRUE(confirmCommonItems)) { + return(1L) + } + if (identical(confirmCommonItems, FALSE)) { + return(2L) + } + if (!interactive()) { + stop( + 'Common item confirmation requires an interactive session; ', + 'set confirmCommonItems = TRUE to accept the supplied pairs.' + ) + } repeat { n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") if (grepl("^[0-9]+$", n)) { @@ -550,27 +563,20 @@ autoFIPC <- IPDItemNamesNewForm <- vector() # IPD target item checking + newFormColNames <- colnames(newformXDataK[colnames(newFormModel@Data$data)]) + oldFormColNames <- colnames(oldformYDataK[colnames(oldFormModel@Data$data)]) + for (i in 1:length(oldformCommonItemNames)) { + newFormItemName <- newFormColNames[match(newformCommonItemNames[i], newFormColNames)] + oldFormItemName <- oldFormColNames[match(oldformCommonItemNames[i], oldFormColNames)] if ( - (length(grep( - paste0('^', newformCommonItemNames[i], '$'), - colnames(newformXDataK[colnames(newFormModel@Data$data)]) - )) == - 1) == - TRUE && - (length(grep( - paste0('^', oldformCommonItemNames[i], '$'), - colnames(oldformYDataK[colnames(oldFormModel@Data$data)]) - )) == - 1) == - TRUE + !is.na(newFormItemName) && + !is.na(oldFormItemName) ) { IPDItemCount <- IPDItemCount + 1 - IPDItemNamesOldForm[IPDItemCount] <- - names(oldformYDataK[oldformCommonItemNames[i]]) - IPDItemNamesNewForm[IPDItemCount] <- - names(newformXDataK[newformCommonItemNames[i]]) - } else {} + IPDItemNamesOldForm[IPDItemCount] <- oldFormItemName + IPDItemNamesNewForm[IPDItemCount] <- newFormItemName + } } # IPD Data generation @@ -702,31 +708,20 @@ autoFIPC <- } } + newFormColNames <- colnames(newformXDataK[colnames(newFormModel@Data$data)]) + oldFormColNames <- colnames(oldformYDataK[colnames(oldFormModel@Data$data)]) + for (i in 1:length(oldformCommonItemNames)) { + newFormItemName <- newFormColNames[match(newformCommonItemNames[i], newFormColNames)] + oldFormItemName <- oldFormColNames[match(oldformCommonItemNames[i], oldFormColNames)] if ( - (length(grep( - paste0('^', newformCommonItemNames[i], '$'), - colnames(newformXDataK[colnames(newFormModel@Data$data)]) - )) == - 1) == - TRUE && - (length(grep( - paste0('^', oldformCommonItemNames[i], '$'), - colnames(oldformYDataK[colnames(oldFormModel@Data$data)]) - )) == - 1) == - TRUE && - (length(levels(as.factor( - newFormModel@Data$data[, grep( - paste0('^', newformCommonItemNames[i], '$'), - colnames(newformXDataK[colnames(newFormModel@Data$data)]) - )] + !is.na(newFormItemName) && + !is.na(oldFormItemName) && + (length(levels(as.factor( + newFormModel@Data$data[, newFormItemName] ))) == length(levels(as.factor( - oldFormModel@Data$data[, grep( - paste0('^', oldformCommonItemNames[i], '$'), - colnames(oldformYDataK[colnames(oldFormModel@Data$data)]) - )] + oldFormModel@Data$data[, oldFormItemName] )))) ) { message( diff --git a/docs/fixed-parameter-item-calibration.md b/docs/fixed-parameter-item-calibration.md new file mode 100644 index 0000000..a511f33 --- /dev/null +++ b/docs/fixed-parameter-item-calibration.md @@ -0,0 +1,31 @@ +# Fixed Parameter Item Calibration Basis + +`autoFIPC()` is maintained as a fixed item parameter calibration workflow. The +core invariant is that common-item parameters from the old form define the base +scale. During new-form calibration, the matching common items in the linked form +must keep those old-form values fixed, and only non-common new-form parameters +should move onto that base scale. + +This follows the fixed parameter calibration framing in Kim (2006): old +operational or anchor item parameters are treated as known values during the +new-form calibration so the new form is calibrated directly on the established +scale. The package test `test-fixed-parameter-calibration.R` reproduces this +contract with generated 2PL data: + +1. Generate old-form and new-form responses from known true item parameters. +2. Fit separate old-form and new-form `mirt` models. +3. Run `autoFIPC()` with the shared items declared as common items. +4. Assert that linked common-item `a1` and `d` values equal the old-form values + and are not estimated in the linked model. +5. Assert that the old-form estimates recover the generating common-item + parameters closely enough for a small deterministic regression test. + +## References + +- Kim, S. (2006). A comparative study of IRT fixed parameter calibration + methods. Journal of Educational Measurement, 43(4), 355-381. +- Chalmers, R. P. `mirt::fixedCalib` documentation. The implementation note + describes fixed-item calibration methods based on Kim (2006) and points to + `multipleGroup` for more flexible anchor-item calibration. +- Kim, S., & Kolen, M. J. (2010). Linking item parameters to a base scale. + Journal of Educational Measurement, 47(2), 164-181. diff --git a/man/autoFIPC.Rd b/man/autoFIPC.Rd index 6dc5890..58c65e5 100644 --- a/man/autoFIPC.Rd +++ b/man/autoFIPC.Rd @@ -20,6 +20,7 @@ autoFIPC( forceNormalZeroOne = F, parameterOverwrite = F, empiricalhist = F, + confirmCommonItems = NULL, ... ) } @@ -54,6 +55,8 @@ autoFIPC( \item{empiricalhist}{do you want to use empirical histogram method when tryEM = TRUE? default is FALSE} +\item{confirmCommonItems}{set TRUE to accept the supplied common-item pairs without an interactive prompt.} + \item{...}{Additional arguments reserved for future extensions.} } \value{ diff --git a/tests/testthat/test-autoFIPC.R b/tests/testthat/test-autoFIPC.R index ff6f096..312cac9 100644 --- a/tests/testthat/test-autoFIPC.R +++ b/tests/testthat/test-autoFIPC.R @@ -7,6 +7,6 @@ test_that("autoFIPC raises error in non-interactive session for inputs", { newformCommonItemNames = c('A'), oldformCommonItemNames = c('A') ), - "Interactive session required for checking correct items" + "Common item confirmation requires an interactive session" ) }) diff --git a/tests/testthat/test-fixed-parameter-calibration.R b/tests/testthat/test-fixed-parameter-calibration.R new file mode 100644 index 0000000..03923f5 --- /dev/null +++ b/tests/testthat/test-fixed-parameter-calibration.R @@ -0,0 +1,87 @@ +test_that("autoFIPC fixes common-item parameters on the old-form scale", { + skip_if_not_installed("mirt") + + set.seed(20260629) + old_item_names <- paste0("old_item_", 1:6) + new_item_names <- paste0("new_item_", 1:6) + old_common_items <- old_item_names[1:4] + new_common_items <- new_item_names[1:4] + old_a <- matrix(c(0.82, 1.05, 1.28, 0.96, 1.15, 0.74), ncol = 1) + old_d <- c(-1.05, -0.35, 0.15, 0.85, -0.65, 0.45) + new_a <- matrix(c(0.82, 1.05, 1.28, 0.96, 0.88, 1.36), ncol = 1) + new_d <- c(-1.05, -0.35, 0.15, 0.85, -0.05, 0.95) + + old_data <- as.data.frame(mirt::simdata( + a = old_a, + d = old_d, + itemtype = rep("2PL", length(old_item_names)), + N = 1600 + )) + new_data <- as.data.frame(mirt::simdata( + a = new_a, + d = new_d, + itemtype = rep("2PL", length(new_item_names)), + N = 1600 + )) + names(old_data) <- old_item_names + names(new_data) <- new_item_names + + old_model <- mirt::mirt( + old_data, + 1, + itemtype = "2PL", + method = "EM", + SE = FALSE, + verbose = FALSE, + technical = list(NCYCLES = 500) + ) + new_model <- mirt::mirt( + new_data, + 1, + itemtype = "2PL", + method = "EM", + SE = FALSE, + verbose = FALSE, + technical = list(NCYCLES = 500) + ) + + linked <- aFIPC::autoFIPC( + newformXData = new_model, + oldformYData = old_model, + newformCommonItemNames = new_common_items, + oldformCommonItemNames = old_common_items, + itemtype = "2PL", + checkIPD = FALSE, + tryEM = TRUE, + freeMEAN = FALSE, + forceNormalZeroOne = TRUE, + confirmCommonItems = TRUE + ) + + old_values <- mirt::mod2values(old_model) + linked_values <- mirt::mod2values(linked$LinkedModel) + + for (i in seq_along(old_common_items)) { + old_item <- old_common_items[i] + new_item <- new_common_items[i] + old_fixed <- old_values[ + old_values$item == old_item & old_values$name %in% c("a1", "d"), + c("name", "value") + ] + linked_fixed <- linked_values[ + linked_values$item == new_item & linked_values$name %in% c("a1", "d"), + c("name", "value", "est") + ] + + expect_equal(linked_fixed$name, old_fixed$name) + expect_equal(linked_fixed$value, old_fixed$value, tolerance = 1e-6) + expect_false(any(linked_fixed$est)) + } + + old_estimates <- old_values[ + old_values$item %in% old_common_items & old_values$name %in% c("a1", "d"), + "value" + ] + true_parameters <- c(rbind(old_a[1:4, 1], old_d[1:4])) + expect_lt(mean(abs(old_estimates - true_parameters)), 0.35) +})