allow negative integer input to ppc_bars, ppc_bars_grouped

closes #172

Author: jgabry

R/helpers-ppc.R

@@ -243,9 +243,12 @@ is_whole_number <- function(x, tol = .Machine$double.eps) {
   }
 }
 
-# check if all values in x are counts (non-negative whole numbers)
+# check if all values in x are whole numbers or counts (non-negative whole numbers)
+all_whole_number <- function(x, ...) {
+  all(is_whole_number(x, ...))
+}
 all_counts <- function(x, ...) {
-  all(is_whole_number(x, ...)) && min(x) >= 0
+  all_whole_number(x, ...) && min(x) >= 0
 }
 
 # labels ----------------------------------------------------------------

R/ppc-discrete.R

@@ -103,10 +103,10 @@ ppc_bars <-
     check_ignored_arguments(...)
     y <- validate_y(y)
     yrep <- validate_yrep(yrep, y)
-    if (!all_counts(y))
-      stop("ppc_bars expects only non-negative integers in 'y'.")
-    if (!all_counts(yrep))
-      stop("ppc_bars expects only non-negative integers in 'yrep'.")
+    if (!all_whole_number(y))
+      stop("ppc_bars expects 'y' to be discrete.")
+    if (!all_whole_number(yrep))
+      stop("ppc_bars expects 'yrep' to be discrete.")
 
     alpha <- (1 - prob) / 2
     probs <- sort(c(alpha, 0.5, 1 - alpha))
@@ -145,10 +145,10 @@ ppc_bars_grouped <-
     y <- validate_y(y)
     yrep <- validate_yrep(yrep, y)
     group <- validate_group(group, y)
-    if (!all_counts(y))
-      stop("ppc_bars expects only non-negative integers in 'y'.")
-    if (!all_counts(yrep))
-      stop("ppc_bars expects only non-negative integers in 'yrep'.")
+    if (!all_whole_number(y))
+      stop("ppc_bars_grouped expects 'y' to be discrete.")
+    if (!all_whole_number(yrep))
+      stop("ppc_bars_grouped expects 'yrep' to be discrete.")
 
     alpha <- (1 - prob) / 2
     probs <- sort(c(alpha, 0.5, 1 - alpha))

tests/testthat/test-extractors.R

@@ -79,6 +79,7 @@ test_that("neff_ratio.stanreg returns correct structure", {
 test_that("rhat.stanfit returns correct structure", {
   r <- rhat(fit$stanfit)
   expect_named(r)
+  r <- r[!names(r) %in% "mean_PPD"]
   expect_equal(r, summary(fit)[, "Rhat"])
 
   r2 <- rhat(fit$stanfit, pars = c("wt", "sigma"))
@@ -91,6 +92,7 @@ test_that("neff_ratio.stanreg returns correct structure", {
 
   ratio <- neff_ratio(fit$stanfit)
   expect_named(ratio)
+  ratio <- ratio[!names(ratio) %in% "mean_PPD"]
   ans <- summary(fit)[, "n_eff"] / denom
   expect_equal(ratio, ans, tol = 0.001)
 

tests/testthat/test-ppc-discrete.R

@@ -30,11 +30,21 @@ test_that("freq argument to ppc_bars works", {
   expect_true(all(y_prop < 1) && all(y_prop > 0))
 })
 
-test_that("ppc_bars errors if y/yrep not natural numbers", {
+test_that("ppc_bars works with negative integers", {
+  y <- round(rnorm(100, -10, 1))
+  yrep <- round(matrix(rnorm(100 * 500, -10, 1), 500, 100))
+  expect_gg(ppc_bars(y, yrep))
+})
+
+test_that("ppc_bars(_grouped) errors if y/yrep not discrete", {
   expect_error(ppc_bars(y + 0.5, yrep),
-               "ppc_bars expects only non-negative integers in 'y'")
+               "ppc_bars expects 'y' to be discrete")
   expect_error(ppc_bars(y, yrep + 0.5),
-               "ppc_bars expects only non-negative integers in 'yrep'")
+               "ppc_bars expects 'yrep' to be discrete")
+  expect_error(ppc_bars_grouped(y + 0.5, yrep, group = esoph$agegp),
+               "ppc_bars_grouped expects 'y' to be discrete")
+  expect_error(ppc_bars_grouped(y, yrep + 0.5, group = esoph$agegp),
+               "ppc_bars_grouped expects 'yrep' to be discrete")
 })