如何使用R中的smatr包绘制主轴拟合的置信区间？

Question

我使用R中的smatr打包将SMA拟合到异速生长测量数据，并且我很难绘制由sma()命令计算的95％置信区间。

在包文档中获取示例数据，如何将上下95％置信线添加到xy数据和SMA拟合图中？

# Load leaf lifetime dataset:
data(leaflife)

# Fit SMA
ft <- sma(longev~lma, data=leaflife, log="xy", method="SMA")

#plot data and fit
plot(ft, log="xy")

我现在如何为我的情节添加95％置信区间的线条？

谢谢！

Answer 1

我最近遇到了这个问题，并且smatr包没有返回预测周围的置信区间。

然而，这些可以通过自举来实现，其中随机数据集是在适合它们的同一模型上制作的。通过提取所有截距和斜率，您可以在预测周围获得95％的置信区间。

可能有很多方法可以做到这一点，但我使用tidyverse完成了它。这会使用包model，purrr，dplyr等等。如果有人提供更优雅的解决方案，我会提供更多代码行，让我知道。

我在运行模型之前进行log10变换，因为它可以更容易地绘制ggplot2中的点和预测。

# smatr bootstrap example

# load packages
library(smatr)
library(dplyr)
library(purrr)
library(tidyr)
library(ggplot2)

# load data
data(leaflife)

# make columns log scale
leaflife <- mutate(leaflife, log_longev = log10(longev),
                   log_lma = log10(lma))

# fit sma
mod <- sma(log_longev ~ log_lma, data=leaflife, method="SMA")

# plot model
plot(mod)

# create new data set of log_lma at a high resolution (200 points from min to max)
preds <- data.frame(expand.grid(log_lma = seq(min(leaflife$log_lma, na.rm = T), max(leaflife$log_lma, na.rm = T), length.out = 200), stringsAsFactors = FALSE))

# bootstrap data and get predictions
preds <- leaflife %>%
  # create new bootstrapped data sets
  modelr::bootstrap(n = 1000, id = 'boot_num') %>%
  # fit sma to every bootstrap
  group_by(boot_num) %>%
  mutate(., fit = map(strap, ~ sma(log_longev ~ log_lma, data=data.frame(.), method="SMA"))) %>%
  ungroup() %>%
  # extract intercept and slope from each fit
  mutate(., intercept = map_dbl(fit, ~coef(.x)[1]),
         slope = map_dbl(fit, ~coef(.x)[2])) %>%
  select(., -fit) %>%
  # get fitted values for each bootstrapped model
  # uses the preds dataframe we made earlier
  group_by(boot_num) %>%
  do(data.frame(fitted = .$intercept + .$slope*preds$log_lma, 
                log_lma = preds$log_lma)) %>%
  ungroup() %>%
  # calculate the 2.5% and 97.5% quantiles at each log_lma value
  group_by(., log_lma) %>%
  dplyr::summarise(., conf_low = quantile(fitted, 0.025),
                   conf_high = quantile(fitted, 0.975)) %>%
  ungroup() %>%
  # add fitted value of actual unbootstrapped model
  mutate(., log_longev = coef(mod)[1] + coef(mod)[2]*log_lma)

# plot with ggplot
ggplot(leaflife, aes(log_lma, log_longev)) +
  geom_point() +
  geom_line(data = preds) +
  geom_ribbon(aes(ymin = conf_low, ymax = conf_high), alpha = 0.1, preds) +
  theme_bw()

然后给出这个情节