diff --git a/NEWS.md b/NEWS.md index da055c698..dddf26d3f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -90,6 +90,7 @@ * Fixed `Aggregate Subject = yes/if-needed` not aggregating reference values, and ratio columns not appearing in results (#1273) ### NCA Results & Export +* Interval parameters (e.g. `AUCINT_0-24`) now display human-readable labels in parameter selectors and boxplot y-axis, instead of raw PPTESTCDs (#1305) * Descriptive statistics were silently ungrouped when exported before visiting the tab — now falls back to default grouping columns (#1264) * Fixed NA `PPSTRESU` handling: descriptive statistics no longer crash on all-NA unit groups, and manual interval parameters no longer get `NA` in column names (#1216) * `get_settings_code()` reads mapping, filters, ratio table, and units from YAML instead of hardcoded defaults (#1189) diff --git a/R/flexible_violinboxplot.R b/R/flexible_violinboxplot.R index 70c6eb061..3d7c91e05 100644 --- a/R/flexible_violinboxplot.R +++ b/R/flexible_violinboxplot.R @@ -169,6 +169,19 @@ flexible_violinboxplot <- function(res_nca, #' @returns Formatted y-axis label. #' @noRd .build_ylabel <- function(parameter, unit) { + # Resolve interval parameter label (e.g. AUCINT_0-24 -> "AUC from 0 to 24") + parsed <- parse_interval_parameter(parameter) + if (parsed$is_interval) { + label <- metadata_nca_parameters$PPTEST[ + match(parsed$base, metadata_nca_parameters$PPTESTCD) + ] + if (!is.na(label)) { + label <- gsub("T1", as.character(parsed$start), label) + label <- gsub("T2", as.character(parsed$end), label) + parameter <- label + } + } + if (is.null(unit) || is.na(unit) || unit == "" || unit == "unitless") { parameter } else { diff --git a/R/label_operators.R b/R/label_operators.R index 08d26a80b..6dc339af3 100644 --- a/R/label_operators.R +++ b/R/label_operators.R @@ -34,6 +34,47 @@ apply_labels <- function(data, labels_df = metadata_nca_variables, type = "ADNCA data } +#' Resolve parameter labels for data frame columns +#' +#' Parses column names like `AUCINT_0-12[Hours*ug/mL]`, strips the unit suffix, +#' resolves the parameter label via `metadata_nca_parameters`, and replaces +#' T1/T2 placeholders with actual interval start/end values. +#' +#' @param data A data frame. +#' @returns Data frame with `label` attributes set for recognized parameter columns. +#' @noRd +resolve_param_labels <- function(data) { + col_names <- names(data) + for (col in col_names) { + # Skip columns that already have a label set + existing_label <- attr(data[[col]], "label") + if (!is.null(existing_label) && !identical(existing_label, col)) next + + # Strip unit suffix: "AUCINT_0-12[Hours*ug/mL]" -> "AUCINT_0-12" + pptestcd <- gsub("\\[.*\\]", "", col) + parsed <- parse_interval_parameter(pptestcd) + label <- if (parsed$is_interval) { + base_label <- metadata_nca_parameters$PPTEST[ + match(parsed$base, metadata_nca_parameters$PPTESTCD) + ] + if (!is.na(base_label)) { + base_label <- gsub("T1", as.character(parsed$start), base_label) + gsub("T2", as.character(parsed$end), base_label) + } else { + NULL + } + } else { + metadata_nca_parameters$PPTEST[ + match(pptestcd, metadata_nca_parameters$PPTESTCD) + ] + } + if (!is.null(label) && !is.na(label)) { + attr(data[[col]], "label") <- label + } + } + data +} + #' Get the Label of a Heading #' #' This function retrieves the label of a heading from a labels file. @@ -169,8 +210,23 @@ add_label_attribute <- function(df, myres) { !is.na(PPSTRESU) & PPSTRESU != "" ~ paste0(PPTESTCD, "[", PPSTRESU, "]"), TRUE ~ PPTESTCD ), - PPTESTCD_cdisc = translate_terms(PPTESTCD, mapping_col = "PPTESTCD", target_col = "PPTEST") + PPTESTCD_cdisc_raw = translate_terms( + PPTESTCD, mapping_col = "PPTESTCD", target_col = "PPTEST" + ), + PPTESTCD_cdisc = PPTESTCD_cdisc_raw + ) %>% + group_by(start, end, type_interval) %>% + mutate( + PPTESTCD_cdisc = if (type_interval[1] == "manual") { + label <- PPTESTCD_cdisc_raw + label <- gsub("T1", as.character(start[1]), label) + label <- gsub("T2", as.character(end[1]), label) + label + } else { + PPTESTCD_cdisc + } ) %>% + ungroup() %>% select(PPTESTCD_cdisc, PPTESTCD_unit) %>% distinct() %>% pull(PPTESTCD_cdisc, PPTESTCD_unit) diff --git a/R/pivot_wider_pknca_results.R b/R/pivot_wider_pknca_results.R index 9fbdbd99b..34c1ba39b 100644 --- a/R/pivot_wider_pknca_results.R +++ b/R/pivot_wider_pknca_results.R @@ -207,36 +207,6 @@ pivot_wider_pknca_results <- function(myres, flag_rules = NULL, extra_vars_to_ke if (length(unique_values) == 0) NA_character_ else paste(unique_values, collapse = ", ") } -#' Helper function to add "label" attribute to columns based on parameter names. -#' @noRd -#' @keywords internal -add_label_attribute <- function(df, myres) { - mapping_vr <- myres$result %>% - mutate( - PPTESTCD_unit = case_when( - type_interval == "manual" ~ paste0( - PPTESTCD, "_", start, "-", end, - ifelse(!is.na(PPSTRESU) & PPSTRESU != "", paste0("[", PPSTRESU, "]"), "") - ), - !is.na(PPSTRESU) & PPSTRESU != "" ~ paste0(PPTESTCD, "[", PPSTRESU, "]"), - TRUE ~ PPTESTCD - ), - PPTESTCD_cdisc = translate_terms(PPTESTCD, mapping_col = "PPTESTCD", target_col = "PPTEST") - ) %>% - select(PPTESTCD_cdisc, PPTESTCD_unit) %>% - distinct() %>% - pull(PPTESTCD_cdisc, PPTESTCD_unit) - - mapping_cols <- intersect(names(df), names(mapping_vr)) - attrs <- unname(mapping_vr[mapping_cols]) - - df[, mapping_cols] <- as.data.frame(mapply(function(col, bw) { - attr(col, "label") <- bw - col - }, df[, mapping_cols], attrs, SIMPLIFY = FALSE)) - df -} - #' Apply Flagging Logic to NCA Results #' #' @description diff --git a/R/zzz.R b/R/zzz.R index 8c636c2c2..e74199e54 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -82,6 +82,7 @@ "PPTEST", "PPTESTCD", "PPTESTCD_cdisc", + "PPTESTCD_cdisc_raw", "PPTESTCD_ref", "PPTESTCD_unit", "PPSUMFL", diff --git a/inst/shiny/functions/selector_label.R b/inst/shiny/functions/selector_label.R index 67dcb9b31..6b24e321e 100644 --- a/inst/shiny/functions/selector_label.R +++ b/inst/shiny/functions/selector_label.R @@ -53,12 +53,35 @@ selector_label <- function(input, output, session, } else if (metadata_type == "parameter") { req(metadata_nca_parameters) choices_df <- data.frame(PPTESTCD = choices, stringsAsFactors = FALSE) + + # Parse interval suffix (e.g. AUCINT_0-24 -> base=AUCINT) for label lookup + parsed_info <- lapply(choices_df$PPTESTCD, parse_interval_parameter) + choices_df$base_pptestcd <- vapply(parsed_info, `[[`, "base", FUN.VALUE = "") + choices_df$is_interval <- vapply(parsed_info, `[[`, "is_interval", FUN.VALUE = TRUE) + choices_df$start_dose <- vapply(parsed_info, function(x) { + if (is.null(x$start)) NA_real_ else x$start + }, FUN.VALUE = 0) + choices_df$end_dose <- vapply(parsed_info, function(x) { + if (is.null(x$end)) NA_real_ else x$end + }, FUN.VALUE = 0) + choices_df <- choices_df %>% left_join( metadata_nca_parameters %>% select(PPTESTCD, PPTEST) %>% distinct(), - by = "PPTESTCD" + by = c("base_pptestcd" = "PPTESTCD") + ) %>% + group_by(start_dose, end_dose, is_interval) %>% + mutate( + desc = if (is_interval[1] && !is.na(PPTEST[1])) { + label <- gsub("T1", as.character(start_dose[1]), PPTEST) + gsub("T2", as.character(end_dose[1]), label) + } else if (!is.na(PPTEST[1])) { + PPTEST + } else { + PPTESTCD + } ) %>% - mutate(desc = ifelse(is.na(PPTEST), PPTESTCD, PPTEST)) %>% + ungroup() %>% rename(val = PPTESTCD) } else { data.frame(val = choices, desc = choices) diff --git a/inst/shiny/modules/common/reactable.R b/inst/shiny/modules/common/reactable.R index e101b33be..928d2a0de 100644 --- a/inst/shiny/modules/common/reactable.R +++ b/inst/shiny/modules/common/reactable.R @@ -71,7 +71,7 @@ reactable_server <- function( labeled_data <- reactive({ req(data()) - apply_labels(data()) + resolve_param_labels(apply_labels(data())) }) output$table <- renderReactable({ diff --git a/tests/testthat/test-label_operators.R b/tests/testthat/test-label_operators.R index 852f6b8a2..4d28596b7 100644 --- a/tests/testthat/test-label_operators.R +++ b/tests/testthat/test-label_operators.R @@ -119,7 +119,7 @@ describe("add_label_attribute", { expect_equal(attr(df_result[["CMAX[ng/mL]"]], "label"), "Max Conc") expect_equal(attr(df_result[["TMAX[hr]"]], "label"), "Time of CMAX Observation") - expect_equal(attr(df_result[["AUCINT_0-2[hr*ng/mL]"]], "label"), "AUC from T1 to T2") + expect_equal(attr(df_result[["AUCINT_0-2[hr*ng/mL]"]], "label"), "AUC from 0 to 2") expect_null(attr(df_result[["RandomCol"]], "label")) }) @@ -143,7 +143,7 @@ describe("add_label_attribute", { df_result_mod <- add_label_attribute(df_input_mod, myres_mod) expect_equal(attr(df_result_mod[["CMAX"]], "label"), "Max Conc") - expect_equal(attr(df_result_mod[["AUCINT_0-2"]], "label"), "AUC from T1 to T2") + expect_equal(attr(df_result_mod[["AUCINT_0-2"]], "label"), "AUC from 0 to 2") }) it("handles manual intervals with NA PPSTRESU without appending NA to names", { @@ -175,7 +175,7 @@ describe("add_label_attribute", { `TLST[hr]` = "Time of Last Nonzero Conc", `CLST[ng/mL]` = "Last Nonzero Conc", `LAMZ[1/hr]` = "Lambda z", - `AUCINT_0-2[hr*ng/mL]` = "AUC from T1 to T2" + `AUCINT_0-2[hr*ng/mL]` = "AUC from 0 to 2" ) df_input <- as.data.frame(matrix(NA, ncol = length(expected_labels_map), nrow = 1)) @@ -190,3 +190,53 @@ describe("add_label_attribute", { )) }) }) + +describe("resolve_param_labels", { + it("resolves interval column with unit suffix to human-readable label", { + df <- data.frame(x = 1:2) + names(df) <- "AUCINT_0-12[hr*ng/mL]" + result <- resolve_param_labels(df) + expect_equal( + attr(result[["AUCINT_0-12[hr*ng/mL]"]], "label"), + "AUC from 0 to 12" + ) + }) + + it("resolves interval column without unit suffix", { + df <- data.frame(x = 1:2) + names(df) <- "AUCINT_0-24" + result <- resolve_param_labels(df) + expect_equal( + attr(result[["AUCINT_0-24"]], "label"), + "AUC from 0 to 24" + ) + }) + + it("resolves non-interval column to standard PPTEST label", { + df <- data.frame(x = 1:2) + names(df) <- "CMAX" + result <- resolve_param_labels(df) + expect_equal( + attr(result[["CMAX"]], "label"), + "Max Conc" + ) + }) + + it("preserves existing label on column", { + df <- data.frame(x = 1:2) + names(df) <- "AUCINT_0-12" + attr(df[["AUCINT_0-12"]], "label") <- "Custom Label" + result <- resolve_param_labels(df) + expect_equal( + attr(result[["AUCINT_0-12"]], "label"), + "Custom Label" + ) + }) + + it("does not set label for unrecognized column", { + df <- data.frame(x = 1:2) + names(df) <- "UNKNOWN_PARAM" + result <- resolve_param_labels(df) + expect_null(attr(result[["UNKNOWN_PARAM"]], "label")) + }) +}) diff --git a/tests/testthat/test-pivot_wider_pknca_results.R b/tests/testthat/test-pivot_wider_pknca_results.R index 25048be87..d6673cf29 100644 --- a/tests/testthat/test-pivot_wider_pknca_results.R +++ b/tests/testthat/test-pivot_wider_pknca_results.R @@ -206,8 +206,8 @@ describe("pivot_wider_pknca_results", { `LAMZHL[hr]` = "Half-Life Lambda z", `LAMZSPN` = "Lambda z Span", `AUCIFO[hr*ng/mL]` = "AUC Infinity Obs", - `AUCINT_0-2[hr*ng/mL]` = "AUC from T1 to T2", - `AUCINT_2-4[hr*ng/mL]` = "AUC from T1 to T2", + `AUCINT_0-2[hr*ng/mL]` = "AUC from 0 to 2", + `AUCINT_2-4[hr*ng/mL]` = "AUC from 2 to 4", `LAMZIX` = NA, `LAMZMTD` = NA, `Exclude` = NA ) expect_equal(labels, expected_labels)