使用 ggplot2 在 3 个子图中绘制时间序列数据的原始值、环比变化和同比变化

给定两个每月时间序列数据样本.

我需要创建一个包含 3 个子图的图：plot1 表示原始值，plot2 表示逐月变化，plot3 表示逐年变化。

我可以用下面的代码绘制绘图，但是代码太冗余了。所以我的问题是如何以简洁的方式实现这一目标？谢谢。

library(xlsx)
library(ggplot2)
library(reshape)
library(dplyr)
library(tidyverse)
library(lubridate)
library(cowplot)
library(patchwork)

df <- read.xlsx('./sample_data.xlsx', 'Sheet1')
colnames(df)
# df

cols <- c('food_index', 'energy_index')
df <- df %>% mutate(date=as.Date(date)) %>% 
  mutate(across(-contains('date'), as.numeric)) %>% 
  mutate(date= floor_date(date, 'month')) %>%
  group_by(date) %>%
  summarise_at(vars(cols), funs(mean(., na.rm=TRUE))) %>%
  mutate(across(cols, list(yoy = ~(. - lag(., 12))/lag(., 12)))*100) %>%
  mutate(across(cols, list(mom = ~(. - lag(., 1))/lag(., 1)))*100) %>% 
  filter(date >= '2018-01-01' & date <= '2021-12-31') %>%
  as.data.frame()

df1 <- df %>%
  select(!grep('mom|yoy', names(df))) 

df1_long <- melt(df1, id.vars = 'date')
plot1 <- ggplot(df1_long[!is.na(df1_long$value), ],
       aes(x = date,
           y = value,
           col = variable)) +
  geom_line(size=0.6, alpha=0.5) +
  geom_point(size=1, alpha=0.8) +
  labs(
    x='',
    y='Unit: $'
  ) 

# MoM changes
df2 <- df %>%
  select(grep('date|mom', names(df)))

df2_long <- melt(df2, id.vars = 'date')
plot2 <- ggplot(df2_long[!is.na(df2_long$value), ],
       aes(x = date,
           y = value,
           col = variable)) +
  geom_line(size=0.6, alpha=0.5) +
  geom_point(size=1, alpha=0.8) +
  labs(
    x='',
    y='Unit: %'
  ) 

# YoY changes
df3 <- df %>%
  select(grep('date|yoy', names(df))) 

df3_long <- melt(df3, id.vars = 'date')
plot3 <- ggplot(df3_long[!is.na(df3_long$value), ],
       aes(x = date,
           y = value,
           col = variable)) +
  geom_line(size=0.6, alpha=0.5) +
  geom_point(size=1, alpha=0.8) +
  labs(
    x='',
    y='Unit: %'
  )
plot <- plot1 + plot2 + plot3 + plot_layout(ncol=1)
# plot <- plot_grid(plot1, plot2, plot3, labels = c('Value', 'MoM', 'YoY'), label_size = 12)
plot

Out:

预期结果将类似于下图（上图将显示原始数据，中图将显示环比变化数据，下图将显示同比变化数据）：

参考：

https://waterdata.usgs.gov/blog/beyond-basic-plotting/ https://waterdata.usgs.gov/blog/beyond-basic-plotting/

http://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/81-ggplot2-easy-way-to-mix-multiple-graphs-on-the-same-page/ http://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/81-ggplot2-easy-way-to-mix-multiple-graphs-on-the-same-page/

使用 ggplot2 并排绘图 https://stackoverflow.com/questions/1249548/side-by-side-plots-with-ggplot2

也许这就是您正在寻找的？通过使用绘图函数将数据重塑为正确的形状，例如purrr::map2您可以实现您想要的结果，而无需像这样重复代码。

使用一些虚假的随机示例数据来模仿您的真实数据：

library(tidyr)
library(dplyr)
library(ggplot2)

df_long <- df |> 
  rename(food_index_raw = food_index, energy_index_raw = energy_index) |> 
  pivot_longer(-date, names_to = c("variable", ".value"), names_pattern = "^(.*?_index)_(.*)$")

plot_fun <- function(x, y, ylab) {
  x <- x |> 
    select(date, variable, value = .data[[y]]) |> 
    filter(!is.na(value))
  
  ggplot(
    x,
    aes(
      x = date,
      y = value,
      col = variable
    )
  ) +
    geom_line(size = 0.6, alpha = 0.5) +
    geom_point(size = 1, alpha = 0.8) +
    labs(
      x = "",
      y = ylab
    )  
}

yvars <- c("raw", "mom", "yoy")
ylabs <- paste0("Unit: ", c("$", "%", "%"))

plots <- purrr::map2(yvars, ylabs, plot_fun, x = df_long)

library(patchwork)

wrap_plots(plots) + plot_layout(ncol = 1)

DATA

set.seed(123)

date <- seq.POSIXt(as.POSIXct("2017-01-31"), as.POSIXct("2022-12-31"), by = "month")
food_index <- runif(length(date))
energy_index <- runif(length(date))

df <- data.frame(date, food_index, energy_index)

EDIT使用时为每个图添加字幕patchwork（目前）有点棘手。在这种情况下我要做的是使用分面“hack”。为此，我稍微调整了函数以获取字幕参数并切换到purrr::pmap:

library(tidyr)
library(dplyr)
library(ggplot2)

df_long <- df |> 
  rename(food_index_raw = food_index, energy_index_raw = energy_index) |> 
  pivot_longer(-date, names_to = c("variable", ".value"), names_pattern = "^(.*?_index)_(.*)$")

plot_fun <- function(x, y, ylab, subtitle) {
  x <- x |> 
    select(date, variable, value = .data[[y]]) |> 
    filter(!is.na(value))
  
  ggplot(
    x,
    aes(
      x = date,
      y = value,
      col = variable
    )
  ) +
    geom_line(size = 0.6, alpha = 0.5) +
    geom_point(size = 1, alpha = 0.8) +
    facet_wrap(~.env$subtitle) +
    labs(
      x = "",
      y = ylab
    ) +
    theme(strip.background = element_blank(), strip.text.x = element_text(hjust = 0))
}

yvars <- c("raw", "mom", "yoy")
ylabs <- paste0("Unit: ", c("$", "%", "%"))
subtitle <- c("Original", "Month-to-Month", "Year-to-Year")

plots <- purrr::pmap(list(y = yvars, ylab = ylabs, subtitle = subtitle), plot_fun, x = df_long)

library(patchwork)

wrap_plots(plots) + plot_layout(ncol = 1)