From bdc1205de75692f8adde10002141e2d0dd474e2a Mon Sep 17 00:00:00 2001 From: Sean Thimons Date: Wed, 28 Oct 2026 13:59:31 +0000 Subject: [PATCH] feat(plot): add 3-row outcome option and batch render for preferred-model overview Adds --outcomes=3 to merge infection and detection into one outcome row (default stays four), scales plot height with the number of outcome rows, documents each facet mode, and adds a script that renders every variant into dev/preferred-models. Cherry-picked from d10bcee without its uat/ PNGs. --- data-raw/plot-preferred-models-all.sh | 12 ++++++++++++ data-raw/plot-preferred-models.R | 25 +++++++++++++++++++------ 2 files changed, 31 insertions(+), 6 deletions(-) create mode 100755 data-raw/plot-preferred-models-all.sh diff --git a/data-raw/plot-preferred-models-all.sh b/data-raw/plot-preferred-models-all.sh new file mode 100755 index 0000000..068b6c3 --- /dev/null +++ b/data-raw/plot-preferred-models-all.sh @@ -0,0 +1,12 @@ +#!/usr/bin/env bash +# Render every preferred-model overview variant: data-raw/plot-preferred-models-all.sh workbook.xlsx out_dir +set -euo pipefail +w=$1; out=${2:-dev/preferred-models}; mkdir -p "$out" +r() { Rscript data-raw/plot-preferred-models.R "$w" "$out/$1.png" "${@:2}"; } +r 01-all-pathogens +for n in 3 4; do + r "02-by-outcome-$n" --facet-outcome --outcomes=$n + r "03-group-x-outcome-$n" --facet-group-outcome --outcomes=$n + r "04-taxa-x-outcome-$n" --facet-taxa-outcome --outcomes=$n + r "05-taxa-by-genus-$n" --facet-taxa-genus --outcomes=$n +done diff --git a/data-raw/plot-preferred-models.R b/data-raw/plot-preferred-models.R index 48320a8..28d849f 100644 --- a/data-raw/plot-preferred-models.R +++ b/data-raw/plot-preferred-models.R @@ -1,9 +1,17 @@ # Run from the package root: -# Rscript data-raw/plot-preferred-models.R workbook.xlsx overview.png [--facet-outcome | --facet-group-outcome | --facet-taxa-outcome | --facet-taxa-genus] +# Rscript data-raw/plot-preferred-models.R workbook.xlsx overview.png [facet-mode] [--outcomes=3] +# facet-mode (optional, one of): +# --facet-outcome outcome rows only +# --facet-group-outcome outcome rows x pathogen group columns +# --facet-taxa-outcome outcome rows x bacterial taxa split + other groups +# --facet-taxa-genus as above, coloured by genus +# --outcomes=3 uses the original three outcome rows (infection or detection merged); default is four (--outcomes=4). args <- commandArgs(trailingOnly = TRUE) modes <- c("--facet-outcome", "--facet-group-outcome", "--facet-taxa-outcome", "--facet-taxa-genus") +three_outcomes <- "--outcomes=3" %in% args +args <- setdiff(args, c("--outcomes=3", "--outcomes=4")) if (length(args) < 2L || length(args) > 3L || (length(args) == 3L && !args[[3L]] %in% modes)) { - stop("Supply the workbook and output PNG paths, optionally followed by --facet-outcome --facet-group-outcome, --facet-taxa-outcome, or --facet-taxa-genus.") + stop("Usage: workbook.xlsx output.png [", paste(modes, collapse = " | "), "] [--outcomes=3]") } mode <- if (length(args) == 3L) args[[3L]] else "" facet_outcome <- mode == "--facet-outcome" @@ -78,11 +86,16 @@ if (any(!is.finite(curves$estimate))) stop("A curve contains invalid probabiliti outcome <- tolower(curves$outcome) curves$outcome_group <- dplyr::case_when( grepl("death|mortality|stillbirth", outcome) ~ "Death or mortality", - grepl("culture|isolation|shedding", outcome) ~ "Detection or shedding", - grepl("infection|invasion|antibody", outcome) ~ "Infection", + grepl("culture|isolation|shedding", outcome) ~ if (three_outcomes) "Infection or detection" else "Detection or shedding", + grepl("infection|invasion|antibody", outcome) ~ if (three_outcomes) "Infection or detection" else "Infection", TRUE ~ "Illness or clinical signs" ) -curves$outcome_group <- factor(curves$outcome_group, levels = c("Infection", "Detection or shedding", "Illness or clinical signs", "Death or mortality")) +outcome_levels <- if (three_outcomes) { + c("Infection or detection", "Illness or clinical signs", "Death or mortality") +} else { + c("Infection", "Detection or shedding", "Illness or clinical signs", "Death or mortality") +} +curves$outcome_group <- factor(curves$outcome_group, levels = outcome_levels) curves$genus <- sub("\\s.*$", "", curves$pathogen) if (facet_taxa) { # ponytail: hand-mapped genus -> panel; unmapped bacteria land in "Other bacteria" (swap for NCBI via taxizedb if the list grows). @@ -128,7 +141,7 @@ plot <- ggplot2::ggplot(curves, ggplot2::aes(x = .data$dose, y = .data$estimate, if (facet_outcome) plot <- plot + ggplot2::facet_wrap(ggplot2::vars(.data$outcome_group), ncol = 1) if (facet_grid) plot <- plot + ggplot2::facet_grid(rows = ggplot2::vars(.data$outcome_group), cols = ggplot2::vars(.data$group), labeller = ggplot2::labeller(group = ggplot2::label_wrap_gen(14))) -ggplot2::ggsave(args[[2L]], plot, width = if (facet_taxa) 15 else if (facet_grid) 12 else 10, height = if (facet_grid) 14 else if (facet_outcome) 11 else 6, dpi = 160) +ggplot2::ggsave(args[[2L]], plot, width = if (facet_taxa) 15 else if (facet_grid) 12 else 10, height = if (facet_grid) 3.5 * length(outcome_levels) else if (facet_outcome) 2.75 * length(outcome_levels) else 6, dpi = 160) cat(sprintf("Plotted %d of %d experiments.\n", length(unique(curves$study_key)), length(experiments))) print(table(curves$source[!duplicated(curves$study_key)])) print(table(curves$outcome_group[!duplicated(curves$study_key)]))