feat: add PPTESTCD glossary slide to PowerPoint export

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: aNCA
 Title: (Pre-)Clinical NCA in a Dynamic Shiny App
-Version: 0.1.0.9173
+Version: 0.1.0.9174
 Authors@R: c(
     person("Ercan", "Suekuer", email = "ercan.suekuer@roche.com", role = "aut",
            comment = c(ORCID = "0009-0001-1626-1526")),

NEWS.md

@@ -41,6 +41,7 @@
 * Right-side sidebars resizable by dragging; default width 250px (#1156)
 
 ### Export & Output
+* PowerPoint export includes a PPTESTCD glossary slide after the title slide, listing all PK parameter codes and their full names (#1325)
 * General button at top of page to save all NCA results, settings, and draft slides as a ZIP file (#638)
 * Dose-normalised summary slides added to PPT/QMD export, controlled via Customise Slides modal (#1054)
 * Export modal allows selecting which slide sections to include in PPTX/HTML exports (#972)

R/officer-utils.R

@@ -310,6 +310,113 @@ add_pptx_sl_plot <- function(pptx, plot) {
   list(pptx = pptx, lst_group_slide = lst_group_slide, group_slides = group_slides)
 }
 
+#' Collect all unique PPTESTCDs used across dose group slide data
+#'
+#' Extracts PPTESTCDs from statistics tables (column names), individual
+#' parameter tables (column names), and boxplot names.
+#'
+#' @param res_dose_slides List of dose group results as produced by
+#'   `get_dose_esc_results()`.
+#' @returns Character vector of unique PPTESTCDs.
+#' @keywords internal
+#' @noRd
+.collect_pptestcds <- function(res_dose_slides) {
+  codes <- unlist(lapply(res_dose_slides, .extract_group_codes), use.names = FALSE)
+  unique(as.character(codes))
+}
+
+#' Extract PPTESTCDs from a single dose group's slide data
+#' @param group A single element of res_dose_slides.
+#' @returns Character vector of PPTESTCDs (may contain duplicates).
+#' @keywords internal
+#' @noRd
+.extract_group_codes <- function(group) {
+  codes <- character(0)
+  # Statistics table columns: "PPTESTCD[unit]" or plain "PPTESTCD"
+  for (tbl_name in c("statistics", "dose_norm_statistics")) {
+    codes <- c(codes, .codes_from_df(group[[tbl_name]]))
+  }
+  # Individual parameter tables: same column format
+  if (is.list(group$ind_params)) {
+    codes <- c(codes, unlist(lapply(group$ind_params, .codes_from_df), use.names = FALSE))
+  }
+  # Boxplot names are PPTESTCDs directly
+  if (is.list(group$boxplot)) {
+    codes <- c(codes, names(group$boxplot))
+  }
+  codes
+}
+
+#' Extract PPTESTCDs from data frame column names by stripping unit suffixes
+#' @param tbl A data frame or NULL.
+#' @returns Character vector of codes, or empty character.
+#' @keywords internal
+#' @noRd
+.codes_from_df <- function(tbl) {
+  if (!is.data.frame(tbl) || ncol(tbl) == 0) return(character(0))
+  gsub("\\[.*\\]$", "", names(tbl))
+}
+
+#' Build a glossary data frame of PPTESTCD to PPTEST mappings
+#'
+#' Uses `translate_terms()` to look up PPTEST for each PPTESTCD. Codes in
+#' `metadata_nca_parameters` get their proper label; codes not in metadata
+#' (e.g. custom ratio PPTESTCDs) are kept with the code itself as the label.
+#' Non-parameter column names (where PPTESTCD == PPTEST and not in metadata)
+#' are excluded.
+#'
+#' @param pptestcds Character vector of PPTESTCDs to include.
+#' @returns A data frame with columns `PPTESTCD` and `PPTEST`, sorted by
+#'   PPTESTCD.
+#' @keywords internal
+#' @noRd
+.build_glossary <- function(pptestcds) {
+  pptestcds <- unique(pptestcds)
+  pptest <- translate_terms(pptestcds, mapping_col = "PPTESTCD", target_col = "PPTEST")
+  known_codes <- metadata_nca_parameters$PPTESTCD
+  # Keep codes that are in metadata OR where translate_terms changed the value
+  # (custom codes not in metadata get themselves back — keep them too)
+  is_known <- pptestcds %in% known_codes
+  is_translated <- pptestcds != pptest
+  keep <- is_known | is_translated
+  glossary <- data.frame(
+    PPTESTCD = pptestcds[keep],
+    PPTEST = pptest[keep],
+    stringsAsFactors = FALSE
+  )
+  glossary <- glossary[order(glossary$PPTESTCD), ]
+  rownames(glossary) <- NULL
+  glossary
+}
+
+#' Add glossary slides to a PowerPoint presentation
+#'
+#' Inserts one or more slides with a two-column table (PPTESTCD, PPTEST)
+#' listing all PK parameters used in the presentation. Splits across
+#' multiple slides when the table exceeds `max_rows` per slide.
+#'
+#' @param pptx An officer rpptx object.
+#' @param glossary A data frame with columns `PPTESTCD` and `PPTEST`.
+#' @param max_rows Maximum rows per glossary slide. Default 20.
+#' @returns A list with `pptx` (updated rpptx object) and `n_slides`
+#'   (number of glossary slides added).
+#' @keywords internal
+#' @noRd
+.add_pptx_glossary_slides <- function(pptx, glossary, max_rows = 20L) {
+  if (nrow(glossary) == 0) return(list(pptx = pptx, n_slides = 0L))
+
+  chunks <- split(glossary, ceiling(seq_len(nrow(glossary)) / max_rows))
+  for (i in seq_along(chunks)) {
+    page_label <- if (length(chunks) > 1) {
+      paste0("Glossary (", i, "/", length(chunks), ")")
+    } else {
+      "Glossary"
+    }
+    pptx <- add_pptx_sl_table(pptx, chunks[[i]], title = page_label, footer = "")
+  }
+  list(pptx = pptx, n_slides = length(chunks))
+}
+
 #' Create a PowerPoint presentation with dose escalation results, including main and extra figures
 #' Adds slides for summary tables, mean plots, line plots, and individual subject results
 #' @param res_dose_slides List of results for each dose group
@@ -334,7 +441,14 @@ create_pptx_dose_slides <- function(res_dose_slides, path, title, template) {
 
   pptx <- create_pptx_doc(path, title, template)
 
-  lst_group_slide <- 1
+  # Insert glossary slide(s) after the title slide
+  all_codes <- .collect_pptestcds(res_dose_slides)
+  glossary <- .build_glossary(all_codes)
+  glossary_result <- .add_pptx_glossary_slides(pptx, glossary)
+  pptx <- glossary_result$pptx
+  n_glossary_slides <- glossary_result$n_slides
+
+  lst_group_slide <- 1 + n_glossary_slides
   group_slides <- numeric()
   for (i in seq_along(res_dose_slides)) {
     result <- .process_pptx_group_slides(pptx, res_dose_slides[[i]], i, in_sections,
@@ -344,16 +458,23 @@ create_pptx_dose_slides <- function(res_dose_slides, path, title, template) {
     group_slides    <- result$group_slides
   }
 
+  # Move summary slides to just after title + glossary
+  first_content_pos <- 2L + n_glossary_slides
   if (length(group_slides) > 0) {
     group_slides_rev <- rev(group_slides) + (seq_along(group_slides) - 1)
     pptx <- purrr::reduce(
       group_slides_rev,
-      function(pptx, slide_index) officer::move_slide(pptx, index = slide_index, to = 2),
+      function(pptx, slide_index) {
+        officer::move_slide(pptx, index = slide_index, to = first_content_pos)
+      },
       .init = pptx
     )
   }
   pptx <- add_pptx_sl_title(pptx, "Extra Figures")
-  pptx <- officer::move_slide(x = pptx, index = length(pptx), to = (length(group_slides) + 2))
+  pptx <- officer::move_slide(
+    x = pptx, index = length(pptx),
+    to = (length(group_slides) + first_content_pos)
+  )
 
   # Add additional analysis slides generically
   non_empty <- .filter_additional_analysis(additional_analysis, slide_sections)

tests/testthat/test-officer-utils.R

@@ -265,3 +265,160 @@ describe(".add_pptx_dose_norm_slide", {
     expect_equal(result$n_slides, 0L)
   })
 })
+
+describe(".collect_pptestcds", {
+  it("extracts PPTESTCDs from statistics column names", {
+    slides <- list(list(
+      statistics = data.frame(
+        Statistic = "Mean",
+        `AUCIFO[ng*hr/mL]` = 1, `CMAX[ng/mL]` = 2, check.names = FALSE
+      ),
+      ind_params = list(),
+      boxplot = list()
+    ))
+    codes <- .collect_pptestcds(slides)
+    expect_true("AUCIFO" %in% codes)
+    expect_true("CMAX" %in% codes)
+    expect_true("Statistic" %in% codes)
+  })
+
+  it("extracts PPTESTCDs from ind_params column names", {
+    slides <- list(list(
+      statistics = data.frame(),
+      ind_params = list(
+        SUBJ01 = data.frame(
+          USUBJID = "01", `LAMZHL[hr]` = 5, check.names = FALSE
+        )
+      ),
+      boxplot = list()
+    ))
+    codes <- .collect_pptestcds(slides)
+    expect_true("LAMZHL" %in% codes)
+  })
+
+  it("extracts PPTESTCDs from boxplot names", {
+    slides <- list(list(
+      statistics = data.frame(),
+      ind_params = list(),
+      boxplot = list(AUCIFO = ggplot2::ggplot(), CMAX = NULL)
+    ))
+    codes <- .collect_pptestcds(slides)
+    expect_true("AUCIFO" %in% codes)
+    expect_true("CMAX" %in% codes)
+  })
+
+  it("deduplicates across groups", {
+    slides <- list(
+      list(
+        statistics = data.frame(`CMAX[ng/mL]` = 1, check.names = FALSE),
+        ind_params = list(),
+        boxplot = list(CMAX = ggplot2::ggplot())
+      ),
+      list(
+        statistics = data.frame(`CMAX[ng/mL]` = 2, check.names = FALSE),
+        ind_params = list(),
+        boxplot = list()
+      )
+    )
+    codes <- .collect_pptestcds(slides)
+    expect_equal(sum(codes == "CMAX"), 1)
+  })
+
+  it("returns empty character for empty input", {
+    expect_equal(.collect_pptestcds(list()), character(0))
+  })
+})
+
+describe(".build_glossary", {
+  it("returns matching PPTESTCD/PPTEST pairs from metadata", {
+    glossary <- .build_glossary(c("CMAX", "AUCIFO"))
+    expect_equal(ncol(glossary), 2)
+    expect_equal(names(glossary), c("PPTESTCD", "PPTEST"))
+    expect_true("CMAX" %in% glossary$PPTESTCD)
+    expect_true("AUCIFO" %in% glossary$PPTESTCD)
+  })
+
+  it("excludes non-parameter column names not in metadata", {
+    glossary <- .build_glossary(c("CMAX", "Statistic", "USUBJID"))
+    expect_true("CMAX" %in% glossary$PPTESTCD)
+    expect_false("Statistic" %in% glossary$PPTESTCD)
+    expect_false("USUBJID" %in% glossary$PPTESTCD)
+  })
+
+  it("returns sorted, deduplicated rows", {
+    glossary <- .build_glossary(c("LAMZHL", "AUCIFO", "CMAX", "AUCIFO"))
+    expect_equal(glossary$PPTESTCD, sort(glossary$PPTESTCD))
+    expect_equal(nrow(glossary), length(unique(glossary$PPTESTCD)))
+  })
+
+  it("returns empty data frame when no codes match metadata", {
+    glossary <- .build_glossary(c("Statistic", "USUBJID"))
+    expect_equal(nrow(glossary), 0)
+  })
+})
+
+describe(".add_pptx_glossary_slides", {
+  template <- system.file("www/templates/template.pptx", package = "aNCA")
+
+  it("adds one slide for a small glossary", {
+    pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template)
+    initial_count <- length(pptx)
+    glossary <- data.frame(
+      PPTESTCD = c("CMAX", "AUCIFO"),
+      PPTEST = c("Max Concentration", "AUC Infinity Obs"),
+      stringsAsFactors = FALSE
+    )
+    result <- .add_pptx_glossary_slides(pptx, glossary)
+    expect_equal(length(result$pptx), initial_count + 1)
+    expect_equal(result$n_slides, 1L)
+  })
+
+  it("adds multiple slides when glossary exceeds max_rows", {
+    pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template)
+    initial_count <- length(pptx)
+    glossary <- data.frame(
+      PPTESTCD = paste0("CODE", seq_len(25)),
+      PPTEST = paste0("Description ", seq_len(25)),
+      stringsAsFactors = FALSE
+    )
+    result <- .add_pptx_glossary_slides(pptx, glossary, max_rows = 10)
+    expect_equal(length(result$pptx), initial_count + 3)
+    expect_equal(result$n_slides, 3L)
+  })
+
+  it("does not add slides for empty glossary", {
+    pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template)
+    initial_count <- length(pptx)
+    glossary <- data.frame(
+      PPTESTCD = character(0), PPTEST = character(0),
+      stringsAsFactors = FALSE
+    )
+    result <- .add_pptx_glossary_slides(pptx, glossary)
+    expect_equal(length(result$pptx), initial_count)
+    expect_equal(result$n_slides, 0L)
+  })
+})
+
+describe("create_pptx_dose_slides glossary integration", {
+  template <- system.file("www/templates/template.pptx", package = "aNCA")
+
+  it("includes glossary slide in the output", {
+    slides <- list(list(
+      info = data.frame(group = "A"),
+      group = "A",
+      statistics = data.frame(
+        Statistic = "Mean", `CMAX[ng/mL]` = 1, check.names = FALSE
+      ),
+      meanplot = ggplot2::ggplot(),
+      linplot = ggplot2::ggplot(),
+      boxplot = list(CMAX = ggplot2::ggplot()),
+      ind_params = list(SUBJ01 = data.frame(param = "CMAX", value = 1)),
+      ind_plots = list(SUBJ01 = ggplot2::ggplot())
+    ))
+    out <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides, out, "NCA", template)
+    pptx <- officer::read_pptx(out)
+    slide_summaries <- officer::slide_summary(pptx, 2)
+    expect_true(any(grepl("Glossary", slide_summaries$text)))
+  })
+})