Merge pull request #359 from stan-dev/residual

add x as argument to ppc_error_binned

Author: jgabry

NEWS.md

@@ -2,6 +2,8 @@
 
 * PPC "avg" functions (`ppc_scatter_avg()`, `ppc_error_scatter_avg()`, etc.) gain a `stat` argument to set the averaging function. (Suggestion of #348, @kruschke).
 * `ppc_error_scatter_avg_vs_x(x = some_expression)` labels the *x* axis with `some_expression`.
+* Add `ppc_dots()` and `ppd_dots()` by @behramulukir (#357)
+* Add `x` argument to `ppc_error_binned` by @behramulukir (#359)
 
 # bayesplot 1.13.0
 

R/ppc-errors.R

@@ -9,6 +9,7 @@
 #' @template args-y-yrep
 #' @template args-group
 #' @template args-facet_args
+#' @param x A numeric vector the same length as `y` to use as the x-axis variable.
 #' @param ... Currently unused.
 #' @param stat A function or a string naming a function for computing the
 #' posterior average. In both cases, the function should take a vector input and
@@ -109,6 +110,10 @@
 #' yrep_prop <- sweep(yrep, 2, trials, "/")
 #'
 #' ppc_error_binned(y_prop, yrep_prop[1:6, ])
+#'
+#' # plotting against a covariate on x-axis
+#' herd <- as.numeric(example_model$data$herd)
+#' ppc_error_binned(y_prop, yrep_prop[1:6, ], x = herd)
 #' }
 #'
 NULL
@@ -270,9 +275,6 @@ ppc_error_scatter_avg_grouped <-
 
 #' @rdname PPC-errors
 #' @export
-#' @param x A numeric vector the same length as `y` to use as the x-axis
-#'   variable.
-#'
 ppc_error_scatter_avg_vs_x <- function(
     y,
     yrep,
@@ -312,14 +314,16 @@ ppc_error_scatter_avg_vs_x <- function(
 ppc_error_binned <-
   function(y,
            yrep,
+           x = NULL,
            ...,
            facet_args = list(),
            bins = NULL,
            size = 1,
            alpha = 0.25) {
     check_ignored_arguments(...)
 
-    data <- ppc_error_binnned_data(y, yrep, bins = bins)
+    qx <- enquo(x)
+    data <- ppc_error_binnned_data(y, yrep, x = x, bins = bins)
     facet_layer <- if (nrow(yrep) == 1) {
       geom_ignore()
     } else {
@@ -356,7 +360,7 @@ ppc_error_binned <-
         color = point_color
       ) +
       labs(
-        x = "Predicted proportion",
+        x = if (is.null(x)) "Predicted proportion" else as_label((qx)),
         y = "Average Errors \n (with 2SE bounds)"
       ) +
       bayesplot_theme_get() +
@@ -454,24 +458,39 @@ error_avg_label <- function(stat = NULL) {
 
 
 # Data for binned errors plots
-ppc_error_binnned_data <- function(y, yrep, bins = NULL) {
+ppc_error_binnned_data <- function(y, yrep, x = NULL, bins = NULL) {
   y <- validate_y(y)
   yrep <- validate_predictions(yrep, length(y))
 
+  if (!is.null(x)) {
+    x <- validate_x(x, y)
+  }
+
   if (is.null(bins)) {
     bins <- n_bins(length(y))
   }
 
   errors <- compute_errors(y, yrep)
   binned_errs <- list()
   for (s in 1:nrow(errors)) {
-    binned_errs[[s]] <-
-      bin_errors(
-        ey = yrep[s, ],
-        r = errors[s, ],
-        bins = bins,
-        rep_id = s
-      )
+    if (is.null(x)) {
+      binned_errs[[s]] <-
+        bin_errors(
+          ey = yrep[s, ],
+          r = errors[s, ],
+          bins = bins,
+          rep_id = s
+        )
+    } else {
+      binned_errs[[s]] <-
+        bin_errors(
+          ey = x,
+          r = errors[s, ],
+          bins = bins,
+          rep_id = s
+        )
+    }
+
   }
 
   binned_errs <- dplyr::bind_rows(binned_errs)