R 中有没有办法在另一个数据集的正态图上添加数据集的样条曲线?

问题描述

我有以下数据集

data1<- structure(list(Total.VolumeD = c(705.6,691.2,878.4,950.4,600,547.2,1065.6,1228.8,1180.8,830.4,556.8,1017.6,1089.6,1612.8,988.8,1113.6,609.6,1780.8,912,806.4,1636.8,1444.8,844.8,1425.6,604.8,417.6,1046.4,1689.6,1152,868.8,1108.8,657.6,1276.8,1262.4,921.6,667.2,940.8,873.6,1680,964.8,724.8,249.6,1507.2,902.4,960,1161.6,489.6,854.4,720,1459.2,1008,1084.8,672,888,662.4,979.2,1497.6,1118.4,739.2,1094.4,1608,801.6,744,849.6,1670.4,777.6,835.2,1190.4,787.2,566.4,1449.6,1305.6,1171.2,758.4,916.8,456,864,936,1003.2,1377.6,998.4),Speed_KM = c(114.239,112.63,109.412,107.803,111.021,106.194,114.239,102.976,59.533,83.668,46.661,94.931,77.232,61.142,70.796,99.758,101.367,45.052,98.149,53.097,90.104,117.457,75.623,48.27,49.879,109.412)),row.names = c(NA,-100L),class = "data.frame")

我想在 x 和 y 上绘制这两个变量作为点。然后我想使用下面的数据集在它上面拟合一个样条。

data2<-structure(list(q = c(158.4,274.133,414.102,613.637,787.081,899.571,1020.936,1134.581,1282.396,1424.662,1571.935,1741.292,1549.867,1488.96,1514.317,1519.543,1574.4,1456.615,1470.912,1481.04,1419.443,1452.916,1423.418,1382.8,1367.611,1369.1,1341.45,1329.36,1243.765,1257.6,1141.371,1076.16,1100,1142.4,895.2,1468.8,796.8,1070.4),u = c(91.11,103.713,106.808,110.56,111.033,109.907,109.392,109.494,108.584,107.729,105.759,101.676,88.793,83.024,81.726,76.313,72.904,67.578,66.677,62.912,59.183,58.509,56.656,53.734,50.401,49.007,48.32,45.776,43.632,43.736,42.064,45.696,35.934,32.18,23.331,36.202,62.751
),k = c(0.913,1.678,2.714,3.825,4.836,5.827,6.801,7.747,8.922,9.99,11.057,12.077,13.311,14.347,15.276,16.395,17.359,18.573,19.58,20.635,21.676,22.685,23.806,24.783,25.838,26.919,27.994,28.96,30.135,31.173,32.264,33.28,34.217,35.4,36.45,37.3,39.82,41,47.6,52.8)),-40L),class = "data.frame")

我试过的代码如下

ggplot(data1) +
  geom_point(aes( x = Total.VolumeD,y = Speed_KM,width = 0.5),size = 1.5,color = "grey")+ 
  geom_xspline(data = data2,aes( x = q,y = u))

我将变量 k 留在 data2 中,因为它可能会有所帮助。我想得到像没有红点的图片一样的输出。该问题最初与here

The output might look like that without the red dots

解决方法

您可以考虑使用移动平均线。在这里,使用 slider::slide_dbl,我做了一个平均,它更平滑地回顾,期待接近你的绘图。第一个 mutate(across... 生成新列 q_smoothu_smooth,第二个应用另一轮平滑处理。

library(slider)
data2 %>%
  mutate(across(q:u,~slide_dbl(.x,mean,.before = 5,.after = 1),.names = "{.col}_smooth")) %>%
  mutate(across(q_smooth:u_smooth,.after = 1))) %>%
  ggplot() +
  geom_point(aes(q,u)) +
  geom_path(aes(q_smooth,u_smooth))

enter image description here