diff --git a/R/aFIPC.R b/R/aFIPC.R index b6a9e6c..81b6cc9 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -16,6 +16,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 @@ -42,6 +43,7 @@ autoFIPC <- forceNormalZeroOne = F, parameterOverwrite = F, empiricalhist = F, + confirmCommonItems = NULL, ... ) { # print credits @@ -74,12 +76,25 @@ autoFIPC <- data.frame(cbind(newformCommonItemNames, oldformCommonItemNames)) checkCorrect <- function() { + 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.' + ) + } + n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") - if (!grepl("^[0-9]+$", n)) { - return(checkCorrect()) + while (!grepl("^[0-9]+$", n)) { + n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") } - return(as.integer(n)) + as.integer(n) } confirm <- checkCorrect() if (confirm != 1) { 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 27f679f..5505090 100644 --- a/man/autoFIPC.Rd +++ b/man/autoFIPC.Rd @@ -9,7 +9,8 @@ autoFIPC(newformXData = ..., oldformYData = ..., itemtype = "3PL", newformBILOGprior = NULL, oldformBILOGprior = NULL, tryFitwholeNewItems = T, tryFitwholeOldItems = T, checkIPD = T, tryEM = T, freeMEAN = T, forceNormalZeroOne = F, - parameterOverwrite = F, empiricalhist = F, ...) + parameterOverwrite = F, empiricalhist = F, confirmCommonItems = NULL, + ...) } \arguments{ \item{newformXData}{new form data X} @@ -42,6 +43,8 @@ autoFIPC(newformXData = ..., oldformYData = ..., \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.} } \description{ diff --git a/tests/testthat/test-fixed-parameter-calibration.R b/tests/testthat/test-fixed-parameter-calibration.R new file mode 100644 index 0000000..20c99de --- /dev/null +++ b/tests/testthat/test-fixed-parameter-calibration.R @@ -0,0 +1,83 @@ +test_that("autoFIPC fixes common-item parameters on the old-form scale", { + skip_if_not_installed("mirt") + + set.seed(20260629) + item_names <- paste0("I", 1:6) + common_items <- 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(item_names)), + N = 1600 + )) + new_data <- as.data.frame(mirt::simdata( + a = new_a, + d = new_d, + itemtype = rep("2PL", length(item_names)), + N = 1600 + )) + names(old_data) <- item_names + names(new_data) <- 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 = common_items, + oldformCommonItemNames = 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 (item in common_items) { + old_fixed <- old_values[ + old_values$item == item & old_values$name %in% c("a1", "d"), + c("name", "value") + ] + linked_fixed <- linked_values[ + linked_values$item == 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% 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) +})