diff --git a/R/trace_generation.R b/R/trace_generation.R index 7f448dd66e..3cdf9f465d 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -252,9 +252,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 8c0f4a4517..93a1752ea8 100644 --- a/tests/testthat/test-ggplot-density.R +++ b/tests/testthat/test-ggplot-density.R @@ -26,7 +26,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")) @@ -42,3 +43,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 b66c17950f..d576038b8c 100644 --- a/tests/testthat/test-ggplot-histogram.R +++ b/tests/testthat/test-ggplot-histogram.R @@ -47,7 +47,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]] @@ -63,6 +63,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"))