From 237b910e16197f12b3005a2a08fa7f3af07d11f1 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Thu, 30 Apr 2015 19:40:42 -0500
Subject: [PATCH] Add some tests inspired by cookbook distributions. Helped
 identify a difference in position_identity() for histograms and bar charts

---
 R/trace_generation.R                   | 11 +++--
 tests/testthat/test-ggplot-density.R   | 14 +++++-
 tests/testthat/test-ggplot-histogram.R | 65 +++++++++++++++++++++++++-
 3 files changed, 85 insertions(+), 5 deletions(-)

diff --git a/R/trace_generation.R b/R/trace_generation.R
index de902b19d5..52b2735244 100644
--- a/R/trace_generation.R
+++ b/R/trace_generation.R
@@ -247,9 +247,14 @@ layer2traces <- function(l, d, misc) {
     if (g$geom == "bar") {
       tr$bargap <- if (exists("bargap")) bargap else "default"
       pos <- l$position$.super$objname
-      tr$barmode <- if (pos %in% c("identity", "stack", "fill")) {
-        "stack"
-      } else "group"
+      tr$barmode <-
+        if (pos %in% "identity" && tr$bargap == 0) {
+          "overlay" 
+        } else if (pos %in% c("identity", "stack", "fill")) {
+          "stack"
+        } else {
+        "group"
+      }
     }
     
     traces <- c(traces, list(tr))
diff --git a/tests/testthat/test-ggplot-density.R b/tests/testthat/test-ggplot-density.R
index 0d77b191d4..148dbc175d 100644
--- a/tests/testthat/test-ggplot-density.R
+++ b/tests/testthat/test-ggplot-density.R
@@ -27,7 +27,8 @@ test_that("geom_density() is translated to area chart", {
 })
 
 test_that("geom_density() respects fill aesthetic", {
-  info <- expect_traces(base + geom_density(aes(fill=factor(vs))), 2, "fill")
+  gg <- base + geom_density(aes(fill=factor(vs)), alpha = 0.3)
+  info <- expect_traces(gg, 2, "fill")
   trs <- info$traces
   type <- unique(sapply(trs, "[[", "type"))
   fill <- unique(sapply(trs, "[[", "fill"))
@@ -43,3 +44,14 @@ test_that("geom_density() respects colour aesthetic", {
   expect_identical(type, "scatter")
   expect_identical(fill, "tozeroy")
 })
+
+g <- base + 
+  geom_histogram(aes(y = ..density..), binwidth = 0.5, fill = "pink") +
+  geom_density(fill = "lightblue", alpha = 0.1)
+  
+test_that("geom_histogram(aes(y = ..density..)) + geom_density() works", {
+  info <- expect_traces(g, 2, "color")
+  trs <- info$traces
+  type <- unique(sapply(trs, "[[", "type"))
+  expect_identical(sort(type), c("bar", "scatter"))
+})
diff --git a/tests/testthat/test-ggplot-histogram.R b/tests/testthat/test-ggplot-histogram.R
index d0aaeb7ea5..101bbb532f 100644
--- a/tests/testthat/test-ggplot-histogram.R
+++ b/tests/testthat/test-ggplot-histogram.R
@@ -48,7 +48,7 @@ test_that("geom_histogram(aes(fill = ..count..)) works", {
   }
 })
 
-test_that("Fixed colour/fill works", {
+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$traces[[1]]
@@ -64,6 +64,69 @@ test_that("Specify histogram binwidth", {
   expect_equal(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")
+  trs <- info$traces
+  type <- unique(sapply(trs, "[[", "type"))
+  gap <- unique(sapply(trs, "[[", "bargap"))
+  barmode <- unique(sapply(trs, "[[", "barmode"))
+  expect_identical(type, "bar")
+  expect_equal(gap, 0)
+  expect_equal(barmode, "stack")
+})
+
+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")
+  trs <- info$traces
+  type <- unique(sapply(trs, "[[", "type"))
+  gap <- unique(sapply(trs, "[[", "bargap"))
+  barmode <- unique(sapply(trs, "[[", "barmode"))
+  expect_identical(type, "bar")
+  expect_equal(gap, 0)
+  expect_equal(barmode, "overlay")
+})
+
+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")
+  trs <- info$traces
+  type <- unique(sapply(trs, "[[", "type"))
+  gap <- unique(sapply(trs, "[[", "bargap"))
+  barmode <- unique(sapply(trs, "[[", "barmode"))
+  expect_identical(type, "bar")
+  expect_equal(gap, 0)
+  expect_equal(barmode, "group")
+})
+
+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$traces
+  type <- unique(sapply(trs, "[[", "type"))
+  gap <- unique(sapply(trs, "[[", "bargap"))
+  barmode <- unique(sapply(trs, "[[", "barmode"))
+  expect_identical(type, "bar")
+  expect_equal(gap, 0)
+  expect_equal(barmode, "stack")
+})
+
+test_that("vline overlaid histogram", {
+  gg <- base + geom_histogram() +
+    geom_vline(aes(xintercept=mean(wt)), color="red", linetype="dashed", size=1)
+  info <- expect_traces(gg, 2, "vline")
+  trs <- info$traces
+  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"))