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:
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
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
diff --git a/R/ppc-censoring.R b/R/ppc-censoring.R
index bcca33d6..4babfbbd 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 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,
@@ -103,6 +110,7 @@ ppc_km_overlay <- function(
status_y,
left_truncation_y = NULL,
extrapolation_factor = 1.2,
+ y_draw = c("lines", "points"),
size = 0.25,
alpha = 0.7
) {
@@ -132,6 +140,8 @@ ppc_km_overlay <- function(
))
}
+ y_draw <- match.arg(y_draw)
+
data <- ppc_data(y, yrep, group = status_y)
# Modify the status indicator:
@@ -171,10 +181,13 @@ 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)
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 +196,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 (y_draw == "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 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,
+ 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 +239,47 @@ 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)),
+ "yrep" = expression(italic(y)[rep]))
+ ) +
+ (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'
+ )
+ )
+ )
+ }) +
+ # 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(
+ 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(order = 2, 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(-12, "pt")
+ )
}
#' @export
@@ -225,6 +293,7 @@ ppc_km_overlay_grouped <- function(
status_y,
left_truncation_y = NULL,
extrapolation_factor = 1.2,
+ y_draw = c("lines", "points"),
size = 0.25,
alpha = 0.7
) {
@@ -237,6 +306,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/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/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg
new file mode 100644
index 00000000..2ee62b92
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-censored.svg
@@ -0,0 +1,214 @@
+
+
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..7989529b
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-grouped-points-only-observed.svg
@@ -0,0 +1,182 @@
+
+
diff --git a/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg
new file mode 100644
index 00000000..e091d537
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-censored.svg
@@ -0,0 +1,155 @@
+
+
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..66405814
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-censoring/ppc-km-overlay-points-only-observed.svg
@@ -0,0 +1,123 @@
+
+
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..cf5ebc7e 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))
})
@@ -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,
@@ -74,6 +76,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"),
+ "'arg' should be one of",
+ )
+})
+
# Visual tests -----------------------------------------------------------------
test_that("ppc_km_overlay renders correctly", {
@@ -121,6 +131,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, 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", {
@@ -189,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, 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
+ )
})