feat: Analyte Comparison slides in PPT/QMD export

DESCRIPTION

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

NEWS.md

@@ -2,6 +2,7 @@
 
 ## Features added
 
+* Added "Analyte Comparison" slide type under Summary Slides in the export customisation modal. Generates mean plots faceted by DOSETRT × PARAM for both PPTX and QMD exports (#1174)
 * Added "Min. Points for Half-life" setting in NCA > Settings > General Settings, allowing users to configure PKNCA's `min.hl.points` option (range 2–10, default 3) (#1155)
 * Settings version control: single YAML file stores multiple versions with metadata (timestamp, comment, dataset, aNCA version, active tab). Save button in header, version selection modal on upload, version delete support (#1103)
 * Right-side sidebars (Exploration, NCA Parameter Plots, TLG) can now be resized by dragging the left edge. Default width increased to 250px, left nav sidebar reduced to 150px (#1156)

R/officer-utils.R

@@ -185,13 +185,19 @@ add_pptx_sl_plot <- function(pptx, plot) {
                             subtitle = paste(group_data$group)) %>%
     officer::ph_slidelink(ph_label = "Footer Placeholder 3", slide_index = (lst_group_slide + 1))
   pptx <- .add_pptx_main_summary_slide(pptx, group_data, i, in_sections)
+  # Analyte comparison slide (mean plot faceted by DOSETRT × PARAM)
+  has_analyte_cmp <- in_sections("analyte_comparison") && !is.null(group_data$analyte_comparison)
+  if (has_analyte_cmp) {
+    pptx <- add_pptx_sl_plot(pptx, group_data$analyte_comparison)
+  }
   pptx <- pptx %>% {
     if (in_sections("linplot")) add_pptx_sl_plot(., group_data$linplot) else .
   }
   bp_result <- .add_pptx_boxplot_slides(pptx, group_data, in_sections)
   pptx <- bp_result$pptx
   n_main_slides <- as.integer(in_sections("meanplot") || in_sections("statistics"))
-  n_summary_slides <- 1L + n_main_slides + as.integer(in_sections("linplot")) + bp_result$n_slides
+  n_summary_slides <- 1L + n_main_slides + as.integer(has_analyte_cmp) +
+    as.integer(in_sections("linplot")) + bp_result$n_slides
   list(pptx = pptx, n_summary_slides = n_summary_slides)
 }
 
@@ -211,7 +217,7 @@ add_pptx_sl_plot <- function(pptx, plot) {
   pptx <- ind_result$pptx
   n_ind_slides <- ind_result$n_slides
   has_summary <- in_sections("meanplot") || in_sections("statistics") ||
-    in_sections("linplot") || in_sections("boxplot")
+    in_sections("analyte_comparison") || in_sections("linplot") || in_sections("boxplot")
   if (has_summary) {
     summary_result <- .add_pptx_group_summary(pptx, group_data, i, in_sections, lst_group_slide)
     pptx <- summary_result$pptx

R/quarto-utils.R

@@ -160,6 +160,12 @@ add_qmd_sl_plot <- function(quarto_path, plot, use_plotly = FALSE) {
         use_plotly = use_plotly
       )
     }
+    if (in_sections("analyte_comparison") &&
+        !is.null(res_dose_slides[[i]]$analyte_comparison)) {
+      add_qmd_sl_plot(quarto_path = quarto_path,
+                      plot = paste0("res_dose_slides[[", i, "]]$analyte_comparison"),
+                      use_plotly = use_plotly)
+    }
     if (in_sections("linplot")) {
       add_qmd_sl_plot(quarto_path = quarto_path,
                       plot = paste0("res_dose_slides[[", i, "]]$linplot"),
@@ -260,7 +266,7 @@ create_qmd_dose_slides <- function(res_dose_slides, quarto_path, title, use_plot
 
   # Mean plot + statistics block
   has_summary <- in_sections("meanplot") || in_sections("statistics") ||
-    in_sections("linplot") || in_sections("boxplot")
+    in_sections("analyte_comparison") || in_sections("linplot") || in_sections("boxplot")
   has_individual <- in_sections("ind_plots") || in_sections("ind_params")
 
   if (has_summary) .add_qmd_summary_slides(quarto_path, res_dose_slides, in_sections, use_plotly)

inst/shiny/functions/zip-utils.R

@@ -183,6 +183,19 @@ get_dose_esc_results <- function(
       sd_max = TRUE
     )
 
+    # Analyte comparison: mean plot faceted by DOSETRT × PARAM
+    analyte_comparison_i <- exploration_meanplot(
+      pknca_data = o_nca_i$data,
+      color_by = group_by_vars,
+      facet_by = c("DOSETRT", analyte_col),
+      filtering_list = list(
+        PCSPEC = unique(d_conc_i[[pcspec_col]]),
+        ATPTREF = unique(d_conc_i[[profile_col]])
+      ),
+      ylog_scale = TRUE,
+      sd_max = TRUE
+    )
+
     stats_i <- calculate_summary_stats(
       data = merge(o_res_i, d_conc_i[, c(group_vars(o_nca), facet_vars)]),
       input_groups = facet_vars
@@ -262,6 +275,7 @@ get_dose_esc_results <- function(
     output_list[[paste0("Group_", i)]] <- list(
       linplot = linplot_i,
       meanplot = meanplot_i,
+      analyte_comparison = analyte_comparison_i,
       statistics = stats_i,
       boxplot = boxplots_i,
       info = info_i,

inst/shiny/modules/tab_nca/zip.R

@@ -56,10 +56,11 @@ zip_ui <- function(id) {
       id       = "summary",
       label    = "Summary Slides",
       sections = list(
-        list(id = "meanplot",   label = "Mean Plots"),
-        list(id = "linplot",    label = "Spaghetti / Group Plot"),
-        list(id = "boxplot",    label = "Box Plot"),
-        list(id = "statistics", label = "Summary Statistics")
+        list(id = "meanplot",            label = "Mean Plots"),
+        list(id = "analyte_comparison",  label = "Analyte Comparison"),
+        list(id = "linplot",             label = "Spaghetti / Group Plot"),
+        list(id = "boxplot",             label = "Box Plot"),
+        list(id = "statistics",          label = "Summary Statistics")
       )
     )
   )

tests/testthat/test-officer-utils.R

@@ -7,6 +7,7 @@ describe("create_pptx_dose_slides", {
       group = "A",
       statistics = data.frame(stat = "Mean", value = 1),
       meanplot = ggplot2::ggplot(),
+      analyte_comparison = ggplot2::ggplot(),
       linplot = ggplot2::ggplot(),
       boxplot = list(AUCIFO = ggplot2::ggplot()),
       ind_params = list(SUBJ01 = data.frame(param = "CMAX", value = 1)),
@@ -187,4 +188,59 @@ describe("create_pptx_dose_slides", {
 
     expect_lt(length(officer::read_pptx(out_one)), length(officer::read_pptx(out_both)))
   })
+
+  it("includes analyte comparison slide when analyte_comparison is in slide_sections", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c(
+      "meanplot", "analyte_comparison", "statistics", "ind_plots", "ind_params"
+    )
+    out_with <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides, out_with, "NCA", template)
+
+    slides_without <- base_slides
+    attr(slides_without, "slide_sections") <- c(
+      "meanplot", "statistics", "ind_plots", "ind_params"
+    )
+    out_without <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides_without, out_without, "NCA", template)
+
+    expect_gt(length(officer::read_pptx(out_with)), length(officer::read_pptx(out_without)))
+  })
+
+  it("omits analyte comparison slide when analyte_comparison is not in slide_sections", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c("meanplot", "statistics", "ind_plots", "ind_params")
+    out <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides, out, "NCA", template)
+
+    slides_with <- base_slides
+    attr(slides_with, "slide_sections") <- c(
+      "meanplot", "analyte_comparison", "statistics", "ind_plots", "ind_params"
+    )
+    out_with <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides_with, out_with, "NCA", template)
+
+    expect_lt(length(officer::read_pptx(out)), length(officer::read_pptx(out_with)))
+  })
+
+  it("includes analyte comparison slide when slide_sections is NULL (all selected)", {
+    out <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(base_slides, out, "NCA", template)
+
+    slides_no_ac <- base_slides
+    slides_no_ac[[1]]$analyte_comparison <- NULL
+    out_no_ac <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides_no_ac, out_no_ac, "NCA", template)
+
+    expect_gt(length(officer::read_pptx(out)), length(officer::read_pptx(out_no_ac)))
+  })
+
+  it("creates summary section when only analyte_comparison is selected", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c("analyte_comparison")
+    out <- tempfile(fileext = ".pptx")
+    create_pptx_dose_slides(slides, out, "NCA", template)
+    # Title slide + group info + analyte comparison + Extra Figures title = at least 4
+    expect_gte(length(officer::read_pptx(out)), 4)
+  })
 })

tests/testthat/test-quarto-utils.R

@@ -4,6 +4,7 @@ describe("create_qmd_dose_slides", {
       info = data.frame(group = "A"),
       statistics = data.frame(stat = "Mean", value = 1),
       meanplot = ggplot2::ggplot(),
+      analyte_comparison = ggplot2::ggplot(),
       linplot = ggplot2::ggplot(),
       boxplot = list(AUCIFO = ggplot2::ggplot()),
       ind_params = list(SUBJ01 = data.frame(param = "CMAX", value = 1)),
@@ -322,4 +323,47 @@ describe("create_qmd_dose_slides", {
     expect_true(grepl("Group 1 (Individual)", content, fixed = TRUE))
     expect_false(grepl("Group 2 (Individual)", content, fixed = TRUE))
   })
+
+  it("includes analyte_comparison expression when analyte_comparison is in slide_sections", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c("meanplot", "analyte_comparison", "statistics")
+    out_file <- tempfile(fileext = ".qmd")
+
+    create_qmd_dose_slides(slides, out_file, "NCA Results", use_plotly = FALSE)
+    content <- paste(readLines(out_file, warn = FALSE), collapse = "\n")
+
+    expect_true(grepl("analyte_comparison", content, fixed = TRUE))
+  })
+
+  it("omits analyte_comparison expression when analyte_comparison is not in slide_sections", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c("meanplot", "statistics", "ind_plots", "ind_params")
+    out_file <- tempfile(fileext = ".qmd")
+
+    create_qmd_dose_slides(slides, out_file, "NCA Results", use_plotly = FALSE)
+    content <- paste(readLines(out_file, warn = FALSE), collapse = "\n")
+
+    expect_false(grepl("analyte_comparison", content, fixed = TRUE))
+  })
+
+  it("includes analyte_comparison when slide_sections is NULL (all selected)", {
+    out_file <- tempfile(fileext = ".qmd")
+    create_qmd_dose_slides(base_slides, out_file, "NCA Results", use_plotly = FALSE)
+    content <- paste(readLines(out_file, warn = FALSE), collapse = "\n")
+
+    expect_true(grepl("analyte_comparison", content, fixed = TRUE))
+  })
+
+  it("creates summary section when only analyte_comparison is selected", {
+    slides <- base_slides
+    attr(slides, "slide_sections") <- c("analyte_comparison")
+    out_file <- tempfile(fileext = ".qmd")
+
+    create_qmd_dose_slides(slides, out_file, "NCA Results", use_plotly = FALSE)
+    content <- paste(readLines(out_file, warn = FALSE), collapse = "\n")
+
+    expect_true(grepl("analyte_comparison", content, fixed = TRUE))
+    expect_true(grepl("# Group 1", content, fixed = TRUE))
+    expect_false(grepl("meanplot", content, fixed = TRUE))
+  })
 })