Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -22,3 +22,4 @@
^\.jules(/.*)?$
^\.trivyignore\.yaml$
^trivy\.yaml$
^\.semgrepignore$
3 changes: 3 additions & 0 deletions .jules/bolt.md
Original file line number Diff line number Diff line change
Expand Up @@ -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) 오버헤드를 방지해야 합니다.
## 2024-07-26 - R 언어에서 최솟값/최댓값 탐색 시 정렬(sort) 오버헤드 최적화
**Learning:** R에서 벡터의 최솟값 또는 최댓값을 찾기 위해 `sort(x)[1]` 또는 `names(sort(x))[1]`과 같이 전체를 정렬하는 방식을 사용하면, O(N log N)의 불필요한 연산 오버헤드가 발생하여 성능이 저하됩니다.
**Action:** `which.min(x)` 또는 `which.max(x)`를 활용하여 `names(x)[which.min(x)]`와 같이 변경함으로써 전체 데이터를 정렬하지 않고 O(N) 선형 탐색으로 성능을 향상시켜야 합니다.
19 changes: 18 additions & 1 deletion R/surveyFA.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,20 @@
#' Select the first named minimum without sorting the full vector
#'
#' @description Returns the name attached to the first minimum value in a named
#' numeric vector. The helper intentionally uses a single linear scan so the
#' bounded recovery loop does not pay the cost of sorting every candidate.
#' @param values A named numeric vector whose missing-value policy has already
#' been applied by the caller.
#' @return The first minimum value's name, or `NA_character_` for an empty input.
#' @keywords internal
.minimum_named_value <- function(values) {
minimum_index <- which.min(values)
if (length(minimum_index) == 0L) {
return(NA_character_)
}
names(values)[minimum_index]
}

#' @title surveyFA
#' @description Fallback calibration helper used when direct model estimation in
#' `autoFIPC()` fails.
Expand Down Expand Up @@ -232,7 +249,7 @@ surveyFA <- function(
names(p_values) <- rownames(fit_df)
if (any(!is.na(p_values))) {
p_values[is.na(p_values)] <- 1
candidate <- names(sort(p_values, decreasing = FALSE))[1L]
candidate <- .minimum_named_value(p_values)
if (!is.na(candidate) && p_values[[candidate]] < pThreshold) {
Comment on lines 249 to 253
return(candidate)
}
Expand Down
59 changes: 59 additions & 0 deletions tests/testthat/test-surveyFA.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,8 +58,32 @@ test_that("surveyFA validates boolean control flags before estimator dispatch",
)
})

test_that("minimum named selection preserves prior sort semantics", {
normalized_cases <- list(
c(item_a = 0.40, item_b = 0.10, item_c = 0.30),
c(item_a = 0.10, item_b = 0.10, item_c = 0.20),
c(item_a = -0.50, item_b = 0.00, item_c = 0.50)
)
missing_case <- c(item_a = NA_real_, item_b = 0.20, item_c = 0.30)
missing_case[is.na(missing_case)] <- 1
normalized_cases[[length(normalized_cases) + 1L]] <- missing_case

for (p_values in normalized_cases) {
prior_candidate <- names(sort(p_values, decreasing = FALSE))[1L]
expect_identical(
aFIPC:::.minimum_named_value(p_values),
prior_candidate
)
}
expect_identical(
aFIPC:::.minimum_named_value(setNames(numeric(), character())),
NA_character_
)
})

test_that("surveyFA reports bounded recovery exhaustion when unrecoverable", {
skip_if_not_installed("mirt")
set.seed(20260726)

raw <- as.data.frame(
matrix(
Expand All @@ -82,3 +106,38 @@ test_that("surveyFA reports bounded recovery exhaustion when unrecoverable", {
"could not estimate a valid model after bounded recovery attempts"
)
})

test_that("surveyFA removes the minimum-variance binary item", {
skip_if_not_installed("mirt")
set.seed(20260727)

raw <- as.data.frame(
mirt::simdata(
a = matrix(c(1.00, 1.20, 0.95), ncol = 1),
d = c(-1.0, -0.45, -0.10),
itemtype = rep("2PL", 3),
N = 100
)
)
names(raw) <- c("item1", "item2", "item3")

# Keep the 2PL input binary while making item3 the deterministic variance minimum.
raw$item3 <- rep(0L, nrow(raw))
raw$item3[1:3] <- 1L

expect_error(
suppressWarnings(
aFIPC::surveyFA(
data = raw,
autofix = TRUE,
forceUIRT = TRUE,
itemtype = "2PL",
maxItemRemovals = 1,
forceNormalEM = TRUE,
SE = TRUE,
pThreshold = 0.000000001
)
),
"could not estimate a valid model after bounded recovery attempts.*Removed items: item3"
)
Comment thread
coderabbitai[bot] marked this conversation as resolved.
})
Loading