ggplot2：无法使用 geom_ribbon 为相交线之间的区域着色

Question

我正在处理来自所有 50 个州的数据。我正在尝试绘制小型多折线图，其中一条线是州（蓝色），另一条线是全国平均水平（灰色）。

这是缅因州的一个例子：

这是我的缅因州数据框的样子：

我试图将州界线低于全国平均水平的区域涂成红色，而高于它的区域则为绿色。

我曾经geom_ribbon对区域进行着色并获得一种颜色（比例不同）：

但是，当州界线越过国界线时，我正在努力寻找改变填充的方法。

当我运行此代码时：

ggplot(states, aes(x = year, group=1)) + 
  geom_line(aes(y = ttc_avg),colour='#006f91') +
  geom_line(aes(y = nat_avg), colour='#666666') +
  geom_ribbon(aes(x=year, ymin = nat_avg, ymax = ttc_avg, fill=ttc_avg > nat_avg)) +
  scale_fill_manual(values=c("green", "red"), name="fill") +
  facet_wrap(~state)

我收到一个错误提示 Aesthetics can not vary with a ribbon.

解决这个问题的最佳方法是什么？我应该使用geom_ribbon还是另一个 ggplot2 函数？

Answer 1

有一些解决方法，但看起来您可能对每个状态都有这些值，并通过方面来组织它们。在这种情况下，让我们尽量做到“整洁”。在这个构建的假数据中，为了简单起见，我更改了您的变量名称，但概念是相同的。

library(dplyr)
library(purrr)
library(ggplot2)

temp.grp <- expand.grid(state = sample(state.abb, 8), year = 2008:2015) %>% 
              # sample 8 states and make a dataframe for the 8 years
  group_by(state) %>% 
  mutate(sval = cumsum(rnorm(8, sd = 2))+11) %>% 
              # for each state, generate some fake data
  ungroup %>% group_by(year) %>% 
  mutate(nval = mean(sval))
              # create a "national average" for these 8 states

head(temp.grp)

Source: local data frame [6 x 4]
Groups: year [1]

   state  year      sval     nval
  <fctr> <int>     <dbl>    <dbl>
1     WV  2008 15.657631 10.97738
2     RI  2008 10.478560 10.97738
3     WI  2008 14.214157 10.97738
4     MT  2008 12.517970 10.97738
5     MA  2008  9.376710 10.97738
6     WY  2008  9.578877 10.97738

这将绘制两条丝带，一条位于全国平均水平线之间，以较小的一条线位于全国平均水平或州值之间。这意味着当全国平均水平较低时，它本质上是一条高度为 0 的色带。当全国平均水平较高时，色带介于全国平均水平和较低的州值之间。

另一个功能区与此相反，当状态值较小时为 0 高度，当状态值较高时在两个值之间拉伸。

ggplot(temp.grp, aes(year, nval)) +  facet_wrap(~state) +
  geom_ribbon(aes(ymin = nval, ymax = pmin(sval, nval), fill = "State lower")) +
  geom_ribbon(aes(ymin = sval, ymax = pmin(sval, nval), fill = "State higher")) +
  geom_line(aes(linetype = "Nat'l Avg")) +
  geom_line(aes(year, sval, linetype = "State")) +
  scale_fill_brewer(palette = "Set1", direction = -1)

这主要是有效的，但你可以看到交叉点发生的地方有点奇怪，因为它们并没有完全在年份 x 值交叉：

为了解决这个问题，我们需要沿着每条线段进行插值，直到这些间隙变得肉眼无法区分。我们将purrr::map_df为此使用。我们首先split将数据放入一个数据框列表中，每个状态一个。然后map，我们沿着该列表创建一个数据框，其中包含 1) 内插年份和州值，2) 内插年份和全国平均值，以及 3) 每个州的标签。

temp.grp.interp <- temp.grp %>% 
  split(.$state) %>% 
  map_df(~data.frame(state = approx(.x$year, .x$sval, n = 80), 
                     nat = approx(.x$year, .x$nval, n = 80), 
                     state = .x$state[1]))
head(temp.grp.interp)

   state.x  state.y    nat.x    nat.y state
1 2008.000 15.65763 2008.000 10.97738    WV
2 2008.089 15.90416 2008.089 11.03219    WV
3 2008.177 16.15069 2008.177 11.08700    WV
4 2008.266 16.39722 2008.266 11.14182    WV
5 2008.354 16.64375 2008.354 11.19663    WV
6 2008.443 16.89028 2008.443 11.25144    WV

该approx函数默认返回一个名为xand的列表y，但我们将其强制转换为数据帧并使用state =andnat =参数重新标记它。请注意，插值年份在每一行中都是相同的值，因此我们可以在此时丢弃其中一列。我们也可以重命名列，但我不会管它。

现在我们可以修改上面的代码来处理这个新创建的插值数据框。

ggplot(temp.grp.interp, aes(nat.x, nat.y)) +  facet_wrap(~state) +
  geom_ribbon(aes(ymin = nat.y, ymax = pmin(state.y, nat.y), fill = "State lower")) +
  geom_ribbon(aes(ymin = state.y, ymax = pmin(state.y, nat.y), fill = "State higher")) +
  geom_line(aes(linetype = "Nat'l Avg")) +
  geom_line(aes(nat.x, state.y, linetype = "State")) +
  scale_fill_brewer(palette = "Set1", direction = -1)

现在十字路口干净多了。此解决方案的分辨率由n =对 的两次调用的参数控制approx(...)。