ggplot2: geom_ribbon的填充颜色行为

Question

我正在尝试在ggplot2中着色彩带。使用geom_ribbon时，我可以指定ymin和ymax以及填充颜色。但它现在的作用是只要在ymin和ymax之间的所有内容都会被着色，而不考虑上限或下限。

示例（经过修改来自互联网）：

library("ggplot2")
# Generate data (level2 == level1)
huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron), level2 = as.vector(LakeHuron))

# Change Level2
huron[1:50,2] <- huron[1:50,2]+100
huron[50:90,2] <- huron[50:90,2]-100

h <- ggplot(huron, aes(year))

h +
  geom_ribbon(aes(ymin = level, ymax = level2), fill = "grey80") +
  geom_line(aes(y = level)) + geom_line(aes(y=level2))

将导致此图表：

我想要填充区域，其中(ymin > ymax)，用不同的颜色而不是(ymin < ymax)的颜色。在我的真实数据中，我有出口和进口值。在那里，我想将出口高于进口的颜色设置为绿色，将进口大于出口的色带设置为红色。

替代方案：我想让geom_ribbon只填充ymax > ymin的区域。

有人知道如何做到这一点吗？

感谢您的帮助。

- ManuK

Answer 1

不需要手动创建另一列的选项是在aes(fill =内部进行逻辑处理。

## fill dependent on level > level2
h + 
  geom_ribbon(aes(ymin = level, ymax = level2, fill = level > level2)) +
  geom_line(aes(y = level)) + geom_line(aes(y=level2)) +
  scale_fill_manual(values=c("red", "green"), name="fill")

或者，如果您只想在该条件为真时进行填充，

## fill dependent on level > level2, no fill otherwise
h + 
  geom_ribbon(aes(ymin = level, ymax = level2, fill = ifelse(level > level2, TRUE, NA))) +
  geom_line(aes(y = level)) + geom_line(aes(y=level2)) +
  scale_fill_manual(values=c("green"), name="fill")

我认为插值填充缺失似乎与ggplot2版本有关，因为我用@beetroot的代码得到了同样的结果。

## @beetroot's answer
huron$id <- 1:nrow(huron)
huron$group <- ifelse(huron$id <= 50, "A", "B") 

h <- ggplot(huron, aes(year))
h +
  geom_ribbon(aes(ymin = level, ymax = level2, fill = group)) +
  geom_line(aes(y = level)) + geom_line(aes(y = level2))    

当我运行那段没有逻辑的代码时，会得到@ManuK的图像输出结果：

- Jonathan Carroll

---

哇，这太棒了，非常感谢！这正是我想要的，因为我可以将条件基本上放入“fill =”中。然而，我会保留我的更改请求，因为它并不完美：填充不能完美地应用于交点。 （这次对我来说没有问题）此外，我仍然认为ggplot2中的填充逻辑需要改变。 - ManuK

非常有用！有没有办法用长格式的数据达到同样的结果呢？例如，将您的数据设置为：年份、级别（1或2）、值。 我可以做到：h + geom_line(aes(y=Value, group=Level)，但我不知道如何使用这种结构添加geom_ribbon()图层。 - Anthony S.

我认为不太容易。ggplot2需要列数据，所以你需要有一列可以作为ymin和ymax值的数据。不过使用tidyr::spread()将长格式的数据转换成所需格式是相当直观的。 - Jonathan Carroll

好的，我本来希望能避免更改格式，但没办法。谢谢Jono！ - Anthony S.

Answer 2

您可以向数据中添加一个分组变量，以便指定填充颜色。但问题在于两条线相交的点，它需要包括在两个分组中，以防止出现任何间隙。

因此，首先找到这一行...

huron[huron$level == huron$level2,]

> huron[huron$level == huron$level2,]
     year  level level2 
50   1924 577.79 577.79 
...

将其再次添加到数据中：

huron <- rbind(huron, huron[huron$year == 1924,])
huron <- huron[order(huron$year),]

然后根据行索引添加一个id列，并根据1924年的行号设置分组：

huron$id <- 1:nrow(huron)
huron$group <- ifelse(huron$id <= 50, "A", "B") 

h <- ggplot(huron, aes(year))
h +
  geom_ribbon(aes(ymin = level, ymax = level2, fill = group)) +
  geom_line(aes(y = level)) + geom_line(aes(y = level2))

- erc

---

非常感谢您的回答，这很有效。然而，在我的用例中，由于以下问题，它并不是非常实用：

1. 我想添加多个色带，因此我需要添加相当多的“解决方法”列。
2. 线条相交的点在数据中并不真正可见，因此我需要计算这些点并将其添加到数据库中（两次）。我一直希望有一个简单的解决方案，但似乎比简单的条件填充更复杂。 :-)

- ManuK

@ManuK 是的，特别是第二个问题据我所知很难解决，不幸的是我现在无法帮助你。但也许其他人会想出另一个答案？也许这篇博客文章能给你一些启示。 - erc

我已将此问题作为一个功能请求提交给了ggplot2的Github。我希望它能在未来的ggplot2版本中得到实现请求链接。 - ManuK

Answer 3

如果遇到非插值fill的问题，您可以使用两个（或n个）绸带。

h <- ggplot() +
  geom_ribbon(data = huron[huron$level >= huron$level2, ], aes(x = year, ymin = level, ymax = level2), fill="green") +
  geom_ribbon(data = huron[huron$level <= huron$level2, ], aes(x = year, ymin = level, ymax = level2), fill="red") +
  geom_line(data = huron, aes(x = year, y = level)) + 
  geom_line(data = huron, aes(x = year, y = level2))
h

无论您在 aes(fill = 中使用什么条件，它都会强制将其转换为因子，因此似乎仅适用于实际存在数据的情况。我认为这不是 ggplot2 的 bug，而是预期的行为。

- Jonathan Carroll

Answer 4

受这个已解决的问题的启发，有一种非常巧妙的方法可以解决这个问题，只需要在geom_ribbon()中使用pmin()函数即可：

h +
    geom_ribbon(aes(ymin = level,  ymax = pmin(level, level2), fill = "lower")) +
    geom_ribbon(aes(ymin = level2, ymax = pmin(level, level2), fill = "higher")) +
    geom_line(aes(y = level)) + geom_line(aes(y=level2))

- fschier

Answer 5

以上的解决方案对我没有用，因为我的数据有多个交叉点，以下是帮助我的方法。

这个解决方案引入了一个函数，稍微插值了数据集，即使用fill_data_gaps()函数来插值交叉点：

library(tidyverse)

# finds the intercept between two lines.
# note that C and D are fixed to the same x coords as A and B
find_intercept <- function(x1, x2, y1, y2, l1, l2) {
  d <- (x1 - x2) * ((l1 - l2) - (y1 - y2))
  
  a <- (x1*y2 - x2*y1)
  b <- (x1*l2 - x2*l1)
  
  px <- (a*(x1 - x2) - (x1 - x2)*b) / d
  py <- (a*(l1 - l2) - (y1 - y2)*b) / d
  list(x = px, y = py)
}

fill_data_gaps <- function(data, xvar, yvar, levelvar) {
  xv <- deparse(substitute(xvar))
  yv <- deparse(substitute(yvar))
  lv <- deparse(substitute(levelvar))
  
  data <- data %>% arrange({{xvar}}) # not needed?
  
  grp <- ifelse(data[[yv]] >= data[[lv]], "up", "down")
  
  sp <- split(data, cumsum(grp != lag(grp, default = "")))
  
  # calculate the intersections
  its <- lapply(seq_len(length(sp) - 1), function(i) {
    lst <- sp[[i]] %>% slice(n())
    nxt <- sp[[i + 1]] %>% slice(1)
    it <- find_intercept(x1 = lst[[xv]], x2 = nxt[[xv]],
                         y1 = lst[[yv]], y2 = nxt[[yv]],
                         l1 = lst[[lv]], l2 = nxt[[lv]])
    it[[lv]] <- it[["y"]]
    setNames(as_tibble(it), c(xv, yv, lv))
  })
  
  # insert the intersections at the correct values
  for (i in seq_len(length(sp))) {
    dir <- ifelse(mean(sp[[i]][[yv]]) > mean(sp[[i]][[lv]]), "up", "down")
    if (i > 1) sp[[i]] <- bind_rows(its[[i - 1]], sp[[i]]) # earlier interpolation
    if (i < length(sp)) sp[[i]] <- bind_rows(sp[[i]], its[[i]]) # next interpolation
    sp[[i]] <- sp[[i]] %>% mutate(.dir = dir)
  }
  # combine the values again
  bind_rows(sp)
}

创建一些虚假数据。

N <- 10
set.seed(1235)

data <- tibble(
  year = 2000:(2000 + N),
  value = c(100, 100 + cumsum(rnorm(N))),
  level = c(100, 100 + cumsum(rnorm(N)))
)
data
#> # A tibble: 11 x 3
#>     year value level
#>    <int> <dbl> <dbl>
#>  1  2000 100   100  
#>  2  2001  99.3  99.1
#>  3  2002  98.0 100. 
#>  4  2003  99.0  99.4
#>  5  2004  99.1  99.0
#>  6  2005  99.2  98.1
#>  7  2006 101.   98.6
#>  8  2007 101.   99.2
#>  9  2008 102.   98.7
#> 10  2009 103.   98.1
#> 11  2010 103.   98.4

data2 <- fill_data_gaps(data, year, value, level)
data2
#> # A tibble: 15 x 4
#>     year value level .dir 
#>    <dbl> <dbl> <dbl> <chr>
#>  1 2000  100   100   up   
#>  2 2001   99.3  99.1 up   
#>  3 2001.  99.2  99.2 up   
#>  4 2001.  99.2  99.2 down 
#>  5 2002   98.0 100.  down 
#>  6 2003   99.0  99.4 down 
#>  7 2004.  99.1  99.1 down 
#>  8 2004.  99.1  99.1 up   
#>  9 2004   99.1  99.0 up   
#> 10 2005   99.2  98.1 up   
#> 11 2006  101.   98.6 up   
#> 12 2007  101.   99.2 up   
#> 13 2008  102.   98.7 up   
#> 14 2009  103.   98.1 up   
#> 15 2010  103.   98.4 up

请注意，我们有更多带插值值的行（例如第3、4、7、8行）。

然后，我们可以像往常/预期一样使用ggplot2::geom_ribbon()。

ggplot(data2, aes(x = year)) +
  geom_ribbon(aes(ymin = level, ymax = value, fill = .dir)) +
  geom_line(aes(y = value)) +
  geom_line(aes(y = level), linetype = "dashed") +
  scale_fill_manual(name = "Dir", values = c("up" = "green", "down" = "red"))

- David