Extend the changes also to the ppc_loo functions.

Author: mcol

NEWS.md

@@ -19,10 +19,10 @@ gains an argument `discrete`, which is `FALSE` by default, but can be used to ma
 Geom more appropriate for discrete data. (#145)
 
 * [PPC intervals plots](http://mc-stan.org/bayesplot/reference/PPC-intervals.html)
+and [LOO predictive checks](http://mc-stan.org/bayesplot/reference/PPC-loo.html)
 now draw both an outer and an inner probability interval, which can be
 controlled through the new argument `prob_outer` and the already existing
-`prob`. The default value of the outer interval has been changed from 1.0 to
-0.9, consistently with what is produced by `mcmc_intervals()` and similar.
+`prob`, consistently with what is produced by `mcmc_intervals()` and similar.
 (#154, @mcol)
 
 # bayesplot 1.5.0

R/ppc-loo.R

@@ -269,16 +269,18 @@ ppc_loo_pit <-
 #'   object returned by the \code{psis} function (or by the \code{loo} function
 #'   with argument \code{save_psis} set to \code{TRUE}).
 #' @param prob A value between 0 and 1 indicating the desired probability mass
-#'   to include in the intervals. The default is 0.9.
+#'   to include in the inner interval. The default is 0.5.
+#'  @param prob_outer The probability mass to include in the outer interval.
+#'   The default is 0.9.
 #' @param intervals For \code{ppc_loo_intervals} and \code{ppc_loo_ribbon},
-#'   optionally a matrix of precomputed LOO predictive intervals intervals with
+#'   optionally a matrix of precomputed LOO predictive intervals
 #'   that can be specified instead of \code{yrep} and \code{lw} (these are both
 #'   ignored if \code{intervals} is specified). If not specified the intervals
 #'   are computed internally before plotting. If specified, \code{intervals}
 #'   must be a matrix with number of rows equal to the number of data points and
-#'   three columns in the following order: the first for the lower bound of the
-#'   interval, the second for median (50\%), and the third for the interval
-#'   upper bound (column names are ignored).
+#'   five columns in the following order: lower outer interval, lower inner
+#'   interval, median (50\%), upper inner interval and upper outer interval
+#'   (column names are ignored).
 #' @param order For \code{ppc_loo_intervals}, a string indicating how to arrange
 #'   the plotted intervals. The default (\code{"index"}) is to plot them in the
 #'   order of the observations. The alternative (\code{"median"}) arranges them
@@ -300,7 +302,8 @@ ppc_loo_intervals <-
            subset = NULL,
            intervals = NULL,
            ...,
-           prob = 0.9,
+           prob = 0.5,
+           prob_outer = 0.9,
            size = 1,
            fatten = 3,
            order = c("index", "median")) {
@@ -309,11 +312,14 @@ ppc_loo_intervals <-
     y <- validate_y(y)
     order_by_median <- match.arg(order) == "median"
     if (!is.null(intervals)) {
-      stopifnot(is.matrix(intervals), ncol(intervals) == 3)
+      stopifnot(is.matrix(intervals), ncol(intervals) %in% c(3, 5))
       message(
         "'intervals' specified so ignoring ",
         "'yrep', 'psis_object', 'subset', if specified."
       )
+      if (ncol(intervals) == 3) {
+          intervals <- cbind(intervals[, 1], intervals, intervals[, 3])
+      }
     } else {
       suggested_package("loo", min_version = "2.0.0")
       yrep <- validate_yrep(yrep, y)
@@ -323,7 +329,8 @@ ppc_loo_intervals <-
         yrep <- yrep[, subset, drop=FALSE]
         psis_object <- .psis_subset(psis_object, subset)
       }
-      a <- (1 - prob) / 2
+      probs <- sort(c(prob, prob_outer))
+      a <- (1 - probs) / 2
       stopifnot(identical(dim(psis_object), dim(yrep)))
       intervals <- suppressWarnings(t(loo::E_loo(
         x = yrep,
@@ -367,17 +374,21 @@ ppc_loo_ribbon <-
            subset = NULL,
            intervals = NULL,
            ...,
-           prob = 0.9,
+           prob = 0.5,
+           prob_outer = 0.9,
            alpha = 0.33,
            size = 0.25) {
     check_ignored_arguments(...)
     y <- validate_y(y)
     if (!is.null(intervals)) {
-      stopifnot(is.matrix(intervals), ncol(intervals) == 3)
+      stopifnot(is.matrix(intervals), ncol(intervals) %in% c(3, 5))
       message(
         "'intervals' specified so ignoring ",
         "'yrep', 'psis_object', 'subset', if specified."
       )
+      if (ncol(intervals) == 3) {
+          intervals <- cbind(intervals[, 1], intervals, intervals[, 3])
+      }
     } else {
       suggested_package("loo", min_version = "2.0.0")
       yrep <- validate_yrep(yrep, y)
@@ -387,7 +398,8 @@ ppc_loo_ribbon <-
         yrep <- yrep[, subset, drop=FALSE]
         psis_object <- .psis_subset(psis_object, subset)
       }
-      a <- (1 - prob) / 2
+      probs <- sort(c(prob, prob_outer))
+      a <- (1 - probs) / 2
       stopifnot(identical(dim(psis_object), dim(yrep)))
       intervals <- suppressWarnings(t(loo::E_loo(
         x = yrep,
@@ -416,9 +428,11 @@ ppc_loo_ribbon <-
     y_id = seq_along(y),
     y_obs = y,
     x = x,
-    lo = intervals[, 1],
-    mid = intervals[, 2],
-    hi = intervals[, 3])
+    ll = intervals[, 1],
+    l  = intervals[, 2],
+    m  = intervals[, 3],
+    h  = intervals[, 4],
+    hh = intervals[, 5])
 }
 
 # subset a psis_object without breaking it

man/PPC-loo.Rd

@@ -72,7 +72,7 @@ test_that("ppc_loo_ribbon returns ggplot object", {
 })
 
 test_that("ppc_loo_intervals/ribbon work when 'intervals' specified", {
-  intervals <- t(apply(yrep, 2, quantile, probs = c(0.1, 0.5, 0.9)))
+  intervals <- t(apply(yrep, 2, quantile, probs = c(0.1, 0.25, 0.5, 0.75, 0.9)))
   expect_gg(ppc_loo_intervals(y, intervals = intervals))
   expect_gg(ppc_loo_ribbon(y, intervals = intervals))
   expect_message(ppc_loo_ribbon(y, intervals = intervals),
@@ -81,6 +81,12 @@ test_that("ppc_loo_intervals/ribbon work when 'intervals' specified", {
                  "'intervals' specified so ignoring 'yrep', 'psis_object', 'subset', if specified")
 })
 
+test_that("ppc_loo_intervals/ribbon work when 'intervals' has 3 columns", {
+  intervals <- t(apply(yrep, 2, quantile, probs = c(0.1, 0.5, 0.9)))
+  expect_gg(ppc_loo_intervals(y, intervals = intervals))
+  expect_gg(ppc_loo_ribbon(y, intervals = intervals))
+})
+
 test_that("errors if dimensions of yrep and lw don't match", {
   expect_error(
     ppc_loo_pit_overlay(y, yrep, lw[, 1:5]),