diff --git a/DESCRIPTION b/DESCRIPTION index 34f69e952..b13840286 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: aNCA Title: (Pre-)Clinical NCA in a Dynamic Shiny App -Version: 0.1.0.9177 +Version: 0.1.0.9178 Authors@R: c( person("Ercan", "Suekuer", email = "ercan.suekuer@roche.com", role = "aut", comment = c(ORCID = "0009-0001-1626-1526")), diff --git a/NEWS.md b/NEWS.md index da055c698..c018fbb45 100644 --- a/NEWS.md +++ b/NEWS.md @@ -45,6 +45,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 (#1326) * 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) diff --git a/R/officer-utils.R b/R/officer-utils.R index 28e54f0ab..17a322354 100644 --- a/R/officer-utils.R +++ b/R/officer-utils.R @@ -31,9 +31,11 @@ add_pptx_sl_title <- function(pptx, title) { #' @param plot ggplot object to show as plot #' @returns rpptx object with slide added add_pptx_sl_plottable <- function(pptx, df, plot) { + ft <- flextable::flextable(df, cwidth = 1) %>% + flextable::fontsize(size = 9, part = "all") officer::add_slide(pptx, layout = "Content with Caption") %>% officer::ph_with(value = plot, location = "Content Placeholder 1") %>% - officer::ph_with(value = flextable::flextable(df, cwidth = 1), location = "Table Placeholder 1") + officer::ph_with(value = ft, location = "Table Placeholder 1") } #' Add a slide with a table only @@ -56,6 +58,7 @@ add_pptx_sl_table <- function(pptx, df, title = "", # Set flextable to autofit and center for better appearance ft <- flextable::flextable(df) %>% + flextable::fontsize(size = 9, part = "all") %>% flextable::autofit() officer::add_slide(pptx, layout = "Title Only") %>% @@ -310,6 +313,131 @@ 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 8. +#' @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 = 8L) { + if (nrow(glossary) == 0) return(list(pptx = pptx, n_slides = 0L)) + + # Position table closer to the title than the default template placeholder, + # horizontally centered on the 10" slide + table_loc <- officer::ph_location( + left = 1.85, top = 1.2, width = 6.3, height = 3.8 + ) + + 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" + } + + title_formatted <- officer::fpar( + officer::ftext(page_label), + fp_p = officer::fp_par(text.align = "center", line_spacing = 1) + ) + ft <- flextable::flextable(chunks[[i]]) %>% + flextable::fontsize(size = 9, part = "all") %>% + flextable::autofit() + + pptx <- officer::add_slide(pptx, layout = "Title Only") %>% + officer::ph_with(value = ft, location = table_loc) %>% + officer::ph_with(value = title_formatted, location = "Title 1") %>% + officer::ph_with(value = "", location = "Footer Placeholder 3") + } + 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 +462,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 +479,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) diff --git a/tests/testthat/test-officer-utils.R b/tests/testthat/test-officer-utils.R index 63efdae02..2ee09d796 100644 --- a/tests/testthat/test-officer-utils.R +++ b/tests/testthat/test-officer-utils.R @@ -265,3 +265,193 @@ describe(".add_pptx_dose_norm_slide", { expect_equal(result$n_slides, 0L) }) }) + +describe("add_pptx_sl_plottable", { + template <- system.file("www/templates/template.pptx", package = "aNCA") + + it("adds a slide with plot and table", { + pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template) + initial_count <- length(pptx) + df <- data.frame(A = 1, B = 2) + p <- ggplot2::ggplot() + pptx <- add_pptx_sl_plottable(pptx, df, p) + expect_equal(length(pptx), initial_count + 1) + }) +}) + +describe("add_pptx_sl_table", { + template <- system.file("www/templates/template.pptx", package = "aNCA") + + it("adds a slide with a table and title", { + pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template) + initial_count <- length(pptx) + df <- data.frame(Param = "CMAX", Value = 42) + pptx <- add_pptx_sl_table(pptx, df, title = "Summary") + expect_equal(length(pptx), initial_count + 1) + }) + + it("uses default footer when none specified", { + pptx <- create_pptx_doc(tempfile(fileext = ".pptx"), "Test", template) + df <- data.frame(X = 1) + pptx <- add_pptx_sl_table(pptx, df) + summary <- officer::slide_summary(pptx, 2) + expect_true(any(grepl("individual results", summary$text))) + }) +}) + +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))) + }) +})