僅當 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 所追求的目標的另一種方法。

這是相關的情節