fix mcmc_area_ridges and visual tests

DESCRIPTION

@@ -27,7 +27,7 @@ Imports:
     utils,
     rlang,
     ggridges
-Suggests:
+Suggests: 
     arm,
     gridExtra (>= 2.2.1),
     knitr (>= 1.16),
@@ -38,7 +38,8 @@ Suggests:
     rstantools (>= 1.2.0),
     scales,
     shinystan (>= 2.3.0),
-    testthat
+    testthat,
+    vdiffr
 RoxygenNote: 6.0.1
 VignetteBuilder: knitr
 Encoding: UTF-8

R/mcmc-intervals.R

@@ -362,7 +362,9 @@ mcmc_areas_ridges <- function(x,
                                  prob = prob, prob_outer = prob_outer,
                                  bw = bw, adjust = adjust, kernel = kernel,
                                  n_dens = n_dens)
-  datas <- split(data, data$interval)
+
+  datas <- data %>%
+    split(data$interval)
 
   # faint vertical line at zero if zero is within x_lim
   x_lim <- range(datas$outer$x)
@@ -376,31 +378,62 @@ mcmc_areas_ridges <- function(x,
     geom_ignore()
   }
 
-  args_inner <- list(
-    mapping = aes_(height = ~ density),
-    data = datas$inner,
-    fill = get_color("light"),
-    color = get_color("dark"),
-    stat = "identity"
-  )
-
   args_outer <- list(
     mapping = aes_(height = ~ density),
     color = get_color("dark"),
     fill = NA,
     stat = "identity"
   )
 
-  layer_inner <- do.call(ggridges::geom_density_ridges, args_inner)
   layer_outer <- do.call(ggridges::geom_density_ridges, args_outer)
 
+  # Force ggridges to compute the scaling now
+  test_plot <- ggplot(datas$outer) +
+    aes_(x = ~ x, y = ~ parameter) +
+    layer_outer
+
+  soft_build <- ggplot_build(test_plot)
+  scaler1 <- unique(soft_build$data[[1]][["scale"]])
+  scaler2 <- unique(soft_build$data[[1]][["iscale"]])
+  scale <- scaler1 * scaler2
+
+  # Draw each ridgeline from top the bottom
+  layer_list_inner <- list()
+  par_draw_order <- levels(unique(data$parameter))
+  bg <- theme_get()[["panel.background"]][["fill"]] %||% "white"
+
+  for (par_num in seq_along(unique(data$parameter))) {
+    # Basically, draw the current ridgeline normally, but draw all the ones
+    # under it (which would overlap it vertically) with a blank fill
+    this_par <- par_draw_order[par_num]
+    next_pars <- par_draw_order[par_num < seq_along(par_draw_order)]
+
+    this_par_data <- datas$inner %>%
+      dplyr::filter(.data$parameter == this_par) %>%
+      mutate(color = get_color("dark"), fill = get_color("light"))
+
+    next_par_data <- datas$outer %>%
+      dplyr::filter(.data$parameter %in% next_pars) %>%
+      mutate(color = get_color("dark"), fill = bg)
+
+    args_inner <- list(
+        mapping = aes_(height = ~ density, color = ~ color, fill = ~ fill),
+        data = dplyr::bind_rows(this_par_data, next_par_data),
+        scale = scale,
+        stat = "identity")
+
+    layer_list_inner[[par_num]] <- do.call(ggridges::geom_ridgeline, args_inner)
+  }
+
   ggplot(datas$outer) +
     aes_(x = ~ x, y = ~ parameter) +
     layer_vertical_line +
     layer_outer +
-    layer_inner +
     scale_y_discrete(limits = unique(rev(data$parameter)),
                      expand = c(0.05, .6)) +
+    layer_list_inner +
+    scale_fill_identity() +
+    scale_color_identity() +
     xlim(x_lim) +
     yaxis_title(FALSE) +
     xaxis_title(FALSE) +

tests/figs/deps.txt

@@ -0,0 +1,6 @@
+Fontconfig: 2.11.94
+FreeType: 2.6.0
+Cairo: 1.14.2
+vdiffr: 0.2.1
+svglite: 1.2.1
+ggplot2: 2.2.1