tests for blurry dotplots

R/stat_dotsinterval.R

@@ -47,13 +47,13 @@ compute_slab_dots = function(
       )
       if (compute_mcse) {
         stop_if_not_installed("posterior", "{.help stat_mcse_dots}")
-        se = posterior::mcse_quantile(.sample, probs)
+        se = posterior::mcse_quantile(.sample, probs, names = FALSE)
       }
     } else {
       input = sort(.sample)
       if (compute_mcse) {
         stop_if_not_installed("posterior", "{.help stat_mcse_dots}")
-        se = posterior::mcse_quantile(.sample, ppoints(length(input), a = 0.5))
+        se = posterior::mcse_quantile(.sample, ppoints(length(input), a = 0.5), names = FALSE)
       }
     }
   } else {

R/testthat.R

@@ -19,11 +19,11 @@ skip_if_sensitive_to_density = function() {
   testthat::skip_if(getRversion() >= "4.4", "density() output changed in R 4.4")
 }
 
-#' skip tests if linearGradient support for visual test cases is not available
+#' skip tests if gradient support for visual test cases is not available
 #' (old versions of svglite did not support it and so test cases with
-#' linearGradients would be incorrect)
+#' gradients would be incorrect)
 #' @noRd
-skip_if_no_linearGradient = function() {
+skip_if_no_gradient = function() {
   testthat::skip_if_not(getRversion() >= "4.1")
   testthat::skip_if_not_installed("svglite", "2.1.0")
   testthat::skip_if_not_installed("fontquiver")

tests/testthat/test.distributions.R

@@ -37,9 +37,11 @@ test_that("distribution functions work on weighted sample distributions", {
   expect_equal(mean(x), mean(ref), tolerance = eps)
   expect_equal(median(x), median(ref), tolerance = eps)
   expect_equal(Mode(x), 5, tolerance = 0.01)
+  expect_equal(variance(x), variance(ref), tolerance = eps)
   expect_equal(distr_pdf(x)(2), distr_pdf(ref)(2), tolerance = eps)
   expect_equal(distr_cdf(x)(1), distr_cdf(ref)(1), tolerance = eps)
   expect_equal(distr_quantile(x)(0.5), distr_quantile(ref)(0.5), tolerance = eps)
+  expect_equal(format(x), "weighted_sample[20000]")
 })
 
 

tests/testthat/test.geom_blur_dots.R

@@ -0,0 +1,22 @@
+# Tests for blurry dot plots
+#
+# Author: mjskay
+###############################################################################
+
+
+test_that("geom_blur_dots displays correctly", {
+  skip_if_no_vdiffr()
+  skip_if_no_gradient()
+  skip_if_not_installed("posterior")
+
+  df = data.frame(x = 0, sd = c(0,0.1,0.25,1,2))
+
+  vdiffr::expect_doppelganger("blur types work correctly",
+    ggplot(df, aes(x = x, sd = sd)) +
+      geom_blur_dots(aes(y = "gaussian")) +
+      geom_blur_dots(aes(y = "interval 95%"), blur = "interval") +
+      geom_blur_dots(aes(y = "interval +/- 1sd"), blur = blur_interval(.width = 0.6826895)) +
+      geom_vline(xintercept = c(-2, -1, -0.25, 0.25, 1, 2), alpha = 0.25),
+    writer = write_svg_with_gradient
+  )
+})

tests/testthat/test.stat_dist_slabinterval.R

@@ -214,7 +214,7 @@ test_that("stat_dist_gradientinterval works", {
 
 test_that("fill_type = 'gradient' works", {
   skip_if_no_vdiffr()
-  skip_if_no_linearGradient()
+  skip_if_no_gradient()
 
 
   p = tribble(
@@ -303,6 +303,10 @@ test_that("scale transformation works", {
     p_log + stat_dist_ccdfinterval(n = 20)
   )
 
+  vdiffr::expect_doppelganger("dist_halfeyeh log scale mode_hdi",
+    p_log + stat_dist_halfeye(n = 20, point_interval = mode_hdi)
+  )
+
 
   p_log_wrap = data.frame(x = dist_wrap("lnorm")) %>%
     ggplot(aes(xdist = x, y = 0))
@@ -325,6 +329,7 @@ test_that("scale transformation works", {
   )
 
 
+  # transform that should require numerical diff
   p_logit = data.frame(dist = dist_beta(2,2)) %>%
     ggplot(aes(xdist = dist)) +
     scale_x_continuous(trans = scales::trans_new("logit", qlogis, plogis))
@@ -333,9 +338,16 @@ test_that("scale transformation works", {
     p_logit + stat_eye(n = 15, slab_color = "gray50")
   )
 
-  vdiffr::expect_doppelganger("dist_halfeyeh log scale mode_hdi",
-    p_log + stat_dist_halfeye(n = 20, point_interval = mode_hdi)
+
+  # transform that should work with symbolic diff
+  p_log_sym = data.frame(dist = dist_lognormal(2,2)) %>%
+    ggplot(aes(xdist = dist)) +
+    scale_x_continuous(trans = scales::trans_new("log", function(x) log(x), function(x) exp(x)))
+
+  vdiffr::expect_doppelganger("dist_halfeyeh log scale mode_hdi sym diff",
+    p_log_sym + stat_dist_halfeye(n = 20, point_interval = mode_hdi)
   )
+
 })
 
 

tests/testthat/test.stat_mcse_dots.R

@@ -0,0 +1,22 @@
+# Tests for MCSE dot plots
+#
+# Author: mjskay
+###############################################################################
+
+
+test_that("stat_mcse_dots calculates correctly", {
+  skip_if_not_installed("posterior")
+
+  set.seed(1234)
+  x = rnorm(200)
+
+  # MCSE on all points
+  df_all = layer_data(ggplot() + stat_mcse_dots(aes(x)))
+  expect_equal(df_all$x, sort(x))
+  expect_equal(df_all$sd, posterior::mcse_quantile(x, ppoints(200), names = FALSE))
+
+  # MCSE on 100 quantiles
+  df_100 = layer_data(ggplot() + stat_mcse_dots(aes(x), quantiles = 100))
+  expect_equal(df_100$x, quantile(x, ppoints(100), type = 5, names = FALSE))
+  expect_equal(df_100$sd, posterior::mcse_quantile(x, ppoints(100), names = FALSE))
+})

tests/testthat/test.stat_sample_slabinterval.R

@@ -36,7 +36,7 @@ test_that("gradientinterval works", {
 
 test_that("fill_type = 'gradient' works", {
   skip_if_no_vdiffr()
-  skip_if_no_linearGradient()
+  skip_if_no_gradient()
 
 
   set.seed(1234)

tests/testthat/test.util.R

@@ -61,3 +61,13 @@ test_that("dlply_ works properly", {
   expect_equal(dlply_(df, NULL, identity), list(df))
 
 })
+
+
+# stop_if_not_installed ---------------------------------------------------
+
+test_that("stop_if_not_installed works properly", {
+  e = tryCatch(stop_if_not_installed("_fake_package"), error = function(e) e)
+  expect_s3_class(e, c("ggdist_missing_package"))
+  expect_s3_class(e, c("error"))
+  expect_equal(e$ggdist_package, "_fake_package")
+})