从引导，曲线拟合中可视化ggplot中的多条曲线 [英] Visualizing multiple curves in ggplot from bootstrapping, curve fitting

问题描述

我有时间序列数据，使用正弦曲线很好地建模。我希望使用引导来显示拟合模型中的不确定性。

我调整了

需要做更多工作来增加平均值和95％置信区间： / p>

  quant<  -  fitted_boot％>％
 group_by（xdata）％>％
总结（均值=均值（.fitted），
低=分位数（.fitted，0.025），
高位=分位数（.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（）
  

I have time series data that is well modeled using a sinusoidal curve. I'd like to visualize the uncertainty in the fitted model using bootstrapping.

I adapted the approach from here. I am also interested in this approach too, using nlsBoot. I can get the first approach to run, but the resulting plot contains curves that are not continuous, but jagged.

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

Can anyone offer help? Why are the displayed curves not smooth? Is there a better way to implement?

解决方案

broom::augment is merely returning fitted values for each of the available data points. Therefore, the resolution of x is limited to the resolution of the data. You can predict values from the model with a much higher resolution:

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

Some more work is needed to add the mean and 95% confidence interval:

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

这篇关于从引导，曲线拟合中可视化ggplot中的多条曲线的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！