diff --git a/NEWS.md b/NEWS.md index 9ac7adfd1..cad7ae434 100644 --- a/NEWS.md +++ b/NEWS.md @@ -79,6 +79,7 @@ * DOSNOA computation fixed for specimen-level grouping — urine-only data no longer gets incorrect dose numbering (#1116) * Dose-aware AUCint parameters now share the same PPTESTCD as their non-dose-aware counterparts in CDISC exports, with `PPANMETH` indicating the analytical method. Internal PPTESTCDs renamed from misleading `D` suffix (e.g. `AUCINTD`) to lowercase `da` suffix (e.g. `AUCINTda`). Fixed wrong PPTEST label for `AUCINTD` which said "Normalized by Dose" (#1242) * Optional settings (`slope_rules`, `int_parameters`, `ratio_table`) are now normalized to `NULL` when empty, instead of persisting as 0-row data frames throughout the app and settings pipeline (#1262) +* Fixed `PKNCA_impute_method_FALSE` error when YAML settings contain `impute_c0: no` — the `impute` column is now initialized before BLQ imputation to prevent name collision with the boolean function parameter (#1266) * Interval-specific parameters (`aucint.*`, `cav.int.*`) excluded from the Parameter Selection matrix — they require finite sub-intervals and must be configured via Partial Interval Calculations (#1309) ### Ratio Calculations diff --git a/R/PKNCA.R b/R/PKNCA.R index bc8e1caad..729c6432e 100644 --- a/R/PKNCA.R +++ b/R/PKNCA.R @@ -898,6 +898,18 @@ remove_pp_not_requested <- function(pknca_res) { pknca_res$data$intervals$impute <- NA_character_ } + # Match on PKNCA groups + interval IDs only; exclude keep_interval_cols + # to avoid type-mismatch errors on joins. + pknca_groups <- unique(c( + group_vars(pknca_res$data$conc), + group_vars(pknca_res$data$dose) + )) + match_cols <- unique(c( + pknca_groups, + "start", "end", "ATPTREF", "DOSNOA", "type_interval" + )) + match_cols <- intersect(match_cols, names(pknca_res$data$intervals)) + # Reshape intervals, filter params_not_requested <- pknca_res$data$intervals %>% pivot_longer( @@ -906,7 +918,7 @@ remove_pp_not_requested <- function(pknca_res) { values_to = "is_requested" ) %>% mutate(PPTESTCD = translate_terms(PPTESTCD, "PKNCA", "PPTESTCD")) %>% - group_by(across(c(-impute, -is_requested))) %>% + group_by(across(all_of(c(match_cols, "PPTESTCD")))) %>% summarise( is_requested = any(is_requested), .groups = "drop" diff --git a/R/intervals.R b/R/intervals.R index 0db736fa0..362ebe558 100644 --- a/R/intervals.R +++ b/R/intervals.R @@ -290,6 +290,12 @@ update_main_intervals <- function( data <- create_start_impute(data) } + # Prevent mutate() from resolving `impute` to the function parameter instead + # of the column (causes PKNCA_impute_method_FALSE error when impute=FALSE). + if (!"impute" %in% names(data$intervals)) { + data$intervals$impute <- NA_character_ + } + ############################################ # Define a BLQ imputation method for PKNCA # and apply it only for non-observational parameters diff --git a/R/ratio_calculations.R b/R/ratio_calculations.R index d40378ca5..0551b8d26 100644 --- a/R/ratio_calculations.R +++ b/R/ratio_calculations.R @@ -130,6 +130,12 @@ calculate_ratios.data.frame <- function( ) group_cols <- setdiff(colnames(data), extra_res_cols) + # Coerce YAML-sourced character values to match data column types for joins. + ref_groups <- .coerce_group_types(ref_groups, data) + if (!is.null(test_groups)) { + test_groups <- .coerce_group_types(test_groups, data) + } + # Define the reference and test data based on the parameters and groups df_ref <- as.data.frame(data)[data$PPTESTCD == ref_parameter, , drop = FALSE] df_ref <- merge(df_ref, ref_groups) @@ -468,6 +474,34 @@ calculate_ratio_app <- function( list(test_groups = test_groups, ref_groups = ref_groups) } +#' Coerce group column types to match the corresponding columns in data. +#' +#' When group specifications are sourced from YAML settings, all values +#' are character strings. If the PKNCA result data has those columns as +#' numeric (e.g. AGE), joins will fail with incompatible type errors. +#' This helper converts group columns to match the data column types. +#' +#' @param groups A data.frame of group values (from `.parse_ratio_groups`). +#' @param data A data.frame with the PKNCA result data. +#' @returns A data.frame with column types coerced to match `data`. +#' @noRd +.coerce_group_types <- function(groups, data) { + for (col in intersect(names(groups), names(data))) { + groups[[col]] <- utils::type.convert(groups[[col]], as.is = TRUE) + data_type <- class(data[[col]])[1] + group_type <- class(groups[[col]])[1] + if (data_type == group_type) next + if (data_type == "factor") { + groups[[col]] <- factor(groups[[col]], levels = levels(data[[col]])) + } else if (data_type %in% c("numeric", "integer")) { + groups[[col]] <- as.numeric(groups[[col]]) + } else if (data_type == "character") { + groups[[col]] <- as.character(groups[[col]]) + } + } + groups +} + #' Filter result data to keep only the specific interval rows for interval parameters. #' #' For non-interval parameters, all rows are kept. For interval parameters, diff --git a/inst/shiny/modules/tab_nca/setup/settings.R b/inst/shiny/modules/tab_nca/setup/settings.R index ceda5ae39..0dd6e9a59 100644 --- a/inst/shiny/modules/tab_nca/setup/settings.R +++ b/inst/shiny/modules/tab_nca/setup/settings.R @@ -588,6 +588,7 @@ settings_server <- function(id, data, adnca_data, settings_override) { if (!is.null(settings$int_parameters)) { int_parameters(settings$int_parameters) + reset_reactable_memory() refresh_reactable(refresh_reactable() + 1) } diff --git a/inst/shiny/modules/tab_nca/setup/slope_selector.R b/inst/shiny/modules/tab_nca/setup/slope_selector.R index 7f3cfe0f1..87fd20a9d 100644 --- a/inst/shiny/modules/tab_nca/setup/slope_selector.R +++ b/inst/shiny/modules/tab_nca/setup/slope_selector.R @@ -262,7 +262,7 @@ slope_selector_server <- function( # nolint manual_slopes(click_result$manual_slopes) # render rectable anew # - shinyjs::runjs("memory = {};") # needed to properly reset reactable.extras widgets + reset_reactable_memory() refresh_reactable(refresh_reactable() + 1) }) diff --git a/tests/testthat/test-ratio_calculations.R b/tests/testthat/test-ratio_calculations.R index 9ca2f4677..d8bc460a9 100644 --- a/tests/testthat/test-ratio_calculations.R +++ b/tests/testthat/test-ratio_calculations.R @@ -574,3 +574,49 @@ describe("calculate_ratio_app with interval parameters", { expect_true(nrow(ratios) > 0) }) }) + +describe(".coerce_group_types", { + it("coerces character column to numeric when data column is numeric", { + groups <- data.frame(AGE = "25", stringsAsFactors = FALSE) + data <- data.frame(AGE = 25, USUBJID = "S1") + result <- .coerce_group_types(groups, data) + expect_type(result$AGE, "double") + expect_equal(result$AGE, 25) + }) + + it("coerces character column to factor with correct levels when data column is factor", { + groups <- data.frame(RACE = "WHITE", stringsAsFactors = FALSE) + data <- data.frame( + RACE = factor(c("WHITE", "ASIAN", "BLACK")), + USUBJID = "S1", stringsAsFactors = FALSE + ) + result <- .coerce_group_types(groups, data) + expect_s3_class(result$RACE, "factor") + expect_setequal(levels(result$RACE), c("WHITE", "ASIAN", "BLACK")) + }) + + it("leaves already-matching types unchanged", { + groups <- data.frame(AGE = 25, RACE = "WHITE", stringsAsFactors = FALSE) + data <- data.frame(AGE = 30, RACE = "ASIAN", USUBJID = "S1", + stringsAsFactors = FALSE) + result <- .coerce_group_types(groups, data) + # AGE is already numeric → unchanged + expect_equal(result$AGE, 25) + # RACE is character, data$RACE is character → unchanged + expect_equal(result$RACE, "WHITE") + }) + + it("handles mixed columns: some coerced, some unchanged", { + groups <- data.frame(AGE = "25", RACE = "WHITE", SEX = "M", + stringsAsFactors = FALSE) + data <- data.frame(AGE = 30, RACE = "ASIAN", SEX = "F", USUBJID = "S1", + stringsAsFactors = FALSE) + result <- .coerce_group_types(groups, data) + # AGE: character → numeric + expect_type(result$AGE, "double") + expect_equal(result$AGE, 25) + # RACE, SEX: character → character (already matching) + expect_equal(result$RACE, "WHITE") + expect_equal(result$SEX, "M") + }) +})