merge pr #437: fix two-sided p-value shading

NEWS.md

@@ -2,8 +2,10 @@
 
 To be released as v1.0.2.
 
-* Fixes `generate()` errors when columns are named `x` (#431).
-* Fixed error from `visualize` when passed `generate()`d `infer_dist` objects that had not been passed to `hypothesize()` (#432). 
+
+* Fix p-value shading when the calculated statistic falls exactly on the boundaries of a histogram bin (#424).
+* Fix `generate()` errors when columns are named `x` (#431).
+* Fix error from `visualize` when passed `generate()`d `infer_dist` objects that had not been passed to `hypothesize()` (#432). 
 * Update visual checks for `visualize` output to align with the R 4.1.0+ graphics engine (#438).
 
 # infer v1.0.1 (GitHub Only)

R/shade_p_value.R

@@ -249,7 +249,15 @@ two_tail_area <- function(obs_stat, direction) {
       max(obs_stat, second_border), "right", do_warn = FALSE
     )(data)
 
-    dplyr::bind_rows(left_area, right_area)
+    ret <- dplyr::bind_rows(left_area, right_area)
+
+    # jitter one of the x coords that the right and left area have in common 
+    # so that their heights aren't summed
+    common_x <- which.max(ret$x[ret$dir == "left"])
+
+    ret$x[common_x] <- ret$x[common_x] - 1e-5*ret$x[common_x]
+
+    ret
   }
 }
 

tests/testthat/test-shade_p_value.R

@@ -51,6 +51,27 @@ test_that("shade_p_value works", {
     "pval-both-corrupt",
     expect_warning(gss_viz_both + shade_p_value(1, "aaa"), "direction")
   )
+
+  # -roper p-value shading when the calculated statistic falls exactly on the 
+  # boundaries of a histogram bin (#424)
+  r_hat <- gss %>% 
+    observe(college ~ sex, success = "no degree",
+            stat = "ratio of props", order = c("female", "male"))
+
+  set.seed(33)
+
+  null_dist <- gss %>%
+    specify(college ~ sex, success = "no degree") %>%
+    hypothesize(null = "independence") %>% 
+    generate(reps = 1000) %>% 
+    calculate(stat = "ratio of props", order = c("female", "male"))
+
+
+  expect_doppelganger(
+    "pval-stat-match", 
+    visualize(null_dist) +
+      shade_p_value(obs_stat = r_hat, direction = "two-sided")
+  )
 })
 
 test_that("shade_p_value accepts synonyms for 'direction'", {