fix: resolve interval parameter show raw PPTESTCDs instead of labels in NCA results #1305

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)

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 {

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)

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

R/zzz.R

@@ -82,6 +82,7 @@
     "PPTEST",
     "PPTESTCD",
     "PPTESTCD_cdisc",
+    "PPTESTCD_cdisc_raw",
     "PPTESTCD_ref",
     "PPTESTCD_unit",
     "PPSUMFL",

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)

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({

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"))
+  })
+})

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)