通過引導，曲線擬合在ggplot中可視化多條曲線

Question

我有使用正弦曲線很好地建模的時間序列數據。 我想使用自舉來可視化擬合模型中的不確定性。

我從這里修改了方法。 我也對使用nlsBoot這種方法 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輸出

誰能提供幫助？ 為什么顯示的曲線不平滑？ 有沒有更好的實施方法？

Answer 1

broom::augment只是返回每個可用數據點的擬合值。 因此， x的分辨率僅限於數據的分辨率。 您可以從模型中以更高的分辨率predict值：

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()