diff --git a/.jules/bolt.md b/.jules/bolt.md index 7d3c603..e0b99dd 100644 --- a/.jules/bolt.md +++ b/.jules/bolt.md @@ -16,3 +16,6 @@ ## 2025-02-12 - R 언어에서 반복적인 mirt 모델 생성 시 불필요한 데이터프레임 부분집합 추출 최적화 **Learning:** R에서 데이터프레임의 특정 열을 추출하는 작업(`df[cols]`)은 O(N)의 메모리 복사를 수반합니다. `autoFIPC`에서 `mirt` 모델의 파라미터를 설정하거나 호출하는 과정 중에 `newformXDataK[colnames(newFormModel@Data$data)]` 코드가 반복해서 사용되었고, 심지어 `ncol()`을 위해 단순히 개수를 구할 때도 사용되어 불필요한 메모리 할당과 오버헤드를 초래했습니다. **Action:** 조건문이나 반복문 내부에서 불필요하게 데이터프레임 부분집합 연산이 반복되지 않도록 외부에서 한 번만 `linkedFormData <- newformXDataK[colnames(newFormModel@Data$data)]`로 캐싱(caching)한 뒤, `ncol(linkedFormData)`와 `data = linkedFormData` 형태로 재사용하여 메모리 복사와 O(N) 오버헤드를 방지해야 합니다. +## 2026-07-20 - R 언어에서 데이터프레임 서브셋팅 시 직접 벡터 참조(Direct Vector Subsetting) 최적화 +**Learning:** R에서 `df[condition, "column"] <- value` 같은 2차원 서브셋팅(two-dimensional subsetting)은 S3 메서드 디스패치와 데이터프레임 차원 검사를 수행합니다. 직접 열 할당은 이 고정 오버헤드를 줄이지만, 논리 인덱스 계산과 copy-on-modify 비용은 데이터 크기에 비례하므로 시간 복잡도는 O(N)으로 유지됩니다. +**Action:** `mirt::mod2values()` 결과를 data.frame과 필수 열 스키마로 명시적 검증한 뒤 `df$column[condition] <- value` 형태의 직접 열 할당을 사용합니다. 기존 2차원 할당과 결과·속성이 동일한지는 대표 파라미터 테이블과 Rasch 분기 회귀 테스트로 보존합니다. diff --git a/R/aFIPC.R b/R/aFIPC.R index 6254651..180885b 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -1,3 +1,45 @@ +.validate_scale_parameter_table <- function(parameters, label) { + if (!is.data.frame(parameters)) { + stop( + sprintf("Security Error: %s parameter table must be a data.frame", label), + call. = FALSE + ) + } + + required_columns <- c("item", "name", "value", "est") + missing_columns <- setdiff(required_columns, names(parameters)) + if (length(missing_columns) > 0) { + stop( + sprintf( + "Security Error: %s parameter table is missing required column(s): %s", + label, + paste(missing_columns, collapse = ", ") + ), + call. = FALSE + ) + } + + invisible(parameters) +} + +.prepare_scale_parameters <- function(new_parameters, old_parameters, itemtype) { + .validate_scale_parameter_table(new_parameters, "new-form") + .validate_scale_parameter_table(old_parameters, "old-form") + + new_parameters$est[new_parameters$item == 'GROUP'] <- FALSE + old_parameters$est[old_parameters$item == 'GROUP'] <- FALSE + + new_parameters$est[new_parameters$name == "COV_11"] <- TRUE + old_parameters$est[old_parameters$name == "COV_11"] <- TRUE + + if (itemtype == 'Rasch') { + new_parameters$est[new_parameters$name == "a1"] <- FALSE + old_parameters$est[old_parameters$name == "a1"] <- FALSE + } + + list(new = new_parameters, old = old_parameters) +} + #' automated fixed item parameter linking #' #' @import mirt @@ -64,7 +106,7 @@ autoFIPC <- if (!isS4(x) || !methods::is(x, "SingleGroupClass")) return(FALSE) ok <- tryCatch({ vals <- mirt::mod2values(x) - is.data.frame(vals) || is.matrix(vals) + is.data.frame(vals) }, error = function(e) FALSE, warning = function(w) FALSE) if (!isTRUE(ok)) return(FALSE) required_slots <- c("OptimInfo", "ParObjects") @@ -597,17 +639,14 @@ autoFIPC <- # Preserve mirt's structural estimability flags. Forcing every row TRUE # frees boundary parameters such as 2PL g/u and makes the Hessian unstable. - - NewScaleParms[NewScaleParms$item == 'GROUP', "est"] <- FALSE - OldScaleParms[OldScaleParms$item == 'GROUP', "est"] <- FALSE - - NewScaleParms[NewScaleParms$name == "COV_11", "est"] <- TRUE - OldScaleParms[OldScaleParms$name == "COV_11", "est"] <- TRUE - - if (itemtype == 'Rasch') { - NewScaleParms[NewScaleParms$name == "a1", "est"] <- FALSE - OldScaleParms[OldScaleParms$name == "a1", "est"] <- FALSE - } + prepared_parameters <- .prepare_scale_parameters( + NewScaleParms, + OldScaleParms, + itemtype + ) + NewScaleParms <- prepared_parameters$new + OldScaleParms <- prepared_parameters$old + rm(prepared_parameters) #IPD if (checkIPD == T) { @@ -785,15 +824,15 @@ autoFIPC <- newIdx <- newScaleParmsItemIdxCache[[newFormItemStr]] oldIdx <- oldScaleParmsItemIdxCache[[oldFormItemStr]] - # ⚡ Bolt: Remove unnecessary paste0() array string generation overhead - message(' Newform Parms: ', paste(NewScaleParms[newIdx, "value"], collapse = ' ')) - message(' Oldform Parms: ', paste(OldScaleParms[oldIdx, "value"], collapse = ' ')) + # ⚡ Bolt: Use cached rows with direct column access to avoid 2D dispatch + message(' Newform Parms: ', paste(NewScaleParms$value[newIdx], collapse = ' ')) + message(' Oldform Parms: ', paste(OldScaleParms$value[oldIdx], collapse = ' ')) - NewScaleParms[newIdx, "value"] <- - OldScaleParms[oldIdx, "value"] - message(' Linkedform Parms: ', paste(NewScaleParms[newIdx, "value"], collapse = ' '), '\n') + NewScaleParms$value[newIdx] <- + OldScaleParms$value[oldIdx] + message(' Linkedform Parms: ', paste(NewScaleParms$value[newIdx], collapse = ' '), '\n') - NewScaleParms[newIdx, "est"] <- + NewScaleParms$est[newIdx] <- FALSE } else { message( @@ -813,9 +852,9 @@ autoFIPC <- newBetaIdx <- NewScaleParms$item == 'BETA' oldBetaIdx <- OldScaleParms$item == 'BETA' - NewScaleParms[newBetaIdx, "value"] <- - OldScaleParms[oldBetaIdx, "value"] - NewScaleParms[newBetaIdx, "est"] <- + NewScaleParms$value[newBetaIdx] <- + OldScaleParms$value[oldBetaIdx] + NewScaleParms$est[newBetaIdx] <- FALSE message('applying BETA parameter as linking') @@ -823,7 +862,7 @@ autoFIPC <- message( ' Linkedform Parms: ', paste0( - NewScaleParms[newBetaIdx, "value"], + NewScaleParms$value[newBetaIdx], ' ' ), '\n' @@ -858,13 +897,13 @@ autoFIPC <- new_mean11_idx <- NewScaleParms$name == "MEAN_11" old_mean11_idx <- OldScaleParms$name == "MEAN_11" - NewScaleParms[new_cov11_idx, "est"] <- FALSE - OldScaleParms[old_cov11_idx, "est"] <- FALSE - NewScaleParms[new_mean11_idx, "est"] <- FALSE - OldScaleParms[old_mean11_idx, "est"] <- FALSE + NewScaleParms$est[new_cov11_idx] <- FALSE + OldScaleParms$est[old_cov11_idx] <- FALSE + NewScaleParms$est[new_mean11_idx] <- FALSE + OldScaleParms$est[old_mean11_idx] <- FALSE - NewScaleParms[new_cov11_idx, "value"] <- 1 - OldScaleParms[old_mean11_idx, "value"] <- 0 + NewScaleParms$value[new_cov11_idx] <- 1 + OldScaleParms$value[old_mean11_idx] <- 0 } if (freeMEAN == T) { LinkedModelSyntax <- @@ -875,8 +914,8 @@ autoFIPC <- 'MEAN = F1' )) - NewScaleParms[NewScaleParms$name == "MEAN_1", "est"] <- TRUE - OldScaleParms[OldScaleParms$name == "MEAN_1", "est"] <- TRUE + NewScaleParms$est[NewScaleParms$name == "MEAN_1"] <- TRUE + OldScaleParms$est[OldScaleParms$name == "MEAN_1"] <- TRUE } else { LinkedModelSyntax <- mirt::mirt.model(paste0( diff --git a/tests/testthat/test-optimization-equivalence.R b/tests/testthat/test-optimization-equivalence.R index 02ce2f7..d7a5fa6 100644 --- a/tests/testthat/test-optimization-equivalence.R +++ b/tests/testthat/test-optimization-equivalence.R @@ -78,3 +78,149 @@ test_that("IPD anchor extraction keeps old/new rows and screened columns (#99)", expect_identical(actual_old, legacy_old) expect_identical(actual_new, legacy_new) }) + +test_that("Direct column assignment matches 2D assignment behavior", { + # Mock Data setup equivalent to scale parms + NewScaleParms_2D <- data.frame( + item = c("GROUP", "Item1", "BETA", "Item2"), + name = c("MEAN_1", "a1", "COV_11", "d"), + value = c(0, 1.5, 1, -0.5), + est = c(TRUE, TRUE, FALSE, TRUE), + stringsAsFactors = FALSE + ) + OldScaleParms_2D <- NewScaleParms_2D + OldScaleParms_2D$value <- c(1, 2.0, 0, -1.0) + + NewScaleParms_1D <- NewScaleParms_2D + OldScaleParms_1D <- OldScaleParms_2D + + # 2D Assignment (Legacy) + NewScaleParms_2D[NewScaleParms_2D$item == 'GROUP', "est"] <- FALSE + OldScaleParms_2D[OldScaleParms_2D$item == 'GROUP', "est"] <- FALSE + NewScaleParms_2D[NewScaleParms_2D$name == "COV_11", "est"] <- TRUE + OldScaleParms_2D[OldScaleParms_2D$name == "COV_11", "est"] <- TRUE + NewScaleParms_2D[NewScaleParms_2D$name == "a1", "est"] <- FALSE + OldScaleParms_2D[OldScaleParms_2D$name == "a1", "est"] <- FALSE + + newBetaIdx <- NewScaleParms_2D$item == 'BETA' + oldBetaIdx <- OldScaleParms_2D$item == 'BETA' + NewScaleParms_2D[newBetaIdx, "value"] <- OldScaleParms_2D[oldBetaIdx, "value"] + NewScaleParms_2D[newBetaIdx, "est"] <- FALSE + + # 1D Assignment (Optimized) + NewScaleParms_1D$est[NewScaleParms_1D$item == 'GROUP'] <- FALSE + OldScaleParms_1D$est[OldScaleParms_1D$item == 'GROUP'] <- FALSE + NewScaleParms_1D$est[NewScaleParms_1D$name == "COV_11"] <- TRUE + OldScaleParms_1D$est[OldScaleParms_1D$name == "COV_11"] <- TRUE + NewScaleParms_1D$est[NewScaleParms_1D$name == "a1"] <- FALSE + OldScaleParms_1D$est[OldScaleParms_1D$name == "a1"] <- FALSE + + newBetaIdx_1D <- NewScaleParms_1D$item == 'BETA' + oldBetaIdx_1D <- OldScaleParms_1D$item == 'BETA' + NewScaleParms_1D$value[newBetaIdx_1D] <- OldScaleParms_1D$value[oldBetaIdx_1D] + NewScaleParms_1D$est[newBetaIdx_1D] <- FALSE + + expect_identical(NewScaleParms_2D, NewScaleParms_1D) + expect_identical(OldScaleParms_2D, OldScaleParms_1D) + + # Check type preservation + expect_type(NewScaleParms_1D$value, "double") + expect_type(NewScaleParms_1D$est, "logical") +}) + +test_that("direct parameter-column assignment preserves table semantics (#156)", { + new_parameters <- data.frame( + item = c("GROUP", "item_1", "item_1", "item_2", "BETA", "GROUP"), + name = c("MEAN_1", "a1", "d", "COV_11", "beta", "MEAN_11"), + value = c(0, 0.8, -0.4, 0.9, 0.2, 0.1), + est = c(TRUE, TRUE, TRUE, FALSE, TRUE, TRUE), + stringsAsFactors = FALSE + ) + old_parameters <- data.frame( + item = c("GROUP", "old_1", "old_1", "old_2", "BETA", "GROUP"), + name = c("MEAN_1", "a1", "d", "COV_11", "beta", "MEAN_11"), + value = c(0, 1.1, -0.7, 1.2, 0.5, -0.1), + est = c(TRUE, TRUE, TRUE, FALSE, TRUE, TRUE), + stringsAsFactors = FALSE + ) + + legacy_new <- new_parameters + legacy_old <- old_parameters + direct_new <- new_parameters + direct_old <- old_parameters + + legacy_new[legacy_new$item == "GROUP", "est"] <- FALSE + legacy_old[legacy_old$item == "GROUP", "est"] <- FALSE + direct_new$est[direct_new$item == "GROUP"] <- FALSE + direct_old$est[direct_old$item == "GROUP"] <- FALSE + + legacy_new[legacy_new$name == "COV_11", "est"] <- TRUE + legacy_old[legacy_old$name == "COV_11", "est"] <- TRUE + direct_new$est[direct_new$name == "COV_11"] <- TRUE + direct_old$est[direct_old$name == "COV_11"] <- TRUE + + new_anchor <- legacy_new$item == "item_1" + old_anchor <- legacy_old$item == "old_1" + direct_new_anchor <- direct_new$item == "item_1" + direct_old_anchor <- direct_old$item == "old_1" + legacy_new[new_anchor, "value"] <- legacy_old[old_anchor, "value"] + legacy_new[new_anchor, "est"] <- FALSE + direct_new$value[direct_new_anchor] <- direct_old$value[direct_old_anchor] + direct_new$est[direct_new_anchor] <- FALSE + + new_beta <- legacy_new$item == "BETA" + old_beta <- legacy_old$item == "BETA" + direct_new_beta <- direct_new$item == "BETA" + direct_old_beta <- direct_old$item == "BETA" + legacy_new[new_beta, "value"] <- legacy_old[old_beta, "value"] + legacy_new[new_beta, "est"] <- FALSE + direct_new$value[direct_new_beta] <- direct_old$value[direct_old_beta] + direct_new$est[direct_new_beta] <- FALSE + + expect_identical(direct_new, legacy_new) + expect_identical(direct_old, legacy_old) +}) + +test_that("scale-parameter preparation validates schema and preserves Rasch semantics (#156)", { + parameters <- data.frame( + item = c("GROUP", "item_1", "item_2"), + name = c("MEAN_1", "a1", "COV_11"), + value = c(0, 1, 1), + est = c(TRUE, TRUE, FALSE), + stringsAsFactors = FALSE + ) + + legacy_new <- parameters + legacy_old <- parameters + legacy_new[legacy_new$item == "GROUP", "est"] <- FALSE + legacy_old[legacy_old$item == "GROUP", "est"] <- FALSE + legacy_new[legacy_new$name == "COV_11", "est"] <- TRUE + legacy_old[legacy_old$name == "COV_11", "est"] <- TRUE + legacy_new[legacy_new$name == "a1", "est"] <- FALSE + legacy_old[legacy_old$name == "a1", "est"] <- FALSE + + actual <- aFIPC:::.prepare_scale_parameters(parameters, parameters, "Rasch") + + expect_identical(actual$new, legacy_new) + expect_identical(actual$old, legacy_old) + expect_false(actual$new$est[actual$new$name == "a1"]) + + expect_error( + aFIPC:::.prepare_scale_parameters( + as.matrix(parameters), + parameters, + "Rasch" + ), + "new-form parameter table must be a data.frame", + fixed = TRUE + ) + + for (missing_column in c("item", "name", "value", "est")) { + incomplete <- parameters[setdiff(names(parameters), missing_column)] + expect_error( + aFIPC:::.prepare_scale_parameters(incomplete, parameters, "Rasch"), + paste0("missing required column\\(s\\): ", missing_column), + fixed = FALSE + ) + } +})