如何在ggplot中为含缺失值的非规则数据添加无过度偏离的平滑趋势线

问题背景 #

为含缺失值的非规则时间序列绘制平滑趋势线时，使用geom_smooth(loess)出现两个核心问题：

• 数据缺失区间的趋势线异常下降
• 整体趋势线与数据点贴合度差

可复现示例修正版 #

数据集 #

WQ <- structure(list(date = structure(c(18807, 18807, 18807, 18807, 
18807, 18807, 18814, 18820, 18834, 18834, 18834, 18835, 18835, 
18835, 18835, 18835, 18835, 18841, 18841, 18841, 18841, 18841, 
18841, 18841, 18841, 18841, 18847, 18847, 18847, 18847, 18847, 
18847, 18848, 18848, 18848, 18849, 18855, 18856, 18856, 18856, 
18856, 18856, 18856, 18856, 18856, 18856, 18862, 18862, 18863, 
18863, 18863, 18863, 18863, 18863, 18890, 18890, 18890, 18890, 
18890, 18890), class = "Date"), sulphate = c(38, 38, 39, 37, 
39, 38, 50, 47, NA, NA, NA, 41.34, 40.61, 39.2, 38.69, 39.1, 
38.83, 46, 47, 46, 48, 47, 48, 47, 47, 47, 50, 51, 51, 51, 51, 
51, 51.1, 48.8, 51.9, NA, 67, 64, 64, 65, 64, 69, 64, 68, 68, 
70, NA, 54, 55, 55, 55, 56, 55, 55, 70.5, 70.8, 71.2, 71.6, 71.5, 
71.5)), row.names = c(NA, 60L), class = "data.frame")

原始问题代码（修正依赖与数据问题） #

library(ggplot2)
library(dplyr) # 补充加载filter所需包

# 注：原始数据集无location列，此处注释相关代码避免报错
# WQ$location <- as.factor(WQ$location)
# WQ <- filter(WQ, !location=='4')

WQ$sulphate <- as.numeric(WQ$sulphate)
WQ$date <- as.Date(WQ$date, format='%d/%m/%Y')
lims <- as.Date(strptime(c("2021-06-21", "2021-09-23"), format = "%Y-%m-%d"))

WQ %>%
  ggplot((aes(x=date))) + 
  geom_smooth(aes(y=sulphate, x=date), span=0.7,inherit.aes=FALSE, col='darkgreen')+
  geom_point(aes(y=sulphate, x=date), col='orange')+
  xlab('date') +
  ylab('sulphate mg S/l') +
  theme_bw()+
  theme(plot.margin = unit(c(0.1,0.1,0.1,0.1), 'cm'), 
        text=element_text(size=11), 
        axis.title.x = element_blank(), 
        axis.text.y = element_text(size=11),
        axis.title.y=element_text(size=11))  +
  scale_x_date(breaks = '2 week', date_labels='%d/%b', limits=lims)

解决方案 #

1. 预处理数据：清理重复与缺失值 #

原数据存在同一日期多重复观测、部分日期全为NA的问题，会严重干扰loess拟合：

library(dplyr)
# 按日期聚合取均值，自动过滤全NA的日期
WQ_clean <- WQ %>%
  group_by(date) %>%
  summarise(sulphate = mean(sulphate, na.rm = TRUE)) %>%
  filter(!is.na(sulphate)) # 移除聚合后仍为NA的行

2. 替换loess为GAM拟合 #

loess依赖局部数据点密度，非规则时间序列的间隙会导致拟合异常；**广义相加模型（GAM）**的样条拟合更适合处理非均匀时间序列：

library(ggplot2)
lims <- as.Date(c("2021-06-21", "2021-09-23"))

ggplot(WQ_clean, aes(x = date, y = sulphate)) +
  geom_point(col = 'orange') +
  # 使用GAM立方平滑样条，适配时间序列趋势
  geom_smooth(method = "gam", formula = y ~ s(x, bs = "cs"), col = 'darkgreen') +
  ylab('sulphate mg S/l') +
  theme_bw() +
  theme(plot.margin = unit(c(0.1,0.1,0.1,0.1), 'cm'), 
        text=element_text(size=11), 
        axis.title.x = element_blank(), 
        axis.text.y = element_text(size=11),
        axis.title.y=element_text(size=11)) +
  scale_x_date(breaks = '2 week', date_labels='%d/%b', limits=lims)

3. 可选：调整loess参数（仅当坚持使用loess时） #

若必须使用loess，需调整span参数（增大值提升平滑度，减小值提升贴合度），同时确保仅在有数据的区间拟合：

ggplot(WQ_clean, aes(x = date, y = sulphate)) +
  geom_point(col = 'orange') +
  geom_smooth(method = "loess", span = 0.4, col = 'darkgreen') + # 调整span值适配数据分布
  # 其他绘图参数同上

可复现示例改进建议 #

• 直接使用structure()创建数据框，避免依赖外部CSV文件，确保他人可直接运行代码。
• 补充加载所有用到的包（如dplyr），避免函数未找到的报错。
• 移除或补充数据集缺失的列（如原代码中的location列，当前提供的数据集无此列，会导致filter报错）。

内容的提问来源于stack exchange，提问作者Malaurie Hons