R 中有沒有辦法在另一個數據集的普通 plot 之上添加數據集的樣條？

Question

我有以下數據集

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, 806.4, 667.2, 940.8, 873.6, 1113.6, 
1680, 964.8, 724.8, 249.6, 844.8, 1507.2, 902.4, 960, 1262.4, 
1017.6, 1161.6, 489.6, 854.4, 720, 1459.2, 724.8, 691.2, 1008, 
1084.8, 672, 417.6, 1017.6, 1008, 888, 662.4, 979.2, 844.8, 1497.6, 
921.6, 1108.8, 1118.4, 739.2, 489.6, 1094.4, 1152, 1608, 801.6, 
744, 849.6, 1670.4, 844.8, 777.6, 835.2, 1190.4, 787.2, 566.4, 
1449.6, 1305.6, 1171.2, 758.4, 916.8, 456, 864, 844.8, 964.8, 
936, 1003.2, 1377.6, 1113.6, 998.4), Speed_KM = c(114.239, 112.63, 
109.412, 112.63, 112.63, 107.803, 111.021, 111.021, 106.194, 
109.412, 114.239, 109.412, 112.63, 107.803, 111.021, 109.412, 
107.803, 102.976, 107.803, 111.021, 59.533, 83.668, 102.976, 
46.661, 94.931, 109.412, 77.232, 61.142, 111.021, 114.239, 111.021, 
107.803, 70.796, 109.412, 109.412, 109.412, 111.021, 111.021, 
99.758, 107.803, 107.803, 111.021, 101.367, 99.758, 111.021, 
46.661, 107.803, 106.194, 112.63, 106.194, 45.052, 111.021, 112.63, 
112.63, 45.052, 114.239, 107.803, 111.021, 114.239, 107.803, 
98.149, 111.021, 109.412, 112.63, 53.097, 107.803, 111.021, 90.104, 
117.457, 111.021, 106.194, 111.021, 111.021, 111.021, 109.412, 
107.803, 111.021, 109.412, 107.803, 75.623, 112.63, 114.239, 
109.412, 109.412, 111.021, 111.021, 48.27, 111.021, 109.412, 
106.194, 106.194, 109.412, 112.63, 109.412, 109.412, 111.021, 
107.803, 49.879, 94.931, 109.412)), row.names = c(NA, -100L), class = "data.frame")

我想以 plot 這兩個變量在 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, 854.4, 796.8, 662.4, 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, 45.052, 77.232, 53.097, 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)), row.names = c(NA, 
-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 中，因為它可能會有所幫助。 我想得到一個 output 像沒有紅點的圖片。 該問題最初與here有關

Answer 1

您可以考慮使用移動平均線。 在這里，使用slider::slide_dbl ，我做出了一個更平滑的平均值，看起來更平滑，期待近似您的繪圖。 第一個mutate(across...生成新列q_smooth和u_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, ~slide_dbl(.x, mean, .before = 5, .after = 1))) %>%
  ggplot() +
  geom_point(aes(q,u)) +
  geom_path(aes(q_smooth, u_smooth))