如何在R中绘制非拟合的平滑折线图（类似Excel效果）

问题背景 #

现有如下数据集：

df=data.frame(
  treatment = rep(c("B", "A"), each = 13L),
  time = as.POSIXct(
    rep(
      c(
        "1899-12-31 06:00:00", "1899-12-31 07:00:00", "1899-12-31 08:00:00",
        "1899-12-31 09:00:00", "1899-12-31 10:00:00", "1899-12-31 11:00:00",
        "1899-12-31 12:00:00", "1899-12-31 13:00:00", "1899-12-31 14:00:00",
        "1899-12-31 15:00:00", "1899-12-31 16:00:00", "1899-12-31 17:00:00",
        "1899-12-31 18:00:00"
      ),
      2
    ),
    tz = "UTC"
  ),
  Radiation = c(
    56.52811508317025, 127.6913397994129, 249.13531630136984, 232.7319272847358,
    282.9493191340509, 700.568959549902, 1227.3102986741683, 1481.2186411399216,
    1388.3260398336595, 1126.6007556702543, 598.2448670694715, 234.7725780919765,
    135.41278232387475, 57.28412474559686, 143.20141084148727, 219.71977855675146,
    635.4653254109588, 1313.8880365215264, 1463.729484349315, 1508.7094646183953,
    1183.3423383219176, 653.6103462181995, 318.73400056262227, 284.35463106164383,
    238.0325500440313, 120.99518652641878
  ),
  row.names = c(14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 
                26L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 
                52L)
)

已使用以下代码绘制折线图：

ggplot(data=df, aes(x=time, y=Radiation)) + 
  geom_line (aes(color=treatment, group=treatment)) + 
  geom_point(aes(shape=treatment, fill=treatment), color="black", size=2) +
  scale_shape_manual(values= c(21,22)) +
  scale_fill_manual(values=c("coral4","grey65"))+
  scale_color_manual(values=c("coral4","grey65"))+
  scale_x_datetime(date_breaks = "2 hour", date_labels = "%H:%M") +
  scale_y_continuous(breaks=seq(0,2500,500), limits = c(0,2500)) +
  theme_classic(base_size=18, base_family="serif")+ 
  theme(legend.position=c(0.5,0.9),
        legend.title=element_blank(),
        legend.key=element_rect(color="white", fill="white"),
        legend.text=element_text(family="serif", face="plain",
                                 size=15, color= "Black"),
        legend.background=element_rect(fill="white"),
        axis.line=element_line(linewidth=0.5, colour="black")) +
windows(width=5.5, height=5)

希望绘制类似Excel的平滑折线图，但geom_smooth()会因数据拟合导致图形失真，需实现非拟合的平滑折线图。

解决方案 #

Excel的平滑折线是基于插值法生成的平滑曲线，而非拟合模型。可以通过对每个treatment分组生成插值点，再用折线连接这些点来实现：

步骤1：生成插值数据 #

使用spline()函数对每个treatment的time和Radiation进行插值，生成更多的平滑点：

library(dplyr)

# 转换time为数值方便插值，之后再转回POSIXct
df_smooth <- df %>%
  group_by(treatment) %>%
  do({
    # 将时间转为数值型
    time_num <- as.numeric(.$time)
    # 生成插值数据，n控制平滑程度，数值越大曲线越平滑
    spline_result <- spline(time_num, .$Radiation, n = 100)
    # 转换回POSIXct格式，组合成数据框
    data.frame(
      time = as.POSIXct(spline_result$x, origin = "1970-01-01", tz = "UTC"),
      Radiation_smooth = spline_result$y,
      treatment = .$treatment[1]
    )
  }) %>%
  ungroup()

步骤2：绘制平滑折线图 #

在原有绘图代码基础上，替换geom_line为插值后的平滑折线，保留原数据的散点：

ggplot() +
  # 绘制插值生成的平滑折线
  geom_line(data = df_smooth, aes(x = time, y = Radiation_smooth, color = treatment, group = treatment)) +
  # 保留原数据的散点
  geom_point(data = df, aes(x = time, y = Radiation, shape = treatment, fill = treatment), color = "black", size = 2) +
  scale_shape_manual(values= c(21,22)) +
  scale_fill_manual(values=c("coral4","grey65"))+
  scale_color_manual(values=c("coral4","grey65"))+
  scale_x_datetime(date_breaks = "2 hour", date_labels = "%H:%M") +
  scale_y_continuous(breaks=seq(0,2500,500), limits = c(0,2500)) +
  theme_classic(base_size=18, base_family="serif")+ 
  theme(legend.position=c(0.5,0.9),
        legend.title=element_blank(),
        legend.key=element_rect(color="white", fill="white"),
        legend.text=element_text(family="serif", face="plain",
                                 size=15, color= "Black"),
        legend.background=element_rect(fill="white"),
        axis.line=element_line(linewidth=0.5, colour="black")) +
windows(width=5.5, height=5)

关键说明 #

• spline()函数的n参数控制插值点数量，数值越大曲线越平滑，可根据需求调整（比如n=50或n=200）。
• 该方法完全基于原数据点插值，不会引入拟合偏差，和Excel的平滑折线逻辑一致。

内容的提问来源于stack exchange，提问作者J.K Kim