仅当 ggplot 中的值 A 大于值 B 时，如何对两个时间序列之间的区域进行着色？

Question

我正在尝试在ggplot、AAPL 和 MSFT 上绘制 2 个时间序列（指数股票价格）。我想遮蔽这两条线之间的区域，但前提是 AAPL 指数价格高于 MSFT 的价格。我该如何做到这一点？

我一直在阅读有关使用geom_ribbon() 的信息，但看到有人说这是有问题的，并且当两条线不交叉时不起作用。我也无法让代码正常工作。如何为geom_ribbon() 设置我的ymin 和ymax 值？我也试过geom_area()，但后来我创建的只是一个堆积面积图。

到目前为止，这是我的代码：

install.packages("tidyquant")
install.packages("ggplot2")

library(tidyquant)
library(ggplot2)

symbols <- c("AAPL", "MSFT")
data <- tq_get(symbols, get = "stock.prices", from = "2016-01-01")

S1_index <-data$adjusted[which(data$symbol == "AAPL" & data$date == min(data$date))] 
S2_index <-data$adjusted[which(data$symbol == "MSFT" & data$date == min(data$date))] 

data$adjusted <- ifelse(data$symbol == "AAPL", data$adjusted/S1_index,
                        ifelse(data$symbol == "MSFT", data$adjusted/S2_index,NA))

ggplot(data,aes(x=date, y=adjusted,colour= symbol)) +
  geom_line() +
  scale_colour_manual(values = c(AAPL = "darkblue", MSFT = "red")) +
  ggtitle("Title Here") + xlab("X Axis Label Here") + ylab("Y Axis Label Here") + 
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_x_date(date_labels = "%b %y", date_breaks = "6 months") + 
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
        panel.background = element_blank(), axis.line = element_line(colour = "black"))+
  labs(color = "Company") + 
  theme(legend.title = element_blank())

当 AAPL 高于 MSFT 时，我希望两个时间序列之间的区域被遮蔽，但目前我的代码没有做到这一点。我对 ggplot 的使用不是很熟练，所以如果您有任何建议，我将不胜感激。

Answer 1

您可以使用功能区显示两条线之间的区域，但需要进行一些调整才能仅在 AAPL 高于 MSFT 时显示该区域。假设 data 是您发布的 .csv 文件的链接，并且日期已格式化。首先，我们将以典型的带状格式构建一个单独的 data.frame：

ribbondata <- data.frame(
  # We'll keep the x-values for one of the lines
  x = data$date[data$symbol == "AAPL"],
  # Next we are going to take the pairwise minima and maxima along the lines
  ymin = pmin(data$adjusted[data$symbol == "AAPL"], data$adjusted[data$symbol == "MSFT"]),
  ymax = pmax(data$adjusted[data$symbol == "AAPL"], data$adjusted[data$symbol == "MSFT"]),
  # Then, we'll save a variable for which observations to keep
  keep = data$adjusted[data$symbol == "AAPL"] > data$adjusted[data$symbol == "MSFT"]
)

然后，我将过滤掉我们不想遮蔽的区域，并将一些id 变量附加到跟踪我们确实想要遮蔽的数据段的数据。我们将为此使用运行长度编码：

keep_rle <- rle(ribbondata$keep)
# Now we'll replace every TRUE with a counter integer
keep_rle$values[keep_rle$values] <- seq_len(sum(keep_rle$values))

接下来，我们将把编码为id 的运行长度的倒数附加到ribbondata 数据帧中，并删除ribbondata$KEEP == FALSE 所在的位。

ribbondata$id <- inverse.rle(keep_rle)
ribbondata <- ribbondata[ribbondata$keep,]

然后，我们将使用您提供的绘图代码：

g <- ggplot(data,aes(x=date, y=adjusted,colour= symbol)) +
  geom_line() +
  scale_colour_manual(values = c(AAPL = "darkblue", MSFT = "red")) +
  ggtitle("Title Here") + xlab("X Axis Label Here") + ylab("Y Axis Label Here") + 
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_x_date(date_labels = "%b %y", date_breaks = "6 months") + 
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
        panel.background = element_blank(), axis.line = element_line(colour = "black"))+
  labs(color = "Company") + 
  theme(legend.title = element_blank())

并附上我们的ribbondata：

g <- g + geom_ribbon(data = ribbondata, 
                     aes(x = x, ymin = ymin, ymax = ymax, group = id), 
                     inherit.aes = FALSE)

现在这里的技巧是将我们计算出的id 变量附加到aes() 调用中的group，这样ggplot 就不会将功能区解释为连续对象并在x 值处绘制奇怪的线ribbondata y 值未定义。我还设置了inherit.aes = FALSE，因为ribbondata 的x 和ymin/ymax 变量的名称与主要的data 不同。

我最终得到了以下情节：

当然，您可以为功能区提供您想要的任何填充颜色或 Alpha。祝你好运！

Answer 2

首先重塑您的数据。

data <- data %>% 
    
# Select down to the necessary columns
select(date, symbol, adjusted) %>%
        
# Pivot to create columns for both symbols
pivot_wider(names_from = symbol, values_from = adjusted) %>%

# Create new variables for ribbon
mutate(max1 = ifelse(AAPL >= MSFT, AAPL, MSFT)) %>%
mutate(max2 = ifelse(MSFT >= AAPL, MSFT, AAPL)) 

接下来，创建你的 ggplot 对象

g1 <- data %>%

    # Set PlotAesthetics
    ggplot(aes(x=date, y=AAPL)) + 
    
    # First ribbon creates the color above MSFT and below AAPL
    geom_ribbon(aes(ymin=MSFT, ymax=AAPL), fill="grey", alpha=0.9) +
    
    # Second ribbon removes anything below MSFT
    geom_ribbon(aes(ymin=0, ymax=MSFT), fill="white", alpha=0.9) +
    
    # Add lines for AAPL and MSFT 
    geom_line(aes(y=AAPL), color = "blue") +
    geom_line(aes(y=MSFT), color = "red") +
    
    # Create Labels
    labs(x = "X Axis Label Here", y = "Y Axis Label Here",
         title = "Title Here") + 

    # Set Theme to match your original plot
    theme_classic() +

    # Need to create custom legend 
    annotate(geom = "text", x = ymd('2020-06-01'), y = .25, label = "AAPL", hjust = "left") +
    annotate(geom = "segment", x = ymd('2020-03-01'), xend = ymd('2020-05-01'), y = .25, yend = .25, colour = "blue", size = 1) +
    annotate(geom = "text", x = ymd('2020-06-01'), y = .05, label = "MSFT", hjust = "left") +
    annotate(geom = "segment", x = ymd('2020-03-01'), xend = ymd('2020-05-01'), y = .05, yend = .05, colour = "red", size = 1)

我意识到这有点晚了，但这是实现@bgm 所追求的另一种方法。

Here is the associated plot