Merge pull request #257 from stan-dev/feature-ppc_ribbon_obspoints

Feature ppc ribbon obspoints

R/ppc-intervals.R

@@ -173,14 +173,17 @@ ppc_intervals_grouped <- function(y,
 
 #' @rdname PPC-intervals
 #' @export
+#' @param y_draw For ribbon plots only, a string specifying how to draw `y`. Can
+#'   be `"line"` (the default), `"points"`, or `"both"`.
 ppc_ribbon <- function(y,
                        yrep,
                        x = NULL,
                        ...,
                        prob = 0.5,
                        prob_outer = 0.9,
                        alpha = 0.33,
-                       size = 0.25) {
+                       size = 0.25,
+                       y_draw = c("line", "points", "both")) {
   check_ignored_arguments(...)
 
   data <- ppc_intervals_data(
@@ -197,7 +200,8 @@ ppc_ribbon <- function(y,
     size = size,
     grouped = FALSE,
     style = "ribbon",
-    x_lab = label_x(x)
+    x_lab = label_x(x),
+    y_draw = y_draw
   )
 }
 
@@ -213,7 +217,8 @@ ppc_ribbon_grouped <- function(y,
                                prob = 0.5,
                                prob_outer = 0.9,
                                alpha = 0.33,
-                               size = 0.25) {
+                               size = 0.25,
+                               y_draw = c("line", "points", "both")) {
   check_ignored_arguments(...)
 
   data <- ppc_intervals_data(
@@ -234,7 +239,8 @@ ppc_ribbon_grouped <- function(y,
     size = size,
     grouped = TRUE,
     style = "ribbon",
-    x_lab = label_x(x)
+    x_lab = label_x(x),
+    y_draw = y_draw
   )
 }
 
@@ -319,9 +325,11 @@ label_x <- function(x) {
            size = 1,
            grouped = FALSE,
            style = c("intervals", "ribbon"),
-           x_lab = NULL) {
+           x_lab = NULL,
+           y_draw = c("line", "points", "both")) {
 
   style <- match.arg(style)
+  y_draw <- match.arg(y_draw)
 
   graph <- ggplot(
     data = data,
@@ -349,11 +357,22 @@ label_x <- function(x) {
         aes_(color = "yrep"),
         size = size/2
       ) +
-      geom_blank(aes_(fill = "y")) +
-      geom_line(
+      geom_blank(aes_(fill = "y"))
+
+    if (y_draw == "line" || y_draw == "both") {
+      graph <- graph + geom_line(
         aes_(y = ~ y_obs, color = "y"),
         size = 0.5
       )
+    }
+
+    if (y_draw == "points" || y_draw == "both") {
+      graph <- graph + geom_point(
+        mapping = aes_(y = ~ y_obs, color = "y", fill = "y"),
+        shape = 21,
+        size = 1.5
+      )
+    }
   } else {
     graph <- graph +
       geom_pointrange(

tests/figs/deps.txt

@@ -1,3 +1,3 @@
 - vdiffr-svg-engine: 1.0
-- vdiffr: 0.3.2.2
+- vdiffr: 0.3.3
 - freetypeharfbuzz: 0.2.5

tests/testthat/test-ppc-intervals.R

@@ -126,4 +126,40 @@ test_that("ppc_ribbon renders correctly", {
 
   p_50 <- ppc_ribbon(vdiff_y, vdiff_yrep, prob = 0.5)
   vdiffr::expect_doppelganger("ppc_ribbon (interval width)", p_50)
+
+  p_line <- ppc_ribbon(vdiff_y, vdiff_yrep, y_draw = "line")
+  vdiffr::expect_doppelganger("ppc_intervals (y_draw = line)", p_line)
+
+  p_point <- ppc_ribbon(vdiff_y, vdiff_yrep, y_draw = "point")
+  vdiffr::expect_doppelganger("ppc_intervals (y_draw = point)", p_point)
+
+  p_both <- ppc_ribbon(vdiff_y, vdiff_yrep, y_draw = "both")
+  vdiffr::expect_doppelganger("ppc_intervals (y_draw = both)", p_both)
+})
+
+test_that("ppc_ribbon_grouped renders correctly", {
+  testthat::skip_on_cran()
+  testthat::skip_if_not_installed("vdiffr")
+
+  p_base <- ppc_ribbon_grouped(vdiff_y, vdiff_yrep, group = vdiff_group)
+  vdiffr::expect_doppelganger("ppc_ribbon_grouped (default)", p_base)
+
+  p_line <- ppc_ribbon_grouped(vdiff_y, vdiff_yrep, group = vdiff_group,
+                               y_draw = "line")
+  vdiffr::expect_doppelganger("ppc_ribbon_grouped (y_draw = line)", p_line)
+
+  p_point <- ppc_ribbon_grouped(vdiff_y, vdiff_yrep, group = vdiff_group,
+                               y_draw = "point")
+  vdiffr::expect_doppelganger("ppc_ribbon_grouped (y_draw = point)", p_point)
+
+  p_both <- ppc_ribbon_grouped(vdiff_y, vdiff_yrep, group = vdiff_group,
+                               y_draw = "both")
+  vdiffr::expect_doppelganger("ppc_ribbon_grouped (y_draw = both)", p_both)
+
+  p_x <- ppc_ribbon_grouped(
+    y = vdiff_y,
+    yrep = vdiff_yrep,
+    x = vdiff_y,
+    group = vdiff_group)
+  vdiffr::expect_doppelganger("ppc_ribbon_grouped (x values)", p_x)
 })