仅当 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 所追求的目标的另一种方法。

这是相关的情节