如何移除ggplot2图指定点并平滑折线？R绘图求助

一、移除红圈标记的重复点 #

红圈点对应FTSW_apres_arros与同日期同组FTSW_av_arros值完全重复的记录，可在数据预处理阶段过滤掉这些行：

library(ggplot2)
library(dplyr)
library(lubridate)
library(tidyverse)

lims <- as.POSIXct(strptime(c("2021-06-06","2021-06-15"), format = "%Y-%m-%d")) 

# 数据预处理：过滤重复点
Blancas <- subset(df, Pos_heliaphen %in% c("Z16","Z17","Z30","Z31")) %>%
  mutate(Date_obs = as.POSIXct(lubridate::dmy(Date_obs))) %>%
  tidyr::pivot_longer(starts_with("FTSW")) %>%
  mutate(Date_obs = if_else(name == "FTSW_apres_arros", Date_obs + 43200, Date_obs)) %>%
  # 过滤apres与av值重复的点
  group_by(Bloc, traitement, Date_obs_day = floor_date(Date_obs, "day")) %>%
  mutate(av_value = value[name == "FTSW_av_arros"]) %>%
  filter(!(name == "FTSW_apres_arros" & value == av_value)) %>%
  ungroup() %>%
  filter(!is.na(value))

labels <- Blancas %>% 
  select(Bloc, Pos_heliaphen) %>% 
  distinct(Bloc, Pos_heliaphen) %>% 
  group_by(Bloc) %>% 
  summarise(Pos_heliaphen = paste(Pos_heliaphen, collapse = "-")) %>% 
  tibble::deframe()

二、实现平滑折线（解决geom_smooth异常问题） #

geom_smooth默认loess拟合在分组多、数据点少的场景下容易出现异常，推荐两种替代方案：

方案1：使用GAM拟合的stat_smooth #

依赖mgcv包，拟合平滑曲线且不显示置信区间：

# 安装依赖包（首次运行需执行）
# install.packages("mgcv")

ggplot(Blancas, aes(Date_obs, value, colour = factor(Bloc), shape = traitement, 
                   linetype = traitement, group = interaction(Bloc, traitement))) +
  geom_point() +
  # 用GAM方法生成平滑曲线
  stat_smooth(method = "gam", formula = y ~ s(x, bs = "cs"), se = FALSE, size = 0.8) +
  scale_color_discrete(labels = labels, guide = guide_legend(order = 1)) +
  scale_x_datetime(limits = lims, date_labels = "%d/%m/%Y", date_breaks = "day") +
  labs(title = "Blancas", y = expression(paste("FTSW"))) +
  theme(legend.position = "right", axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank()) +
  guides(colour = guide_legend(order = 1, nrow = 8), shape=guide_legend(nrow = 2), linetype=guide_legend(nrow = 2))

方案2：手动样条插值生成平滑点 #

先对每个分组做样条插值生成密集平滑点，再绘制折线：

# 生成平滑插值数据
smooth_data <- Blancas %>%
  group_by(Bloc, traitement) %>%
  arrange(Date_obs) %>%
  # 生成50个插值点（可调整length.out控制平滑度）
  mutate(
    smooth_date = seq(min(Date_obs), max(Date_obs), length.out = 50),
    smooth_value = spline(Date_obs, value, xout = smooth_date)$y
  ) %>%
  ungroup() %>%
  select(Bloc, traitement, smooth_date, smooth_value) %>%
  distinct()

# 绘图：原始点+平滑折线
ggplot() +
  geom_point(data = Blancas, aes(Date_obs, value, colour = factor(Bloc), shape = traitement)) +
  geom_line(data = smooth_data, aes(smooth_date, smooth_value, colour = factor(Bloc), 
                                    linetype = traitement, group = interaction(Bloc, traitement)), size = 0.8) +
  scale_color_discrete(labels = labels, guide = guide_legend(order = 1)) +
  scale_x_datetime(limits = lims, date_labels = "%d/%m/%Y", date_breaks = "day") +
  labs(title = "Blancas", y = expression(paste("FTSW"))) +
  theme(legend.position = "right", axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank()) +
  guides(colour = guide_legend(order = 1, nrow = 8), shape=guide_legend(nrow = 2), linetype=guide_legend(nrow = 2))

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