From fce7433903c645ed147c83669585a3dfc69d753f Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 15:41:02 +0300 Subject: [PATCH 01/12] Add dots argument to ppc_km_overlay --- R/ppc-censoring.R | 56 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 50 insertions(+), 6 deletions(-) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index bcca33d6..eaba62e3 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -103,6 +103,7 @@ ppc_km_overlay <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, + dots = FALSE, size = 0.25, alpha = 0.7 ) { @@ -171,10 +172,14 @@ ppc_km_overlay <- function( fsf$group <- as.factor(sapply(strata_split, "[[", 2)) } - fsf$is_y_color <- as.factor(sub("\\[rep\\] \\(.*$", "rep", sub("^italic\\(y\\)", "y", fsf$strata))) + #fsf$is_y_color <- as.factor(sub("\\[rep\\] \\(.*$", "rep", sub("^italic\\(y\\)", "y", fsf$strata))) + is_replicate <- grepl("\\[rep\\]", as.character(fsf$strata)) + fsf$is_y_color <- ifelse(is_replicate, "yrep", "y") fsf$is_y_linewidth <- ifelse(fsf$is_y_color == "yrep", size, 1) fsf$is_y_alpha <- ifelse(fsf$is_y_color == "yrep", alpha, 1) + fsf$censor_mark <- ifelse(fsf$is_y_color == "y" & fsf$n.censor > 0, "Censored", NA) + max_time_y <- max(y, na.rm = TRUE) fsf <- fsf %>% dplyr::filter(.data$is_y_color != "yrep" | .data$time <= max_time_y * extrapolation_factor) @@ -183,14 +188,35 @@ ppc_km_overlay <- function( # levels of the factor "strata" fsf$strata <- factor(fsf$strata, levels = rev(levels(fsf$strata))) - ggplot(data = fsf, + p <- ggplot(data = fsf, mapping = aes(x = .data$time, y = .data$surv, color = .data$is_y_color, group = .data$strata, linewidth = .data$is_y_linewidth, - alpha = .data$is_y_alpha)) + - geom_step() + + alpha = .data$is_y_alpha)) + + if (dots) { + p <- p + + # Bottom layer: yrep step curves + geom_step(data = function(x) dplyr::filter(x, .data$is_y_color == "yrep")) + + # Top layer: y points + geom_point(data = function(x) dplyr::filter(x, .data$is_y_color == "y" & .data$n.event > 0), + size = 1.5) + + # Top layer 2: y points strictly at censoring times (e.g., plus signs) + geom_point(data = function(x) dplyr::filter(x, .data$is_y_color == "y" & .data$n.censor > 0), + mapping = aes(shape = .data$censor_mark), + size = 1.5, + stroke = 1) + } else { + p <- p + + # Bottom layer: yrep step curves + geom_step(data = function(x) dplyr::filter(x, .data$is_y_color == "yrep")) + + # Top layer: y step curves + geom_step(data = function(x) dplyr::filter(x, .data$is_y_color == "y")) + } + + p + hline_at( 0.5, linewidth = 0.1, @@ -205,13 +231,31 @@ ppc_km_overlay <- function( ) + scale_linewidth_identity() + scale_alpha_identity() + - scale_color_ppc() + + scale_color_manual( + name = NULL, + values = c("y" = get_color("dh"), "yrep" = get_color("lh")), + labels = c("y" = expression(italic(y)[obs]), + "yrep" = expression(italic(y)[rep])) + ) + + scale_shape_manual( + name = NULL, + values = c("Censored" = 3), + labels = c("Censored" = expression(italic(y)[cens])), + na.translate = FALSE + ) + + # Force the censored sign in the legend to be the dark observation color + guides( + shape = guide_legend(override.aes = list(color = get_color("dh"))) + ) + scale_y_continuous(breaks = c(0, 0.5, 1)) + xlab(y_label()) + yaxis_title(FALSE) + xaxis_title(FALSE) + yaxis_ticks(FALSE) + - bayesplot_theme_get() + bayesplot_theme_get() + + theme( + legend.spacing.y = unit(-10, "pt") + ) } #' @export From 4759a70add1e41b19707e35f81ecea5e6478e07b Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 17:09:52 +0300 Subject: [PATCH 02/12] Change dots argument to draws in ppc_km_overlay() and fix warning --- R/ppc-censoring.R | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index eaba62e3..ed016c2f 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -103,7 +103,7 @@ ppc_km_overlay <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, - dots = FALSE, + ydraw = "lines", size = 0.25, alpha = 0.7 ) { @@ -133,6 +133,10 @@ ppc_km_overlay <- function( )) } + if (ydraw != "lines" && ydraw != "points") { + abort("`ydraw` must be equal to \"lines\" or \"points\".") + } + data <- ppc_data(y, yrep, group = status_y) # Modify the status indicator: @@ -172,7 +176,6 @@ ppc_km_overlay <- function( fsf$group <- as.factor(sapply(strata_split, "[[", 2)) } - #fsf$is_y_color <- as.factor(sub("\\[rep\\] \\(.*$", "rep", sub("^italic\\(y\\)", "y", fsf$strata))) is_replicate <- grepl("\\[rep\\]", as.character(fsf$strata)) fsf$is_y_color <- ifelse(is_replicate, "yrep", "y") fsf$is_y_linewidth <- ifelse(fsf$is_y_color == "yrep", size, 1) @@ -196,14 +199,14 @@ ppc_km_overlay <- function( linewidth = .data$is_y_linewidth, alpha = .data$is_y_alpha)) - if (dots) { + if (ydraw == "points") { p <- p + # Bottom layer: yrep step curves geom_step(data = function(x) dplyr::filter(x, .data$is_y_color == "yrep")) + # Top layer: y points geom_point(data = function(x) dplyr::filter(x, .data$is_y_color == "y" & .data$n.event > 0), size = 1.5) + - # Top layer 2: y points strictly at censoring times (e.g., plus signs) + # Top layer 2: y plus signs at censoring times geom_point(data = function(x) dplyr::filter(x, .data$is_y_color == "y" & .data$n.censor > 0), mapping = aes(shape = .data$censor_mark), size = 1.5, @@ -237,16 +240,21 @@ ppc_km_overlay <- function( labels = c("y" = expression(italic(y)[obs]), "yrep" = expression(italic(y)[rep])) ) + - scale_shape_manual( - name = NULL, - values = c("Censored" = 3), - labels = c("Censored" = expression(italic(y)[cens])), - na.translate = FALSE - ) + - # Force the censored sign in the legend to be the dark observation color - guides( - shape = guide_legend(override.aes = list(color = get_color("dh"))) - ) + + # Conditionally add shape scale and guide ONLY if drawing points AND censored data exists + (if (ydraw == "points" && any(fsf$is_y_color == "y" & fsf$n.censor > 0, na.rm = TRUE)) { + list( + scale_shape_manual( + name = NULL, + values = c("Censored" = 3), + labels = c("Censored" = expression(italic(y)[cens])), + na.translate = FALSE + ), + # Force the censored sign in the legend to be the dark observation color + guides( + shape = guide_legend(override.aes = list(color = get_color("dh"))) + ) + ) + }) + scale_y_continuous(breaks = c(0, 0.5, 1)) + xlab(y_label()) + yaxis_title(FALSE) + @@ -254,7 +262,7 @@ ppc_km_overlay <- function( yaxis_ticks(FALSE) + bayesplot_theme_get() + theme( - legend.spacing.y = unit(-10, "pt") + legend.spacing.y = unit(-13, "pt") ) } From f291a99095b70273af49be8d1de333b0f4ffb90c Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 19:27:12 +0300 Subject: [PATCH 03/12] Add tests for ppc_km_overlay points feature --- R/ppc-censoring.R | 14 +- ...m-overlay-points-observed-and-censored.svg | 155 ++++++++++++++++++ .../ppc-km-overlay-points-only-observed.svg | 124 ++++++++++++++ tests/testthat/data-for-ppc-tests.R | 1 + tests/testthat/test-ppc-censoring.R | 30 +++- 5 files changed, 315 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg create mode 100644 tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index ed016c2f..9f248bd4 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -103,7 +103,7 @@ ppc_km_overlay <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, - ydraw = "lines", + y_draw = "lines", size = 0.25, alpha = 0.7 ) { @@ -133,8 +133,8 @@ ppc_km_overlay <- function( )) } - if (ydraw != "lines" && ydraw != "points") { - abort("`ydraw` must be equal to \"lines\" or \"points\".") + if (y_draw != "lines" && y_draw != "points") { + abort("`y_draw` must be equal to \"lines\" or \"points\".") } data <- ppc_data(y, yrep, group = status_y) @@ -199,7 +199,7 @@ ppc_km_overlay <- function( linewidth = .data$is_y_linewidth, alpha = .data$is_y_alpha)) - if (ydraw == "points") { + if (y_draw == "points") { p <- p + # Bottom layer: yrep step curves geom_step(data = function(x) dplyr::filter(x, .data$is_y_color == "yrep")) + @@ -237,11 +237,11 @@ ppc_km_overlay <- function( scale_color_manual( name = NULL, values = c("y" = get_color("dh"), "yrep" = get_color("lh")), - labels = c("y" = expression(italic(y)[obs]), + labels = c("y" = expression(italic(y)), "yrep" = expression(italic(y)[rep])) ) + # Conditionally add shape scale and guide ONLY if drawing points AND censored data exists - (if (ydraw == "points" && any(fsf$is_y_color == "y" & fsf$n.censor > 0, na.rm = TRUE)) { + (if (y_draw == "points" && any(fsf$is_y_color == "y" & fsf$n.censor > 0, na.rm = TRUE)) { list( scale_shape_manual( name = NULL, @@ -262,7 +262,7 @@ ppc_km_overlay <- function( yaxis_ticks(FALSE) + bayesplot_theme_get() + theme( - legend.spacing.y = unit(-13, "pt") + legend.spacing.y = unit(-12, "pt") ) } diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg new file mode 100644 index 00000000..97fc4307 --- /dev/null +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg @@ -0,0 +1,155 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 + + + + + + + + + + +0 +5 +10 +15 +20 +25 + + +y +c +e +n +s + + + +y +y +r +e +p +ppc_km_overlay (points, observed and censored) + + diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg new file mode 100644 index 00000000..75bd6321 --- /dev/null +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 + + + + + + + + + + +0 +5 +10 +15 +20 +25 + + + + +y +y +r +e +p +ppc_km_overlay (points, only observed) + + diff --git a/tests/testthat/data-for-ppc-tests.R b/tests/testthat/data-for-ppc-tests.R index 8e2dfd4e..d4a08217 100644 --- a/tests/testthat/data-for-ppc-tests.R +++ b/tests/testthat/data-for-ppc-tests.R @@ -31,6 +31,7 @@ vdiff_loo_lw[] <- rnorm(100 * 400, -8, 2) vdiff_y3 <- rexp(50, rate = 0.2) vdiff_status_y3 <- rep_len(0:1, length.out = length(vdiff_y3)) +vdiff_status_y3_no_cens <- rep_len(1, length.out = length(vdiff_y3)) vdiff_group3 <- rep_len(c(1,2), length.out = 50) vdiff_left_truncation_y3 <- runif(length(vdiff_y3), min = 0, max = 0.6) * vdiff_y3 diff --git a/tests/testthat/test-ppc-censoring.R b/tests/testthat/test-ppc-censoring.R index 2224df7b..4ad52389 100644 --- a/tests/testthat/test-ppc-censoring.R +++ b/tests/testthat/test-ppc-censoring.R @@ -2,8 +2,8 @@ source(test_path("data-for-ppc-tests.R")) test_that("ppc_km_overlay returns a ggplot object", { skip_if_not_installed("ggfortify") - expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = Inf)) - expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = 1)) + expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = Inf, y_draw = "lines")) + expect_gg(ppc_km_overlay(y, yrep, status_y = status_y, left_truncation_y = left_truncation_y, size = 0.5, alpha = 0.2, extrapolation_factor = 1, y_draw = "points")) expect_gg(ppc_km_overlay(y2, yrep2, status_y = status_y2)) }) @@ -74,6 +74,14 @@ test_that("ppc_km_overlay messages if extrapolation_factor left at default value ) }) +test_that("ppc_km_overlay errors if bad y_draw value", { + skip_if_not_installed("ggfortify") + expect_error( + ppc_km_overlay(y, yrep, status_y = status_y, y_draw = "dots"), + "`y_draw` must be equal to \"lines\" or \"points\".", + ) +}) + # Visual tests ----------------------------------------------------------------- test_that("ppc_km_overlay renders correctly", { @@ -121,6 +129,24 @@ test_that("ppc_km_overlay renders correctly", { ) vdiffr::expect_doppelganger("ppc_km_overlay (max extrapolation)", p_custom2_max_extrapolation) + + p_custom2_points_observed_and_censored <- ppc_km_overlay( + vdiff_y3, + vdiff_yrep3, + status_y = vdiff_status_y3, + y_draw = "points" + ) + vdiffr::expect_doppelganger("ppc_km_overlay (points, observed and censored)", + p_custom2_points_observed_and_censored) + + p_custom2_points_only_observed <- ppc_km_overlay( + vdiff_y3, + vdiff_yrep3, + status_y = vdiff_status_y3_no_cens, + y_draw = "points" + ) + vdiffr::expect_doppelganger("ppc_km_overlay (points, only observed)", + p_custom2_points_only_observed) }) test_that("ppc_km_overlay_grouped renders correctly", { From 1017c4064b81fbc5d298f4da4e4af04c48f3dac1 Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 20:02:29 +0300 Subject: [PATCH 04/12] Implement points feature for ppc_km_overlay_grouped --- R/ppc-censoring.R | 2 + ...y-grouped-points-observed-and-censored.svg | 214 ++++++++++++++++++ ...m-overlay-grouped-points-only-observed.svg | 183 +++++++++++++++ tests/testthat/test-ppc-censoring.R | 28 +++ 4 files changed, 427 insertions(+) create mode 100644 tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg create mode 100644 tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index 9f248bd4..3e53a3f4 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -277,6 +277,7 @@ ppc_km_overlay_grouped <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, + y_draw = "lines", size = 0.25, alpha = 0.7 ) { @@ -289,6 +290,7 @@ ppc_km_overlay_grouped <- function( ..., status_y = status_y, left_truncation_y = left_truncation_y, + y_draw = y_draw, size = size, alpha = alpha, extrapolation_factor = extrapolation_factor diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg new file mode 100644 index 00000000..15479aa3 --- /dev/null +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg @@ -0,0 +1,214 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 + + + + + + + + + +2 + + + + + + + + + +0 +5 +10 +15 +20 +25 + + + + + + + +0 +5 +10 +15 +20 +25 + +0.0 +0.5 +1.0 + + + + + +y +c +e +n +s + + + +y +y +r +e +p +ppc_km_overlay_grouped (points, observed and censored) + + diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg new file mode 100644 index 00000000..9af05f14 --- /dev/null +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg @@ -0,0 +1,183 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 + + + + + + + + + +2 + + + + + + + + + +0 +5 +10 +15 +20 +25 + + + + + + + +0 +5 +10 +15 +20 +25 + +0.0 +0.5 +1.0 + + + + + + + +y +y +r +e +p +ppc_km_overlay_grouped (points, only observed) + + diff --git a/tests/testthat/test-ppc-censoring.R b/tests/testthat/test-ppc-censoring.R index 4ad52389..03702439 100644 --- a/tests/testthat/test-ppc-censoring.R +++ b/tests/testthat/test-ppc-censoring.R @@ -16,10 +16,12 @@ test_that("ppc_km_overlay_grouped returns a ggplot object", { expect_gg(ppc_km_overlay_grouped(y, yrep, as.numeric(group), status_y = status_y, left_truncation_y = left_truncation_y, + y_draw = "lines", size = 0.5, alpha = 0.2)) expect_gg(ppc_km_overlay_grouped(y, yrep, as.integer(group), status_y = status_y, left_truncation_y = left_truncation_y, + y_draw = "points", size = 0.5, alpha = 0.2)) expect_gg(ppc_km_overlay_grouped(y2, yrep2, group2, @@ -215,4 +217,30 @@ test_that("ppc_km_overlay_grouped renders correctly", { "ppc_km_overlay_grouped (max extrapolation)", p_custom2_max_extrapolation ) + + p_custom2_points_observed_and_censored <- ppc_km_overlay_grouped( + vdiff_y3, + vdiff_yrep3, + vdiff_group3, + status_y = vdiff_status_y3, + y_draw = "points" + ) + + vdiffr::expect_doppelganger( + "ppc_km_overlay_grouped (points, observed and censored)", + p_custom2_points_observed_and_censored + ) + + p_custom2_points_only_observed <- ppc_km_overlay_grouped( + vdiff_y3, + vdiff_yrep3, + vdiff_group3, + status_y = vdiff_status_y3_no_cens, + y_draw = "points" + ) + + vdiffr::expect_doppelganger( + "ppc_km_overlay_grouped (points, only observed)", + p_custom2_points_only_observed + ) }) From c0d2c9e40adc6562a414a772e055b8513275cb9c Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 20:30:52 +0300 Subject: [PATCH 05/12] Fix a bug in ppc_km_overlay --- R/ppc-censoring.R | 10 ++++++++++ .../ppc-km-overlay-grouped-points-only-observed.svg | 1 - .../ppc-km-overlay-points-only-observed.svg | 1 - 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index 3e53a3f4..e2f28ec0 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -240,6 +240,16 @@ ppc_km_overlay <- function( labels = c("y" = expression(italic(y)), "yrep" = expression(italic(y)[rep])) ) + + (if (y_draw == "points") { + guides( + color = guide_legend( + override.aes = list( + shape = c(19, NA), # 19 = point for 'y', NA = no point for 'yrep' + linetype = c(0, 1) # 0 = no line for 'y', 1 = solid line for 'yrep' + ) + ) + ) + }) + # Conditionally add shape scale and guide ONLY if drawing points AND censored data exists (if (y_draw == "points" && any(fsf$is_y_color == "y" & fsf$n.censor > 0, na.rm = TRUE)) { list( diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg index 9af05f14..7989529b 100644 --- a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg @@ -172,7 +172,6 @@ - y y r diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg index 75bd6321..66405814 100644 --- a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg @@ -113,7 +113,6 @@ - y y r From ed8e883ba8c0c3f2085e1f545b7fc3f0f1d04ab4 Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 21:09:36 +0300 Subject: [PATCH 06/12] Add documentation for y_draw parameter in ppc_km_overlay --- R/ppc-censoring.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index e2f28ec0..063debe4 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -78,6 +78,9 @@ #' ) #' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, #' left_truncation_y = left_truncation_y) +#' +#' # With y_draw = "points" +#' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, y_draw = "points") #' } NULL @@ -96,6 +99,10 @@ NULL #' posterior predictive draws may not be shown by default because of the #' controlled extrapolation. To display all posterior predictive draws, set #' `extrapolation_factor = Inf`. +#' @param y_draw A parameter that controls how the observed data are plotted. +#' Possible values are "lines" and "points". If "lines" (default), event times +#' and censoring times are connected with lines. If "points", event times are +#' marked as points and censoring times are marked as plus signs. ppc_km_overlay <- function( y, yrep, From aaae852f65f61f3ef96764ca13317a9b7b2cab7d Mon Sep 17 00:00:00 2001 From: Sakuski Date: Mon, 21 Sep 2026 22:07:06 +0300 Subject: [PATCH 07/12] Update NEWS.md --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 910ce2e7..095d0978 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # bayesplot (development version) +* Add option to display observed data as points in `ppc_km_overlay()` and + `ppc_km_overlay_grouped()` by @Sakuski (#560) + # bayesplot 1.16.0 ### New plots and plotting capabilities From d1e4deddf0335d4ca92eaab69761ae6cabe01b0b Mon Sep 17 00:00:00 2001 From: jgabry Date: Mon, 21 Sep 2026 14:23:12 -0600 Subject: [PATCH 08/12] minor edits --- R/ppc-censoring.R | 16 +++++++--------- man/PPC-censoring.Rd | 10 ++++++++++ tests/testthat/test-ppc-censoring.R | 2 +- 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index 063debe4..18ae2479 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -99,10 +99,10 @@ NULL #' posterior predictive draws may not be shown by default because of the #' controlled extrapolation. To display all posterior predictive draws, set #' `extrapolation_factor = Inf`. -#' @param y_draw A parameter that controls how the observed data are plotted. -#' Possible values are "lines" and "points". If "lines" (default), event times -#' and censoring times are connected with lines. If "points", event times are -#' marked as points and censoring times are marked as plus signs. +#' @param y_draw How should the observed data be plotted? Possible values are +#' `"lines"` and `"points"`. If `"lines"` (default), event times and censoring +#' times are connected with lines. If `"points"`, event times are marked as +#' points and censoring times are marked as plus signs. ppc_km_overlay <- function( y, yrep, @@ -110,7 +110,7 @@ ppc_km_overlay <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, - y_draw = "lines", + y_draw = c("lines", "points"), size = 0.25, alpha = 0.7 ) { @@ -140,9 +140,7 @@ ppc_km_overlay <- function( )) } - if (y_draw != "lines" && y_draw != "points") { - abort("`y_draw` must be equal to \"lines\" or \"points\".") - } + y_draw <- match.arg(y_draw) data <- ppc_data(y, yrep, group = status_y) @@ -294,7 +292,7 @@ ppc_km_overlay_grouped <- function( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, - y_draw = "lines", + y_draw = c("lines", "points"), size = 0.25, alpha = 0.7 ) { diff --git a/man/PPC-censoring.Rd b/man/PPC-censoring.Rd index f15f7ccf..e42c842f 100644 --- a/man/PPC-censoring.Rd +++ b/man/PPC-censoring.Rd @@ -13,6 +13,7 @@ ppc_km_overlay( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, + y_draw = c("lines", "points"), size = 0.25, alpha = 0.7 ) @@ -25,6 +26,7 @@ ppc_km_overlay_grouped( status_y, left_truncation_y = NULL, extrapolation_factor = 1.2, + y_draw = c("lines", "points"), size = 0.25, alpha = 0.7 ) @@ -59,6 +61,11 @@ posterior predictive draws may not be shown by default because of the controlled extrapolation. To display all posterior predictive draws, set \code{extrapolation_factor = Inf}.} +\item{y_draw}{How should the observed data be plotted? Possible values are +\code{"lines"} and \code{"points"}. If \code{"lines"} (default), event times and censoring +times are connected with lines. If \code{"points"}, event times are marked as +points and censoring times are marked as plus signs.} + \item{size, alpha}{Passed to the appropriate geom to control the appearance of the \code{yrep} distributions.} @@ -137,6 +144,9 @@ left_truncation_y[condition] <- pmin( ) ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, left_truncation_y = left_truncation_y) + +# With y_draw = "points" +ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, y_draw = "points") } } \references{ diff --git a/tests/testthat/test-ppc-censoring.R b/tests/testthat/test-ppc-censoring.R index 03702439..7518898b 100644 --- a/tests/testthat/test-ppc-censoring.R +++ b/tests/testthat/test-ppc-censoring.R @@ -80,7 +80,7 @@ test_that("ppc_km_overlay errors if bad y_draw value", { skip_if_not_installed("ggfortify") expect_error( ppc_km_overlay(y, yrep, status_y = status_y, y_draw = "dots"), - "`y_draw` must be equal to \"lines\" or \"points\".", + "'arg' should be one of", ) }) From 44fd631c7a02ad6539b98f59ef27280de9e745aa Mon Sep 17 00:00:00 2001 From: jgabry Date: Mon, 21 Sep 2026 14:24:42 -0600 Subject: [PATCH 09/12] edge case: avoid indexing 1-key legend --- R/ppc-censoring.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index 18ae2479..b70f3672 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -245,7 +245,7 @@ ppc_km_overlay <- function( labels = c("y" = expression(italic(y)), "yrep" = expression(italic(y)[rep])) ) + - (if (y_draw == "points") { + (if (y_draw == "points" && any(fsf$is_y_color == "yrep")) { guides( color = guide_legend( override.aes = list( From f1c4b960bf4f7ca0232a81f8daffa84887e9040d Mon Sep 17 00:00:00 2001 From: jgabry Date: Mon, 21 Sep 2026 15:22:51 -0600 Subject: [PATCH 10/12] fix R cmd check error and note --- R/ppc-censoring.R | 3 +- ...pc-km-overlay-grouped-points-censored.svg} | 30 +++++++++---------- ...svg => ppc-km-overlay-points-censored.svg} | 30 +++++++++---------- tests/testthat/test-ppc-censoring.R | 4 +-- 4 files changed, 34 insertions(+), 33 deletions(-) rename tests/testthat/_snaps/ppc-censoring/{ppc-km-overlay-grouped-points-observed-and-censored.svg => ppc-km-overlay-grouped-points-censored.svg} (96%) rename tests/testthat/_snaps/ppc-censoring/{ppc-km-overlay-points-observed-and-censored.svg => ppc-km-overlay-points-censored.svg} (96%) diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R index b70f3672..4babfbbd 100644 --- a/R/ppc-censoring.R +++ b/R/ppc-censoring.R @@ -248,6 +248,7 @@ ppc_km_overlay <- function( (if (y_draw == "points" && any(fsf$is_y_color == "yrep")) { guides( color = guide_legend( + order = 1, override.aes = list( shape = c(19, NA), # 19 = point for 'y', NA = no point for 'yrep' linetype = c(0, 1) # 0 = no line for 'y', 1 = solid line for 'yrep' @@ -266,7 +267,7 @@ ppc_km_overlay <- function( ), # Force the censored sign in the legend to be the dark observation color guides( - shape = guide_legend(override.aes = list(color = get_color("dh"))) + shape = guide_legend(order = 2, override.aes = list(color = get_color("dh"))) ) ) }) + diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg similarity index 96% rename from tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg rename to tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg index 15479aa3..2ee62b92 100644 --- a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-observed-and-censored.svg +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg @@ -194,21 +194,21 @@ - - + + + y -c -e -n -s - - - -y -y -r -e -p -ppc_km_overlay_grouped (points, observed and censored) +y +r +e +p + + +y +c +e +n +s +ppc_km_overlay_grouped (points, censored) diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg similarity index 96% rename from tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg rename to tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg index 97fc4307..e091d537 100644 --- a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-observed-and-censored.svg +++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg @@ -135,21 +135,21 @@ 15 20 25 - - + + + y -c -e -n -s - - - -y -y -r -e -p -ppc_km_overlay (points, observed and censored) +y +r +e +p + + +y +c +e +n +s +ppc_km_overlay (points, censored) diff --git a/tests/testthat/test-ppc-censoring.R b/tests/testthat/test-ppc-censoring.R index 7518898b..cf5ebc7e 100644 --- a/tests/testthat/test-ppc-censoring.R +++ b/tests/testthat/test-ppc-censoring.R @@ -138,7 +138,7 @@ test_that("ppc_km_overlay renders correctly", { status_y = vdiff_status_y3, y_draw = "points" ) - vdiffr::expect_doppelganger("ppc_km_overlay (points, observed and censored)", + vdiffr::expect_doppelganger("ppc_km_overlay (points, censored)", p_custom2_points_observed_and_censored) p_custom2_points_only_observed <- ppc_km_overlay( @@ -227,7 +227,7 @@ test_that("ppc_km_overlay_grouped renders correctly", { ) vdiffr::expect_doppelganger( - "ppc_km_overlay_grouped (points, observed and censored)", + "ppc_km_overlay_grouped (points, censored)", p_custom2_points_observed_and_censored ) From 5f48ab848fbf1d3372bf3bae2c8efbbd69ceb3fc Mon Sep 17 00:00:00 2001 From: jgabry Date: Mon, 21 Sep 2026 15:26:12 -0600 Subject: [PATCH 11/12] Update R-CMD-check.yaml --- .github/workflows/R-CMD-check.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index f4669a7a..157b7cd0 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -8,6 +8,11 @@ on: name: R-CMD-check.yaml +# Cancel in-progress runs when a new commit is pushed to the same branch/PR +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + permissions: read-all jobs: From 66e42c6357a36de516653e4d2fce3980dd9fb94a Mon Sep 17 00:00:00 2001 From: jgabry Date: Mon, 21 Sep 2026 15:26:14 -0600 Subject: [PATCH 12/12] Update test-coverage.yaml --- .github/workflows/test-coverage.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 1f02d855..efa49c25 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -7,6 +7,11 @@ on: name: test-coverage.yaml +# Cancel in-progress runs when a new commit is pushed to the same branch/PR +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + permissions: contents: read id-token: write