r - 通过引导、曲线拟合在 ggplot 中可视化多条曲线

Question

我有使用正弦曲线很好地建模的时间序列数据。我想使用 Bootstrap 可视化拟合模型中的不确定性。

我采用了 here. 中的方法我对此也感兴趣approach也可以使用nlsBoot。我可以运行第一种方法，但生成的图包含不连续的曲线，而是锯齿状的。

library(dplyr)
library(broom)
library(ggplot2)

xdata <- c(-35.98, -34.74, -33.46, -32.04, -30.86, -29.64, -28.50, -27.29, -26.00, 
           -24.77, -23.57, -22.21, -21.19, -20.16, -18.77, -17.57, -16.47, -15.35,
           -14.40, -13.09, -11.90, -10.47, -9.95,-8.90,-7.77,-6.80, -5.99,
           -5.17, -4.21, -3.06, -2.29, -1.04)
ydata <- c(-4.425, -4.134, -5.145, -5.411, -6.711, -7.725, -8.087, -9.059, -10.657,
           -11.734, NA, -12.803, -12.906, -12.460, -12.128, -11.667, -10.947, -10.294,
           -9.185, -8.620, -8.025, -7.493, -6.713, -6.503, -6.316, -5.662, -5.734, -4.984,
           -4.723, -4.753, -4.503, -4.200)

data <- data.frame(xdata,ydata)

bootnls_aug <- data %>% bootstrap(100) %>%
  do(augment(nls(ydata ~ A*cos(2*pi*((xdata-x_0)/z))+M, ., start=list(A=4,M=-7,x_0=-10,z=30),.)))
ggplot(bootnls_aug, aes(xdata, ydata)) +
  geom_line(aes(y=.fitted, group=replicate), alpha=.1, color="blue") +
  geom_point(size=3) +
  theme_bw()

ggplot output

有人可以提供帮助吗？为什么显示的曲线不平滑？有没有更好的实现方法？

Answer 1

broom::augment 只是返回每个可用数据点的拟合值。因此，x 的分辨率仅限于数据的分辨率。您可以以更高的分辨率从模型中预测值:

x_range <- seq(min(xdata), max(xdata), length.out = 1000)

fitted_boot <- data %>% 
  bootstrap(100) %>%
  do({
    m <- nls(ydata ~ A*cos(2*pi*((xdata-x_0)/z))+M, ., start=list(A=4,M=-7,x_0=-10,z=30))
    f <- predict(m, newdata = list(xdata = x_range))
    data.frame(xdata = x_range, .fitted = f)
    } )

ggplot(data, aes(xdata, ydata)) +
  geom_line(aes(y=.fitted, group=replicate), fitted_boot, alpha=.1, color="blue") +
  geom_point(size=3) +
  theme_bw()

还需要做一些工作来添加平均值和 95% 置信区间:

quants <- fitted_boot %>% 
  group_by(xdata) %>% 
  summarise(mean = mean(.fitted),
            lower = quantile(.fitted, 0.025),
            upper = quantile(.fitted, 0.975)) %>% 
  tidyr::gather(stat, value, -xdata)

ggplot(mapping = aes(xdata)) +
  geom_line(aes(y = .fitted, group = replicate), fitted_boot, alpha=.05) +
  geom_line(aes(y = value, lty = stat), col = 'red', quants, size = 1) +
  geom_point(aes(y = ydata), data, size=3) +
  scale_linetype_manual(values = c(lower = 2, mean = 1, upper = 2)) +
  theme_bw()