如何平滑增加噪音的数据

Question

化学家在这里（因此不太适合进行统计分析）和R中的新手：

我有各种数据集，其中反应的产率随时间监测，例如：

• 数据：

  df <- structure(list(time = c(15, 30, 45, 60, 75, 90, 105, 120, 135, 150, 165, 180, 195, 210, 225, 240, 255, 270, 285, 300, 315, 330, 345, 360, 375, 390, 405, 420, 435, 450, 465, 480, 495, 510, 525, 540, 555, 570, 585, 600, 615, 630, 645, 660, 675, 690, 705, 720, 735, 750, 765, 780, 795, 810, 825, 840, 855, 870, 885, 900, 915, 930, 945, 960, 975, 990, 1005, 1020, 1035, 1050, 1065, 1080, 1095, 1110, 1125, 1140, 1155, 1170, 1185, 1200, 1215, 1230, 1245, 1260, 1275, 1290, 1305, 1320, 1335, 1350, 1365, 1380, 1395, 1410, 1425, 1440, 1455, 1470, 1485, 1500, 1515, 1530, 1545, 1560, 1575, 1590, 1605, 1620, 1635, 1650, 1665, 1680, 1695, 1710, 1725, 1740, 1755, 1770, 1785, 1800, 1815, 1830, 1845, 1860, 1875, 1890, 1905, 1920, 1935, 1950, 1965, 1980, 1995, 2010, 2025, 2040, 2055, 2070, 2085, 2100, 2115, 2130), yield = c(9.3411, 9.32582, 10.5475, 13.5358, 17.3376, 16.7444, 20.7234, 19.8374, 24.327, 27.4162, 27.38, 31.3926, 29.3289, 32.2556, 33.0025, 35.3358, 35.8986, 40.1859, 40.3886, 42.2828, 41.23, 43.8108, 43.9391, 43.9543, 48.0524, 47.8295, 48.674, 48.2456, 50.2641, 50.7147, 49.6828, 52.8877, 51.7906, 57.2553, 53.6175, 57.0186, 57.6598, 56.4049, 57.1446, 58.5464, 60.7213, 61.0584, 57.7481, 59.9151, 64.475, 61.2322, 63.5167, 64.6289, 64.4245, 62.0048, 65.5821, 65.8275, 65.7584, 68.0523, 65.4874, 68.401, 68.1503, 67.8713, 69.5478, 69.9774, 73.4199, 66.7266, 70.4732, 67.5119, 69.6107, 70.4911, 72.7592, 69.3821, 72.049, 70.2548, 71.6336, 70.6215, 70.8611, 72.0337, 72.2842, 76.0792, 75.2526, 72.7016, 73.6547, 75.6202, 76.5013, 74.2459, 76.033, 78.4803, 76.3058, 73.837, 74.795, 76.2126, 75.1816, 75.3594, 79.9158, 77.8157, 77.8152, 75.3712, 78.3249, 79.1198, 77.6184, 78.1244, 78.1741, 77.9305, 79.7576, 78.0261, 79.8136, 75.5314, 80.2177, 79.786, 81.078, 78.4183, 80.8013, 79.3855, 81.5268, 78.416, 78.9021, 79.9394, 80.8221, 81.241, 80.6111, 79.7504, 81.6001, 80.7021, 81.1008, 82.843, 82.2716, 83.024, 81.0381, 80.0248, 85.1418, 83.1229, 83.3334, 83.2149, 84.836, 79.5156, 81.909, 81.1477, 85.1715, 83.7502, 83.8336, 83.7595, 86.0062, 84.9572, 86.6709, 84.4124)), .Names = c("time", "yield"), row.names = c(NA, -142L), class = "data.frame")

• 我想对数据做些什么：

我需要平滑数据以绘制一阶导数。在论文中，作者提到可以拟合高阶多项式并使用它来进行我认为错误的处理，因为我们并不真正知道数据的时间和收益之间的真实关系，并且绝对不是多义的。我无论如何都试过了，衍生物的情节并没有像预期的那样有任何化学意义。接下来，我使用loes<-loess(Yield~Time,data=df,span=0.9)调查黄土，这样可以更好地适应。然而，到目前为止最好的结果是使用：

spl <- smooth.spline(df$Time, y=df$Yield,cv=TRUE)
colnames(predspl)<-c('Time','Yield')
pred.der<-as.data.frame(predict(spl, deriv=1))
colnames(pred.der)<-c('Time', 'Yield')

，特别是在初始数据点（通过目视检查）给出了最佳拟合。

• 我遇到的问题：

然而问题是衍生物看起来非常好，只有t = 500s然后它开始越来越多地走向终点。从化学角度来看，这不应该发生，并且这仅仅是由于噪声的增加而导致数据末端过度拟合的结果。我知道这一点，因为对于一些实验，我已经进行了3次并对数据进行了平均（因此噪声降低了），在导数图中扭曲要小得多。

• 到目前为止我尝试过：

我尝试了不同的翼梁值，虽然它能够正确地平滑后来的数据，但它会导致初始数据不合适（这是最重要的）。我也试图减少结的数量，但我得到了与更改晶石值的结果类似的结果。我认为我需要的是在开始时有更多的结，它会平稳地减少到最后的少数结，以避免过度拟合。

• 问题：

我的推理是否正确？有谁知道我怎么能有上述效果才能获得平滑的衍生物而不会有任何摆动？我可能需要尝试除样条之外的其他适合吗？我最后附上了一张照片，你可以看到smooth.spline与时间的衍生物以及它应该是什么样子的黑色线条（用手绘制）。感谢您的帮助。

Answer 1

我认为你在曲线起点的样条曲线上有更紧密间距的结，这是正确的轨道。您可以使用smooth.spline为all.knots指定结点位置（至少在R＆gt; = 3.4.3;我浏览了R的发行说明，但无法确定可用的版本） ）。

下面是一个例子，在尝试不同的结位置的一些手工工作之后，导致的导数更加平滑：

with(df, {
  kn <- c(0, c(50, 100, 200, 350, 500, 1500) / max(time), 1)
  s <- smooth.spline(time, yield, cv = T)
  s2 <- smooth.spline(time, yield, all.knots = kn)

  ds <- predict(s, d = 1)
  ds2 <- predict(s2, d = 1)

  np <- list(mfrow = c(2, 1), mar = c(4, 4, 1, 2))
  withr::with_par(np, {
    plot(time, yield)
    lines(s)
    lines(s2, lty = 2, col = 'red')

    plot(ds, type = 'l', ylim = c(0, 0.15))
    lines(ds2, lty = 2, col = 'red')
  })
})

您可以进一步微调位置，但我不会太在意它。主要的契合已经接近无法区分了，我说你在识别衍生物的细节方面对这些数据提出了很多要求（如果你plot(time[-1], diff(yield) / diff(time))给出的话，这应该很明显你对数据带来的衍生信息水平的印象。

由reprex package（v0.2.0）创建于2018-02-15。