删除 geom_histogram 的基线颜色

Question

我正在color为多面直方图添加美感。在下面的 reprex 中，没有颜色美感，直方图仅显示该方面级别内的数据。但是，在color定义的情况下，添加了一个基线，该基线将拉伸范围扩展为包括所有方面的数据范围。有没有办法让这种情况不发生？

我正在寻找类似于geom_densitywith 的东西trim = TRUE，但似乎没有修剪选项geom_histogram。

library(tidyverse)

data <- tibble(a = rchisq(1000, df = 3),
               b = rchisq(1000, df = 1),
               c = rchisq(1000, df = 10)) %>%
  gather()

ggplot(data, aes(x = value)) +
  geom_histogram() +
  facet_wrap(~ key, ncol = 1)
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

ggplot(data, aes(x = value)) +
  geom_histogram(color = "red") +
  facet_wrap(~ key, ncol = 1)
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

ggplot(data, aes(x = value)) +
  geom_density(color = "red", trim = TRUE) +
  facet_wrap(~ key, ncol = 1)

^{由reprex 包(v0.3.0)于 2019 年 7 月 20 日创建}

Answer 1

geom_histogram使用rectGrob来自 grid 包的using 绘制条形图，零宽度/零高度的 rectGrob 被描绘为轮廓颜色中的垂直/水平线，至少在我为 RStudio 的设置中（& OP 也是如此，我认为）。演示如下：

library(grid)

r1 <- rectGrob(width = unit(0, "npc"), gp = gpar(col = "red", fill = "grey")) # zero-width
r2 <- rectGrob(height = unit(0, "npc"), gp = gpar(col = "red", fill = "grey")) # zero-height

grid.draw(r1) # depicted as a vertical line, rather than disappear completely
grid.draw(r2) # depicted as a horizontal line, rather than disappear completely

在这种情况下，如果我们检查与直方图层相关联的数据帧中，有许多行与ymin= ymax= 0，这是负责在问题看到的“基线”的效果。

p <- ggplot(data, aes(x = value)) +
  geom_histogram(color = "red") +
  facet_wrap(~ key, ncol = 1)

View(layer_data(p) %>% filter(PANEL == 2)) # look at the data associated with facet panel 2

解决方法：由于数据计算是在 StatBin的compute_group函数的，我们可以定义同一函数的替代版本，并附加一个步骤以完全删除数据框中的 0 计数行：

# modified version of StatBin2 inherits from StatBin, except for an
# additional 2nd last line in compute_group() function
StatBin2 <- ggproto(
  "StatBin2", 
  StatBin,
  compute_group = function (data, scales, binwidth = NULL, bins = NULL, 
                            center = NULL, boundary = NULL, 
                            closed = c("right", "left"), pad = FALSE, 
                            breaks = NULL, origin = NULL, right = NULL, 
                            drop = NULL, width = NULL) {
    if (!is.null(breaks)) {
      if (!scales$x$is_discrete()) {
        breaks <- scales$x$transform(breaks)
      }
      bins <- ggplot2:::bin_breaks(breaks, closed)
    }
    else if (!is.null(binwidth)) {
      if (is.function(binwidth)) {
        binwidth <- binwidth(data$x)
      }
      bins <- ggplot2:::bin_breaks_width(scales$x$dimension(), binwidth, 
                                         center = center, boundary = boundary, 
                                         closed = closed)
    }
    else {
      bins <- ggplot2:::bin_breaks_bins(scales$x$dimension(), bins, 
                                        center = center, boundary = boundary, 
                                        closed = closed)
    }
    res <- ggplot2:::bin_vector(data$x, bins, weight = data$weight, pad = pad)

    # drop 0-count bins completely before returning the dataframe
    res <- res[res$count > 0, ] 

    res
  })

用法：

ggplot(data, aes(x = value)) +
  geom_histogram(color = "red", stat = StatBin2) + # specify stat = StatBin2
  facet_wrap(~ key, ncol = 1)