tests/testthat/test-ggplot-histogram.R

In plotly: Create Interactive Web Graphics via 'plotly.js'

expect_traces <- function(gg, n.traces, name) {
  stopifnot(is.numeric(n.traces))
  L <- expect_doppelganger_built(gg, paste0("histogram-", name))
  all.traces <- L$data
  no.data <- sapply(all.traces, function(tr) {
    is.null(tr[["x"]]) && is.null(tr[["y"]])
  })
  has.data <- all.traces[!no.data]
  expect_equivalent(length(has.data), n.traces)
  list(data = has.data, layout = L$layout)
}

base <- ggplot(mtcars, aes(wt))

test_that("geom_histogram() is a bar chart of counts with no bargap", { 
  info <- expect_traces(base + geom_histogram(), 1, "counts")
  tr <- info$data[[1]]
  expect_identical(tr$type, "bar")
  expect_equivalent(sum(tr$y), nrow(mtcars))
  expect_equivalent(info$layout$barmode, "relative")
})

test_that("geom_histogram(aes(y = after_stat(density))) displays a density", { 
  info <- expect_traces(base + geom_histogram(aes(y=after_stat(density))), 1, "density")
  tr <- info$data[[1]]
  expect_identical(tr$type, "bar")
  #default binwidth
  bw <- (max(tr$x) - min(tr$x))/30
  area <- sum(tr$y) * bw
  # the "area" of the plot (should be 1).
  # note this also serves as a check for the default binwidth
  expect_equal(area, 1, tolerance = 0.1)
})

test_that("geom_histogram(aes(fill = after_stat(count))) works", {
  info <- expect_traces(base + geom_histogram(aes(fill = after_stat(count))), 6, "fill")
  # grab just the bar traces (there should also be a colorbar)
  bars <- info$data[sapply(info$data, "[[", "type") == "bar"]
  # each traces should have the same value of y
  for (i in seq_along(bars)) {
    ys <- bars[[i]]$y
    expect_equivalent(length(unique(ys)), 1)
  }
})

test_that("Histogram with fixed colour/fill works", {
  gg <- base + geom_histogram(colour = "darkgreen", fill = "white")
  info <- expect_traces(gg, 1, "fixed-fill-color")
  tr <- info$data[[1]]
  expect_true(tr$marker$color == "rgba(255,255,255,1)")
  expect_true(tr$marker$line$color == "rgba(0,100,0,1)")
})

test_that("Specify histogram binwidth", {
  gg <- base + geom_histogram(aes(y=after_stat(density)), binwidth = 0.3)
  info <- expect_traces(gg, 1, "density-binwidth")
  tr <- info$data[[1]]
  area <- sum(tr$y) * 0.3
  expect_equivalent(area, 1, 0.1)
})

test_that("geom_histogram(aes(fill = factor(...))) is a stacked by default", {
  gg <- base + geom_histogram(aes(fill = factor(vs)))
  info <- expect_traces(gg, 2, "fill-factor")
  expect_equivalent(info$layout$barmode, "relative")
})

test_that("geom_histogram(aes(fill = factor(...))) respects position_identity()", {
  gg <- base + geom_histogram(
    aes(fill = factor(vs)), alpha = 0.3, position = "identity"
  )
  info <- expect_traces(gg, 2, "fill-factor-identity")
  expect_equivalent(info$layout$barmode, "relative")
})

test_that("geom_histogram(aes(fill = factor(...))) respects position_dodge()", {
  gg <- base + geom_histogram(
    aes(fill = factor(vs)), alpha = 0.3, position = "dodge"
  )
  info <- expect_traces(gg, 2, "fill-factor-dodge")
  expect_equivalent(info$layout$barmode, "relative")
})

test_that("geom_histogram() with facets", {
  gg <- base + geom_histogram(aes(fill = factor(vs)), alpha = 0.3) + 
    facet_wrap(~am)
  info <- expect_traces(gg, 4, "fill-factor-facets")
  trs <- info$data
  type <- unique(sapply(trs, "[[", "type"))
  gap <- unique(sapply(trs, "[[", "bargap"))
  barmode <- unique(sapply(trs, "[[", "barmode"))
  expect_identical(type, "bar")
  expect_equivalent(info$layout$barmode, "relative")
})

test_that("vline overlaid histogram", {
  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
  
  gg <- base + geom_histogram() +
    geom_vline(aes(xintercept=mean(wt)), color="red", linetype="dashed", linewidth=1)
  info <- expect_traces(gg, 2, "vline")
  trs <- info$data
  type <- unique(sapply(trs, "[[", "type"))
  expect_identical(sort(type), c("bar", "scatter"))
})

# Non-numeric (date) data
noram <- data.frame(
  month = c("2012-01-01", "2012-02-01", "2012-01-01", "2012-01-01", 
            "2012-03-01", "2012-02-01")
)
noram$month <- as.Date(noram$month)

test_that("dates work well with histograms", {
  hist <- ggplot(noram, aes(month)) + geom_histogram()
  info <- expect_traces(hist, 1, "dates")
})

# Non-numeric (date) data, specifying binwidth
killed <- data.frame(date=c("2014-12-24",
                            "2014-12-23",
                            "2014-12-22",
                            "2014-12-22",
                            "2014-12-22",
                            "2014-12-18",
                            "2014-12-22",
                            "2014-12-21",
                            "2014-12-21",
                            "2014-12-21",
                            "2014-12-20",
                            "2014-12-19",
                            "2014-12-18",
                            "2014-12-18",
                            "2014-12-17",
                            "2014-12-17",
                            "2013-12-20",
                            "2014-04-25",
                            "2014-12-01",
                            "2014-12-17",
                            "2014-12-17",
                            "2014-12-17",
                            "2014-12-17",
                            "2014-12-17",
                            "2014-12-17",
                            "2014-12-15",
                            "2014-12-15",
                            "2014-12-15",
                            "2014-12-14",
                            "2014-12-14",
                            "2014-12-14",
                            "2014-12-13",
                            "2014-12-13",
                            "2013-05-18",
                            "2014-12-13",
                            "2014-12-12",
                            "2014-12-12",
                            "2014-12-11",
                            "2014-12-10",
                            "2014-12-10",
                            "2014-12-10",
                            "2014-12-10",
                            "2014-12-09",
                            "2014-12-09",
                            "2014-12-09",
                            "2014-12-09",
                            "2014-12-08",
                            "2014-12-08",
                            "2014-12-08",
                            "2014-12-07",
                            "2014-12-08",
                            "2014-12-07",
                            "2014-05-01",
                            "2014-12-05",
                            "2014-12-05",
                            "2014-12-05",
                            "2014-12-04",
                            "2014-12-04",
                            "2014-12-04",
                            "2014-07-13",
                            "2014-12-02",
                            "2014-12-03",
                            "2014-12-03",
                            "2014-12-02",
                            "2014-12-02",
                            "2014-12-01",
                            "2014-12-01",
                            "2014-12-01",
                            "2014-04-02",
                            "2014-11-30",
                            "2014-11-30",
                            "2014-11-29",
                            "2014-11-28",
                            "2014-11-29",
                            "2014-11-27",
                            "2014-11-28",
                            "2014-11-27",
                            "2014-11-26",
                            "2014-11-25",
                            "2014-11-26",
                            "2014-11-25",
                            "2014-11-25",
                            "2014-11-24",
                            "2014-11-24",
                            "2014-11-23",
                            "2014-11-23",
                            "2014-11-24",
                            "2014-11-23",
                            "2014-11-22",
                            "2014-11-23",
                            "2014-11-22",
                            "2014-11-22",
                            "2014-11-21",
                            "2014-11-21",
                            "2014-11-21",
                            "2014-11-20",
                            "2014-11-20",
                            "2014-11-20",
                            "2014-11-19"))

test_that("datetime binning for class POSIXt works in histograms", {
  kP <- killed
  kP$date <- as.POSIXct(kP$date)
  histP <- ggplot(kP, aes(x = date)) + geom_histogram(binwidth = 2592000)
  info <- expect_traces(histP, 1, "POSIXt-bins")
})

test_that("datetime binning for class Date works in histograms", {
  kD <- killed
  kD$date <- as.Date(kD$date)
  histD <- ggplot(kD, aes(x = date)) + geom_histogram(binwidth = 30)
  info <- expect_traces(histD, 1, "Date-bins")
})