感谢我的帮助here,我能够使用自举获得曲线拟合的意大利面条图。我试图从这些合适的模型中获得置信区间。我没有运气得到像
这样的东西quants <- apply(fitted_boot, 1, quantile, c(0.025, 0.5, 0.975))
使用以下内容:
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)
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()
我想也许geom_ribbon()会是一个很好的方式,但我不知道从哪里开始。
感谢Axeman在另一篇文章中提供的帮助!
答案 0 :(得分:1)
一种方法是计算每个x值的置信区间,然后绘制该值。在这里,我使用的是第2.5百分位数和第97.5百分位数之外的第一个值,但您可以根据需要调整代码。
首先,我更改为group_by
个xdata
位置(而不是重复)。然后,我arrange
按.fitted
值,这样我就可以slice
输出我想要的值(第一个超出百分位截止值)。最后,我使用哪个绑定标记它们(它们总是低于高位,因为我们排序了)。
forConfInt <-
fitted_boot %>%
ungroup() %>%
group_by(xdata) %>%
arrange(.fitted) %>%
slice(c(floor(0.025 * n() )
, ceiling(0.975 * n() ) ) ) %>%
mutate(range = c("lower", "upper"))
这给出了:
replicate xdata .fitted range
<int> <dbl> <dbl> <chr>
1 9 -35.98000 -4.927462 lower
2 94 -35.98000 -4.249348 upper
3 9 -35.94503 -4.927248 lower
4 94 -35.94503 -4.257776 upper
5 9 -35.91005 -4.927228 lower
6 94 -35.91005 -4.266334 upper
7 9 -35.87508 -4.927401 lower
8 94 -35.87508 -4.275020 upper
9 9 -35.84010 -4.927766 lower
10 94 -35.84010 -4.283836 upper
# ... with 1,990 more rows
然后我们可以在ggplot
调用中添加一行:
ggplot(data, aes(xdata, ydata)) +
geom_line(aes(y=.fitted, group=replicate), fitted_boot, alpha=.1, color="blue") +
# Added confidence interval:
geom_line(aes(y=.fitted, group=range), forConfInt, color="red") +
geom_point(size=3) +
theme_bw()
给出了这个情节: