tests/testthat/test.stat_dist_slabinterval.R

In ggdist: Visualizations of Distributions and Uncertainty

# Tests for analytical distribution plots
#
# Author: mjskay
###############################################################################

suppressWarnings(suppressPackageStartupMessages({
  library(dplyr)
  library(distributional)
}))


mapped_discrete = getFromNamespace("mapped_discrete", "ggplot2")

test_that("distribution eye plots work with the args aesthetic", {
  skip_if_no_vdiffr()


  p = tribble(
    ~dist, ~args,
    "norm", list(0, 1),
    "beta", list(5, 5),
    NA, NA
  ) %>%
    ggplot(aes(dist = dist, args = args))

  expect_warning(
    vdiffr::expect_doppelganger("vertical eye using args without na.rm",
      p + stat_dist_eye(aes(x = dist), n = 20)
    ),
    "Removed 2 rows containing\\s+missing values"
  )

  vdiffr::expect_doppelganger("vertical eye using args",
    p + stat_dist_eye(aes(x = dist), na.rm = TRUE, n = 20)
  )

  vdiffr::expect_doppelganger("horizontal eye using args",
    p + stat_dist_eye(aes(y = dist), na.rm = TRUE, n = 20)
  )

  vdiffr::expect_doppelganger("vertical half-eye using args",
    p + stat_dist_halfeye(aes(x = dist), na.rm = TRUE, n = 20)
  )

  vdiffr::expect_doppelganger("horizontal half-eye using args",
    p + stat_dist_halfeye(aes(y = dist), na.rm = TRUE, n = 20)
  )

  vdiffr::expect_doppelganger("ccdfinterval using args",
    p + stat_dist_ccdfinterval(aes(x = dist), na.rm = TRUE, n = 25)
  )

  vdiffr::expect_doppelganger("ccdfintervalh using args",
    p + stat_dist_ccdfinterval(aes(y = dist), na.rm = TRUE, n = 25)
  )

  vdiffr::expect_doppelganger("cdfinterval using args",
    p + stat_dist_cdfinterval(aes(x = dist), na.rm = TRUE, n = 25)
  )

  vdiffr::expect_doppelganger("cdfintervalh using args",
    p + stat_dist_cdfinterval(aes(y = dist), na.rm = TRUE, n = 25)
  )

})

test_that("args and arg1...n work with named args", {
  skip_if_no_vdiffr()


  vdiffr::expect_doppelganger("named args for dist", {
    tibble(args = list(list(mean = 1)), sd = 2) %>%
      ggplot(aes(xdist = "norm", args = args, arg1 = sd)) +
      stat_halfeye(n = 15)
  })

})

test_that("layer data is correct", {
  p = data.frame(dist = dist_normal(0, 1)) %>%
    ggplot(aes(xdist = dist)) +
    stat_halfeye(n = 5, p_limits = c(0.01, 0.99))

  x = seq(qnorm(0.01), qnorm(0.99), length.out = 5)
  ref =
    data.frame(
      size = c(NA_real_, 1, 6, 1, NA_real_),
      thickness = dnorm(x),
      f = dnorm(x),
      pdf = dnorm(x),
      cdf = pnorm(x),
      n = Inf,
      x = x,
      datatype = "slab",
      .width = c(NA_real_, 0.95, 0.66, 0.95, NA_real_),
      level = ordered(c(NA, 0.95, 0.66, 0.95, NA), levels = c(0.95, 0.66)),
      .point = NA_character_,
      .interval = NA_character_,
      xmin = NA_real_,
      xmax = NA_real_,
      stringsAsFactors = FALSE
    ) %>%
    rbind(data.frame(
      size = c(6, 1),
      thickness = NA_real_,
      f = NA_real_,
      pdf = NA_real_,
      cdf = NA_real_,
      n = NA_real_,
      x = 0,
      datatype = "interval",
      .width = c(0.66, 0.95),
      level = ordered(c(0.66, 0.95), levels = c(0.95, 0.66)),
      .point = "median",
      .interval = "qi",
      xmin = qnorm(c(0.17, 0.025)),
      xmax = qnorm(c(0.83, 0.975)),
      stringsAsFactors = FALSE
    )) %>%
    cbind(data.frame(
      y = 0,
      height = 1,
      ymin = 0,
      ymax = 1,
      side = "topright",
      scale = 0.9,
      stringsAsFactors = FALSE
    ))
  ref$xdist = rep(list(dist_normal(0, 1)), 7)

  expect_equal(layer_data(p)[, names(ref)], ref)
})

test_that("xdist and ydist aesthetics work", {
  skip_if_no_vdiffr()


  df = data.frame(var = c(1,2), dist = dist_normal(0:1,1))

  vdiffr::expect_doppelganger("ydist",
    df %>%
      ggplot(aes(x = var, ydist = dist)) +
      stat_dist_halfeye(n = 15) +
      scale_y_continuous(limits = c(-7, 7))
  )

  vdiffr::expect_doppelganger("xdist",
    df %>%
      ggplot(aes(xdist = dist, y = var)) +
      stat_dist_halfeye(n = 15) +
      scale_x_continuous(limits = c(-7, 7))
  )

})

test_that("mapping dist to x or y gives helpful error", {
  df = data.frame(var = c(1,2), dist = dist_normal(0:1,1))

  expect_error(
    ggplot_build(
      df %>%
        ggplot(aes(x = var, y = dist)) +
        stat_dist_halfeye(n = 15)
    ),
    "Cannot use distribution or rvar"
  )

  expect_error(
    ggplot_build(
      df %>%
        ggplot(aes(x = dist, y = var)) +
        stat_dist_halfeye(n = 15)
    ),
    "Cannot use distribution or rvar"
  )
})

test_that("stat fill aesthetic on halfeye works", {
  skip_if_no_vdiffr()


  vdiffr::expect_doppelganger("gradient fill/color halfeye",
    tibble(dist = "norm", mean = 0, sd = 1) %>%
      ggplot(aes(
        y = 1, dist = dist, arg1 = mean, arg2 = sd,
        slab_color = after_stat(x > 0),
        fill = after_stat(f),
        slab_linetype = after_stat(x > -1),
        slab_linewidth = after_stat(x > 1)
      )) +
      stat_dist_halfeye(n = 10)
  )
})

test_that("stat_dist_gradientinterval works", {
  skip_if_no_vdiffr()


  p = tribble(
    ~dist, ~args,
    "norm", list(0, 1),
    "t", list(3)
  ) %>%
    ggplot(aes(dist = dist, args = args, fill = dist)) +
    scale_slab_alpha_continuous(range = c(0,1))

  vdiffr::expect_doppelganger("dist_gradientinterval with two groups",
    p + stat_dist_gradientinterval(aes(x = dist), n = 15, p_limits = c(0.01, 0.99), fill_type = "segments")
  )
  vdiffr::expect_doppelganger("dist_gradientintervalh with two groups",
    p + stat_dist_gradientinterval(aes(y = dist), n = 15, p_limits = c(0.01, 0.99), fill_type = "segments")
  )
})

test_that("fill_type = 'gradient' works", {
  skip_if_no_vdiffr()
  skip_if_no_gradient()


  p = tribble(
    ~dist, ~args,
    "norm", list(0, 1),
    "t", list(3)
  ) %>%
    ggplot(aes(dist = dist, args = args, fill = dist)) +
    scale_slab_alpha_continuous(range = c(0,1))

  vdiffr::expect_doppelganger("fill_type = gradient with two groups",
    p + stat_dist_gradientinterval(aes(x = dist), n = 15, p_limits = c(0.01, 0.99), fill_type = "gradient"),
    writer = write_svg_with_gradient
  )
  vdiffr::expect_doppelganger("fill_type = gradient with two groups, h",
    p + stat_dist_gradientinterval(aes(y = dist), n = 15, p_limits = c(0.01, 0.99), fill_type = "gradient"),
    writer = write_svg_with_gradient
  )
})

test_that("stat_dist_pointinterval, interval, and slab work", {
  skip_if_no_vdiffr()


  p = tribble(
    ~dist, ~args,
    "norm", list(0, 1),
    "t", list(3)
  ) %>%
    ggplot(aes(dist = dist, args = args)) +
    scale_color_brewer()

  vdiffr::expect_doppelganger("dist_pointinterval with two groups",
    p + stat_dist_pointinterval(aes(x = dist), n = 20)
  )
  vdiffr::expect_doppelganger("dist_pointintervalh with two groups",
    p + stat_dist_pointinterval(aes(y = dist), n = 20)
  )

  vdiffr::expect_doppelganger("dist_interval with two groups",
    p + stat_dist_interval(aes(x = dist), n = 20)
  )
  vdiffr::expect_doppelganger("dist_intervalh with two groups",
    p + stat_dist_interval(aes(y = dist), n = 20)
  )

  vdiffr::expect_doppelganger("dist_slab with two groups",
    p + stat_dist_slab(aes(x = dist), n = 15)
  )
  vdiffr::expect_doppelganger("dist_slabh with two groups",
    p + stat_dist_slab(aes(y = dist), n = 15)
  )
})

test_that("empty (0-length) distributions work", {
  expect_equal(layer_data(ggplot() + stat_halfeye(aes(xdist = NULL))), data.frame())
  expect_equal(layer_data(ggplot() + stat_halfeye(aes(xdist = list()))), data.frame())
  expect_equal(layer_data(ggplot() + stat_halfeye(aes(xdist = dist_missing()[-1]))), data.frame())

  skip_if_not_installed("posterior")
  expect_equal(layer_data(ggplot() + stat_halfeye(aes(xdist = posterior::rvar()))), data.frame())
})


# scale (and density) transformation --------------------------------------

test_that("density transformation works", {
  expect_equal(transform_pdf(dnorm, 1:5, scales::exp_trans()), dlnorm(1:5))
  expect_equal(transform_pdf(dlnorm, -2:2, scales::log_trans()), dnorm(-2:2))
})

test_that("scale transformation works", {
  skip_if_no_vdiffr()


  # this setup should yield a 95% interval from a little above 1e-3 to a little below 1e+5
  p_log = tibble(dist = "lnorm") %>%
    ggplot(aes(y = 1, dist = dist, arg1 = log(10), arg2 = 2*log(10))) +
    scale_x_log10(breaks = 10^seq(-5,7, by = 2))

  vdiffr::expect_doppelganger("dist_halfeyeh log scale transform",
    p_log + stat_dist_halfeye(n = 20)
  )

  vdiffr::expect_doppelganger("dist_ccdfintervalh log scale transform",
    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))

  vdiffr::expect_doppelganger("transformed scale with dist_wrap(lnorm)",
    p_log_wrap + stat_dist_halfeye(n = 20, point_interval = mode_hdci) + scale_x_log10()
  )


  p_rev = tibble(dist = "lnorm") %>%
    ggplot(aes(y = 1, dist = dist, arg1 = 1, arg2 = 0.5)) +
    scale_x_reverse()

  vdiffr::expect_doppelganger("dist_halfeyeh reverse scale transform",
    p_rev + stat_dist_halfeye(n = 40)
  )

  vdiffr::expect_doppelganger("ccdfinterval reverse scale transform",
    p_rev + stat_dist_ccdfinterval(n = 40)
  )


  # 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))

  vdiffr::expect_doppelganger("beta eye with logit scale",
    p_logit + stat_eye(n = 15, slab_color = "gray50")
  )


  # 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 sym diff",
    p_log_sym + stat_dist_halfeye(n = 20, point_interval = mode_hdi)
  )

})


test_that("scale transformation works on dist_sample", {
  skip_if_no_vdiffr()
  skip_if_sensitive_to_density()


  p_log_dist = data.frame(x = dist_sample(list(qlnorm(ppoints(200))))) %>%
    ggplot(aes(xdist = x, y = 0))

  vdiffr::expect_doppelganger("transformed scale with dist_sample",
    p_log_dist +
      stat_dist_halfeye(n = 20, point_interval = mode_hdci) +
      scale_x_log10() +
      geom_point(aes(x = x), data =  data.frame(x = range(qlnorm(ppoints(200)))))
  )

  p_log_samp = data.frame(x = qlnorm(ppoints(200))) %>%
    ggplot(aes(x = x, y = 0))

  vdiffr::expect_doppelganger("transformed scale with sample data on x",
    p_log_samp + stat_dist_halfeye(n = 20, point_interval = mode_hdi) + scale_x_log10()
  )
})


test_that("scale transformation sets appropriate axis limits", {
  p = data.frame(x = dist_lognormal(10, 0.5)) %>%
    ggplot(aes(xdist = x)) +
    stat_halfeye()

  # without scale transformation, the lower limit of a log-normal is finite
  # and so should be 0
  limits = range(layer_data(p)$x)
  expect_equal(limits[[1]], 0)
  expect_equal(limits[[2]], qlnorm(0.999, 10, 0.5))

  # with scale transformation, the lower limit is no longer finite, so it
  # should be set to the 0.001 quantile ...
  limits = range(layer_data(p + scale_x_log10())$x)
  expect_equal(limits[[1]], log(qlnorm(0.001, 10, 0.5), base = 10))
  expect_equal(limits[[2]], log(qlnorm(0.999, 10, 0.5), base = 10))

  # ... but if other data is added, it should be extended to cover that point
  limits = range(layer_data(p + scale_x_log10() + geom_point(aes(x = 2, y = 0)))$x)
  expect_equal(limits[[1]], log(2, base = 10))
})

test_that("scale transformation works when no slab is present", {
  ld = layer_data(
    data.frame(x = dist_lognormal(log(100), log(10))) %>%
      ggplot(aes(xdist = x)) +
      stat_pointinterval() +
      scale_x_log10()
  )

  ref = data.frame(
    size = c(6, 1),
    thickness = c(NA_real_, NA_real_),
    .width = c(.66, .95),
    .point = "median",
    .interval = "qi",
    x = 2,
    xmin = qnorm((1 - c(.66, .95))/2, 2, 1),
    xmax = qnorm((1 + c(.66, .95))/2, 2, 1),
    stringsAsFactors = FALSE
  )

  expect_equal(ld[, names(ref)], ref)
})


# orientation detection ---------------------------------------------------

test_that("orientation detection works properly on stat_dist", {
  skip_if_no_vdiffr()


  vdiffr::expect_doppelganger("stat_dist with no main axis",
    ggplot(data.frame(), aes(dist = "norm")) + stat_dist_slabinterval(n = 10)
  )

  vdiffr::expect_doppelganger("stat_dist with main axis of y",
    ggplot(data.frame(), aes(y = "a", dist = "norm")) + stat_dist_slabinterval(n = 10)
  )

  vdiffr::expect_doppelganger("stat_dist with main axis of x",
    ggplot(data.frame(), aes(x = "a", dist = "norm")) + stat_dist_slabinterval(n = 10)
  )

})

test_that("auto-grouping works on stat_dist", {
  skip_if_no_vdiffr()


  p = tibble(
    dist = c("norm", "norm"),
    x = c(1, 2)
  ) %>%
    ggplot(aes(dist = dist, arg1 = x, y = 0))

  vdiffr::expect_doppelganger("stat_dist with no grouping",
    p + stat_dist_slab(alpha = 0.5, n = 10)
  )

})

test_that("pdf and cdf aesthetics work", {
  skip_if_no_vdiffr()


  p = tribble(
    ~dist, ~args,
    "norm", list(0, 1),
    "t", list(3)
  ) %>%
    ggplot(aes(dist = dist, args = args, fill = dist, thickness = after_stat(pdf), slab_alpha = after_stat(cdf))) +
    scale_slab_alpha_continuous(range = c(0,1))

  vdiffr::expect_doppelganger("pdf and cdf on a slabinterval",
    p + stat_dist_slabinterval(aes(x = dist), n = 15, p_limits = c(0.01, 0.99))
  )
})

test_that("distributional objects work", {
  skip_if_no_vdiffr()


  p = tribble(
    ~name, ~dist,
    "norm", dist_normal(0, 1.5),
    "t", dist_student_t(3)
  ) %>%
    ggplot(aes(x = name, dist = dist))

  vdiffr::expect_doppelganger("dist objects in stat_dist_halfeye",
    p + stat_dist_halfeye(n = 15)
  )

  vdiffr::expect_doppelganger("dist objects in stat_dist_ccdfinterval",
    p + stat_dist_ccdfinterval(n = 15)
  )
})

test_that("dist_sample objects work", {
  skip_if_no_vdiffr()
  skip_if_sensitive_to_density()

  vdiffr::expect_doppelganger("dist_sample",
    tibble(
      x = dist_sample(list(qnorm(ppoints(100)), qnorm(ppoints(100), mean = 1)))
    ) %>%
      ggplot(aes(dist = x, y = "a")) +
      stat_dist_slab(fill = NA, color = "black", n = 15)
  )

})

test_that("stat_dist_ works on factor dist names", {
  skip_if_no_vdiffr()


  p = data.frame(
    x = factor(c("norm", "norm")),
    y = factor(c("a", "b"))
  ) %>%
    ggplot(aes(dist = x, y = y))

  vdiffr::expect_doppelganger("stat_dist_ with factor dist name",
    p + stat_dist_slabinterval(n = 15)
  )

})

test_that("automatic finite limits work", {
  skip_if_no_vdiffr()


  # this setup should yield a 95% interval from a little above 1e-3 to a little below 1e+5
  p = data.frame(dist = dist_beta(2,2)) %>%
    ggplot(aes(y = 0, dist = dist))

  vdiffr::expect_doppelganger("dist_slab beta(2,2)",
    p + stat_dist_slab(n = 31)
  )
})

test_that("justification can vary", {
  skip_if_no_vdiffr()

  p = tribble(
    ~id, ~name, ~dist,                ~just,
    1, "norm", dist_normal(0, 1.5),  1,
    2, "norm", dist_normal(0, 1),  0.5,
    3, "t",    dist_student_t(3),    0
  ) %>%
    ggplot(aes(x = id, dist = dist, justification = just))

  vdiffr::expect_doppelganger("ccdf with varying just",
    p + stat_dist_ccdfinterval(n = 15)
  )
})

test_that("NA distributional objects work", {
  skip_if_no_vdiffr()


  p = tribble(
    ~name, ~dist,
    "norm", dist_normal(0, 1.5),
    "missing", NULL
  ) %>%
    ggplot(aes(x = name, dist = dist))

  vdiffr::expect_doppelganger("NA dists in stat_dist_slabinterval",
    p + stat_dist_halfeye(n = 15, na.rm = TRUE)
  )

  vdiffr::expect_doppelganger("NA dists in stat_dist_dotsinterval",
    p + stat_dist_dotsinterval(n = 15, na.rm = TRUE)
  )

})

test_that("stat_dist_ throws appropriate errors on ill-formed dists", {
  expect_warning(
    invisible(ggplot_build(
      tibble(y = c("a","b","c"), x = list(1,2,3)) %>%
        ggplot(aes(y = y, dist = x)) + stat_dist_slabinterval()
    ))
    ,
    'The `dist` aesthetic does not support objects of type "numeric"'
  )

  expect_error(
    distr_cdf(dist_normal(c(0,1))),
    "length > 1"
  )
})


# discrete distributions --------------------------------------------------

test_that("stat_dist_ detects discrete distributions", {
  skip_if_no_vdiffr()


  p = tibble(lambda = c(13,7,2)) %>%
    ggplot(aes(x = lambda))

  vdiffr::expect_doppelganger("dist_poisson", {
    p + stat_dist_halfeye(aes(dist = dist_poisson(lambda)), slab_color = "gray50")
  })

  vdiffr::expect_doppelganger("dist_poisson ccdf", {
    p + stat_dist_ccdfinterval(aes(dist = dist_poisson(lambda)), slab_color = "gray50")
  })

  vdiffr::expect_doppelganger("dpois", {
    p + stat_dist_halfeye(aes(dist = "pois", arg1 = lambda), slab_color = "gray50", outline_bars = TRUE)
  })

  vdiffr::expect_doppelganger("dpois ccdf", {
    p + stat_dist_ccdfinterval(aes(dist = "pois", arg1 = lambda), slab_color = "gray50", outline_bars = TRUE)
  })

})

test_that("rvar_factor works", {
  skip_if_not_installed("posterior", "1.3.1.9000")

  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = posterior::rvar(c("a","a","a","b","b","c"))))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    pdf = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    cdf = NA_real_,
    f = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    n = 6,
    datatype = "slab",
    .width = NA_real_,
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)

  interval_ref = data.frame(
    datatype = "interval",
    .width = c(0.66, 0.95),
    stringsAsFactors = FALSE
  )
  interval_ref$xmin = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$xmax = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$x = mapped_discrete(c(NA_real_, NA_real_))
  attr(interval_ref, "row.names") = c(19L, 20L)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)

  x_scale = p$plot$scales$get_scales("x")
  expect_true(x_scale$is_discrete())
  expect_equal(x_scale$get_limits(), c("a","b","c"))
})

test_that("rvar_ordered works and integer dist_sample works", {
  skip_if_not_installed("posterior", "1.3.1.9000")

  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = posterior::rvar_ordered(c("a","a","a","b","b","c"))))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    pdf = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    cdf = c(0,0,0, 3,3,3,3,3,3, 5,5,5,5,5,5, 6,6,6)/6,
    f = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    n = 6,
    datatype = "slab",
    .width = c(NA,NA, .66,.66,.66,.66,.66,.66,.66,.66, .95,.95,.95,.95, NA,NA,NA,NA),
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)

  interval_ref = data.frame(
    datatype = "interval",
    .width = c(0.66, 0.95),
    stringsAsFactors = FALSE
  )
  interval_ref$xmin = mapped_discrete(c(1, 1))
  interval_ref$xmax = mapped_discrete(c(2.15, 2.875))
  interval_ref$x = mapped_discrete(c(1.5, 1.5))
  attr(interval_ref, "row.names") = c(19L, 20L)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)

  x_scale = p$plot$scales$get_scales("x")
  expect_true(x_scale$is_discrete())
  expect_equal(x_scale$get_limits(), c("a","b","c"))


  # integer dist_sample
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_sample(list(c(1L,1L,1L,2L,2L,3L)))))
  )
  slab_ref$x = as.numeric(slab_ref$x)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)
  interval_ref$x = as.numeric(interval_ref$x)
  interval_ref$xmin = as.numeric(interval_ref$xmin)
  interval_ref$xmax = as.numeric(interval_ref$xmax)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)
})

test_that("rvar_ordered works with modified scale limits", {
  skip_if_not_installed("posterior", "1.3.1.9000")

  p = ggplot_build(
    ggplot() +
      stat_slab(aes(xdist = posterior::rvar_ordered(c("a","a","a","c")))) +
      scale_x_discrete(limits = c("a","b","c"))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 0,0,0,0,0,0, 1,1,1,1,1,1)/4,
    pdf = c(3,3,3,3,3,3, 0,0,0,0,0,0, 1,1,1,1,1,1)/4,
    cdf = c(0,0,0, 3,3,3,3,3,3, 3,3,3,3,3,3, 4,4,4)/4,
    f = c(3,3,3,3,3,3, 0,0,0,0,0,0, 1,1,1,1,1,1)/4,
    n = 4,
    datatype = "slab",
    .width = c(NA,NA, .66,.66,.66,.66,.66,.66, .95,.95,.95,.95,.95,.95, NA,NA,NA,NA),
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][, names(slab_ref)], slab_ref)
})

test_that("rvar(<logical>) works", {
  skip_if_not_installed("posterior", "1.3.1.9000")

  p = ggplot_build(
    ggplot() + stat_slab(aes(xdist = posterior::rvar(c(TRUE,TRUE,TRUE,FALSE))))
  )

  expect_snapshot_value(
    as.list(p$data[[1]][, c("thickness","pdf","cdf","n","x","y",".width")]),
    style = "deparse", cran = TRUE
  )
})

test_that("dist_bernoulli works", {
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_bernoulli(0.8)))
  )

  slab_ref = data.frame(
    thickness = c(.2,.2,.2,.2,.2,.2, .8,.8,.8,.8,.8,.8),
    pdf = c(.2,.2,.2,.2,.2,.2, .8,.8,.8,.8,.8,.8),
    cdf = c(0,0,0, .2,.2,.2,.2,.2,.2, 1,1,1),
    f = c(.2,.2,.2,.2,.2,.2, .8,.8,.8,.8,.8,.8),
    n = Inf,
    datatype = "slab",
    .width = c(NA,NA, .66,.66,.66,.66,.66,.66,.66,.66, NA,NA),
    x = c(-.5,-.5, 0,0, .5,.5,.5,.5, 1,1, 1.5,1.5),
    stringsAsFactors = FALSE
  )
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)

  interval_ref = data.frame(
    datatype = "interval",
    .width = c(0.66, 0.95),
    xmin = c(0, 0),
    xmax = c(1, 1),
    x = c(1, 1),
    stringsAsFactors = FALSE
  )
  attr(interval_ref, "row.names") = c(13L, 14L)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)

  x_scale = p$plot$scales$get_scales("x")
  expect_false(x_scale$is_discrete())
  expect_equal(x_scale$get_limits(), c(0, 1))
})

test_that("dist_categorical works", {
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_categorical(list(3:1/6), list(c("a","b","c")))))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    pdf = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    cdf = NA_real_,
    f = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    n = Inf,
    datatype = "slab",
    .width = NA_real_,
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)

  interval_ref = data.frame(
    datatype = "interval",
    .width = c(0.66, 0.95),
    stringsAsFactors = FALSE
  )
  interval_ref$xmin = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$xmax = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$x = mapped_discrete(c(NA_real_, NA_real_))
  attr(interval_ref, "row.names") = c(19L, 20L)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)

  x_scale = p$plot$scales$get_scales("x")
  expect_true(x_scale$is_discrete())
  expect_equal(x_scale$get_limits(), c("a","b","c"))

  # with integer categorical distribution
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_categorical(list(3:1/6))))
  )
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)
})

test_that("dist_categorical works with modified scale limits", {
  p = ggplot_build(
    ggplot() +
      stat_slab(aes(xdist = dist_categorical(list(c(3,1)/4), list(c("a","c"))))) +
      scale_x_discrete(limits = c("a","b","c"))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, NA,NA,NA,NA,NA,NA, 1,1,1,1,1,1)/4,
    pdf = c(3,3,3,3,3,3, NA,NA,NA,NA,NA,NA, 1,1,1,1,1,1)/4,
    cdf = NA_real_,
    f = c(3,3,3,3,3,3, NA,NA,NA,NA,NA,NA, 1,1,1,1,1,1)/4,
    n = Inf,
    datatype = "slab",
    .width = NA_real_,
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][, names(slab_ref)], slab_ref)

})

test_that("dist_categorical works with explicit integer levels", {
  p = ggplot_build(
    ggplot() +
      stat_slab(aes(xdist = dist_categorical(list(c(3,1)/4), list(c(1L,3L)))))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 1,1,1,1,1,1)/4,
    pdf = c(3,3,3,3,3,3, 1,1,1,1,1,1)/4,
    cdf = NA_real_,
    f = c(3,3,3,3,3,3, 1,1,1,1,1,1)/4,
    n = Inf,
    datatype = "slab",
    .width = NA_real_,
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5))
  expect_equal(p$data[[1]][, names(slab_ref)], slab_ref)
})

test_that("dist_sample works", {
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_categorical(list(3:1/6), list(c("a","b","c")))))
  )

  slab_ref = data.frame(
    thickness = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    pdf = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    cdf = NA_real_,
    f = c(3,3,3,3,3,3, 2,2,2,2,2,2, 1,1,1,1,1,1)/6,
    n = Inf,
    datatype = "slab",
    .width = NA_real_,
    stringsAsFactors = FALSE
  )
  slab_ref$x = mapped_discrete(c(.5,.5, 1,1, 1.5,1.5,1.5,1.5, 2,2, 2.5,2.5,2.5,2.5, 3,3, 3.5,3.5))
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)

  interval_ref = data.frame(
    datatype = "interval",
    .width = c(0.66, 0.95),
    stringsAsFactors = FALSE
  )
  interval_ref$xmin = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$xmax = mapped_discrete(c(NA_real_, NA_real_))
  interval_ref$x = mapped_discrete(c(NA_real_, NA_real_))
  attr(interval_ref, "row.names") = c(19L, 20L)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)

  x_scale = p$plot$scales$get_scales("x")
  expect_true(x_scale$is_discrete())
  expect_equal(x_scale$get_limits(), c("a","b","c"))

  # with integer categorical distribution
  p = ggplot_build(
    ggplot() +
      stat_slabinterval(aes(xdist = dist_categorical(list(3:1/6))))
  )
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "slab", names(slab_ref)], slab_ref)
  expect_equal(p$data[[1]][p$data[[1]]$datatype == "interval", names(interval_ref)], interval_ref)
})

test_that("logical conditions at bin edges on histograms work", {
  p = ggplot() +
    stat_slab(aes(xdist = dist_poisson(1), fill = after_stat(x > 0.5))) +
    scale_fill_manual(values = c("red", "blue"))

  ref = data.frame(
    x = c(
      -0.5, -0.5, 0, 0, 0.5, 0.5, 0.5, 0.5, 1, 1, 1.5, 1.5, 1.5, 1.5,
      2, 2, 2.5, 2.5, 2.5, 2.5, 3, 3, 3.5, 3.5, 3.5, 3.5, 4, 4, 4.5,
      4.5, 4.5, 4.5, 5, 5, 5.5, 5.5
    ),
    fill = c(rep("red", 7), rep("blue", 29)),
    stringsAsFactors = FALSE
  )
  expect_equal(layer_data(p)[,c("x", "fill")], ref)

  # with outline
  p = ggplot() +
    stat_slab(
      aes(xdist = dist_poisson(1), fill = after_stat(x > 0.5)),
      outline_bars = TRUE, color = "black"
    ) +
    scale_fill_manual(values = c("red", "blue"))

  ref = data.frame(
    x = c(
      -0.5, -0.5, -0.5, 0, 0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 1, 1,
      1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 2, 2, 2.5, 2.5, 2.5, 2.5, 2.5,
      2.5, 3, 3, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 4, 4, 4.5, 4.5, 4.5,
      4.5, 4.5, 4.5, 5, 5, 5.5, 5.5, 5.5
    ),
    fill = c(rep("red", 10), rep("blue", 38)),
    stringsAsFactors = FALSE
  )
  expect_equal(layer_data(p)[,c("x", "fill")], ref)
})


# grouping order ----------------------------------------------------------

test_that("stat_dist_ preserves existing grouping order", {
  skip_if_no_vdiffr()


  df = tribble(
    ~Model, ~Parameter, ~Coefficient,  ~SE, ~linetype,
    "C",       "MZ",         0.34, 0.07,    "dashed",
    "C",     "Ereg",         0.28, 0.06,    "twodash",
    "C",     "AE-Beta",      0.25, 0.06,    "solid",
    "D",       "MZ",         0.31, 0.08,    "dashed"
  )

  # the labels should overlap the points exactly if grouping order is preserved
  vdiffr::expect_doppelganger("grouped labels with pointintervals",
    df %>%
      ggplot() +
      aes(x = Model, y = Coefficient,
        label = Parameter, color = Parameter,
        group = linetype,
        dist = dist_normal(mu = Coefficient, sigma = SE)
      ) +
      stat_dist_pointinterval(position = "dodge") +
      geom_label(position = position_dodge(width = 1))
  )

})


# constant distributions --------------------------------------------------

test_that("constant distributions work", {
  skip_if_no_vdiffr()


  p = tibble(
    x = c("constant = 1", "normal(2,1)", "constant = 2"),
    y = c(dist_normal(1:2, 0:1), dist_sample(list(2)))
  ) %>%
    ggplot(aes(x = x, dist = y))

  vdiffr::expect_doppelganger("constant dist on halfeye",
    p + stat_dist_slabinterval(n = 15, slab_color = "blue")
  )

  vdiffr::expect_doppelganger("constant dist on halfeye expanded",
    p + stat_dist_slabinterval(n = 15, slab_color = "blue", expand = TRUE)
  )

  vdiffr::expect_doppelganger("constant dist on ccdf",
    p + stat_dist_ccdfinterval(slab_color = "blue", n = 15)
  )

  # with a scale transformation...
  p = tibble(
    x = c("constant = 10", "lognormal(2,1)", "constant = 2"),
    y = c(dist_wrap("lnorm", c(log(10), 2), 0:1), dist_sample(list(2)))
  ) %>%
    ggplot(aes(x = x, dist = y)) +
    scale_y_log10()

  vdiffr::expect_doppelganger("constant dist on halfeye, log scale",
    p + stat_dist_slabinterval(n = 15, slab_color = "blue")
  )

  vdiffr::expect_doppelganger("constant dist on ccdf, log scale",
    p + stat_dist_ccdfinterval(slab_color = "blue", n = 15)
  )

  # with sample data...
  p = data.frame(
    x = c(5, 5)
  ) %>%
    ggplot(aes(x = x)) +
    expand_limits(x = c(0,10))

  vdiffr::expect_doppelganger("constant dist on halfeye, sample data",
    p + stat_dist_slabinterval(n = 15, slab_color = "blue")
  )

  vdiffr::expect_doppelganger("constant dist on ccdf, sample data",
    p + stat_dist_ccdfinterval(n = 15, slab_color = "blue")
  )

})


# point_interval ----------------------------------------------------------

test_that("point_interval works", {
  skip_if_no_vdiffr()


  p = data.frame(
    x = dist_mixture(dist_normal(0, 0.5), dist_normal(4, 1), weights = c(0.5, 0.5))
  ) %>%
    ggplot(aes(xdist = x))

  vdiffr::expect_doppelganger("mixture dist with median_qi",
    p + stat_dist_halfeye(point_interval = median_qi, n = 30)
  )

  vdiffr::expect_doppelganger("mixture dist with NULL point_interval",
    p + stat_dist_halfeye(point_interval = NULL, n = 30)
  )

  # need to set.seed here until https://github.com/mitchelloharawild/distributional/issues/71 is fixed
  set.seed(1234)
  vdiffr::expect_doppelganger("mixture dist with mean_qi",
    p + stat_dist_halfeye(point_interval = mean_qi, n = 30)
  )

  vdiffr::expect_doppelganger("mixture dist with mode_hdi",
    p + stat_dist_halfeye(point_interval = mode_hdi, n = 30)
  )

})


# rvars -------------------------------------------------------------------

test_that("rvars work", {
  skip_if_no_vdiffr()
  skip_if_not_installed("posterior")
  skip_if_sensitive_to_density()


  set.seed(1234)
  p = tibble(
    mu = 1:2,
    x = posterior::rvar_rng(rnorm, 2, mu, 1:2)
  ) %>%
    ggplot(aes(y = mu, xdist = x, fill = after_stat(cdf)))

  vdiffr::expect_doppelganger("halfeye with rvar and cdf",
    p + stat_halfeye(n = 20, trim = FALSE, expand = TRUE, slab_color = "black")
  )
})


# missing rvars and dists -------------------------------------------------

test_that("missing distributions work", {
  expect_warning(
    expect_equal(
      layer_data(ggplot() + stat_slabinterval(aes(xdist = dist_missing()))),
      data.frame()
    ),
    "Removed 1 row.+missing values"
  )
})

test_that("missing rvars work", {
  skip_if_not_installed("posterior")

  expect_warning(
    expect_equal(
      layer_data(ggplot() + stat_slabinterval(aes(xdist = posterior::rvar(c(1,NA))))),
      data.frame()
    ),
    "Removed 1 row.+missing values"
  )

  skip_if_not_installed("posterior", "1.3.1.9000")
  expect_warning(
    expect_equal(
      layer_data(
        ggplot() +
          stat_slabinterval(aes(xdist = posterior::rvar(c("a","b")))) +
          scale_x_discrete(limits = "a")
      ),
      data.frame()
    ),
    "Removed 1 row.+missing values"
  )
})


# without attaching ggdist namespace --------------------------------------

test_that("stats work without attaching the ggdist namespace", {
  skip_if_no_vdiffr()

  ggdist_pos = which(search() == "package:ggdist")
  detach("package:ggdist")                                         # nolint
  on.exit(suppressPackageStartupMessages(
    attach(getNamespace("ggdist"), ggdist_pos, "package:ggdist")   # nolint
  ))

  vdiffr::expect_doppelganger("simple halfeye",
    data.frame(x = dist_normal(0,1)) %>%
      ggplot(aes(xdist = x)) +
      ggdist::stat_halfeye()
  )
})


# multiple dists with unique groups ---------------------------------------

test_that("multiple dists supplied to the same group", {
  skip_if_no_vdiffr()

  p = data.frame(
    y = dist_normal(c(0, 10, 20, 0, 10, 20)),
    x = c(0,0,0,1,1,1)
  ) %>%
    ggplot(aes(ydist = y, x = x, group = rep(c("a","a","b"), 2)))


  # multiple dists can be supplied to the same group with slabinterval,
  # since they can be distinguished ...
  vdiffr::expect_doppelganger("halfeye multiple dists per group",
    p + stat_halfeye()
  )

  # but not to lineribbon, since they can't be distinguished
  expect_warning(ggplot_build(p + stat_lineribbon()),
    "Distributions passed to the `dist` aesthetic must be uniquely associated"
  )
})