Question

我正在寻找一种有效的方法来识别对线性模型参数有巨大影响的数据点。这对于普通的线性模型来说很简单，但我不确定如何使用贝叶斯线性模型。

这是普通线性模型的一种方法，我们可以计算每个数据点的库克距离，并绘制包含库克距离的诊断图：

# ordinary linear model diagnostics, similar to my use-case
library(dplyr)
library(purrr)
library(tidyr)
library(broom)
# make linear models for each type of species
xy <- 
  iris %>% 
  nest(-Species) %>% 
  mutate(model = map(data, 
                     ~lm(Sepal.Length ~ Petal.Width, 
                         data = .)),
         fit = map(model, augment))

这里我们有一个带有嵌套列表的数据框，model列包含每个物种的线性模型：

> xy
# A tibble: 3 × 4
     Species              data    model                   fit
      <fctr>            <list>   <list>                <list>
1     setosa <tibble [50 × 4]> <S3: lm> <data.frame [50 × 9]>
2 versicolor <tibble [50 × 4]> <S3: lm> <data.frame [50 × 9]>
3  virginica <tibble [50 × 4]> <S3: lm> <data.frame [50 × 9]>

broom::augment功能允许我们将每个数据点的库克距离值添加到此数据框中，我们可以像这样检查它们：

# inspect Cook's distance values
xy %>% 
 unnest(fit) %>% 
 arrange(desc(.cooksd))

  # A tibble: 150 × 10
      Species Sepal.Length Petal.Width  .fitted    .se.fit     .resid       .hat    .sigma    .cooksd
       <fctr>        <dbl>       <dbl>    <dbl>      <dbl>      <dbl>      <dbl>     <dbl>      <dbl>
1  versicolor          5.9         1.8 6.612097 0.16181001 -0.7120969 0.13725081 0.4269862 0.24507448
2      setosa          5.0         0.6 5.335281 0.17114108 -0.3352811 0.25027563 0.3410686 0.21385214
3   virginica          4.9         1.7 6.375829 0.13613717 -1.4758292 0.04875277 0.5826838 0.15434787
4      setosa          5.7         0.4 5.149247 0.08625887  0.5507534 0.06357957 0.3355980 0.09396588
5      setosa          4.3         0.1 4.870195 0.08321347 -0.5701948 0.05916942 0.3349111 0.09285408
6   virginica          5.8         2.4 6.831411 0.14828703 -1.0314106 0.05784319 0.6035012 0.09117693
7   virginica          7.2         1.6 6.310746 0.16207266  0.8892538 0.06909799 0.6084108 0.08293253
8  versicolor          4.9         1.0 5.471005 0.11998077 -0.5710051 0.07546185 0.4328038 0.07544526
9      setosa          5.8         0.2 4.963212 0.05287342  0.8367879 0.02388828 0.3228858 0.07500610
10 versicolor          6.0         1.0 5.471005 0.11998077  0.5289949 0.07546185 0.4340307 0.06475225
# ... with 140 more rows, and 1 more variables: .std.resid <dbl>

使用autoplot方法，我们可以制作显示库克距离值的信息性诊断图，并帮助我们快速识别对模型具有特大影响的数据点。 paramters：

# plot model diagnostics
library(ggplot2)
library(ggfortify)
diagnostic_plots_df <- 
  xy %>%  
  mutate(diagnostic_plots = map(model, 
                                ~autoplot(., 
                                          which = 1:6, 
                                          ncol = 3, 
                                          label.size = 3)))

这里只是其中一个图：

> diagnostic_plots_df[[1]]

现在，使用贝叶斯线性模型，我们可以类似地计算数据框中每个组的线性模型：

# Bayesian linear model diagnostics
library(rstanarm)
bayes_xy <- 
  iris %>% 
  nest(-Species) %>% 
  mutate(model = map(data, 
                     ~stan_lm(Sepal.Length ~ Petal.Width, 
                         data = .,
                         prior = NULL, 
                         chains = 1, 
                         cores = 2, 
                         seed = 1)),
         fit =  map(model, augment))

> bayes_xy
# A tibble: 3 × 4
     Species              data         model                   fit
      <fctr>            <list>        <list>                <list>
1     setosa <tibble [50 × 4]> <S3: stanreg> <data.frame [50 × 5]>
2 versicolor <tibble [50 × 4]> <S3: stanreg> <data.frame [50 × 5]>
3  virginica <tibble [50 × 4]> <S3: stanreg> <data.frame [50 × 5]>

但是broom::augment方法并没有像库克的距离值那样：

# inspect fit diagnostics
bayes_xy %>% unnest(fit)

# A tibble: 150 × 6
   Species Sepal.Length Petal.Width  .fitted    .se.fit      .resid
    <fctr>        <dbl>       <dbl>    <dbl>      <dbl>       <dbl>
1   setosa          5.1         0.2 4.963968 0.06020298  0.13482025
2   setosa          4.9         0.2 4.963968 0.06020298 -0.06517975
3   setosa          4.7         0.2 4.963968 0.06020298 -0.26517975
4   setosa          4.6         0.2 4.963968 0.06020298 -0.36517975
5   setosa          5.0         0.2 4.963968 0.06020298  0.03482025
6   setosa          5.4         0.4 5.151501 0.11299956  0.21818386
7   setosa          4.6         0.3 5.057734 0.05951488 -0.47349794
8   setosa          5.0         0.2 4.963968 0.06020298  0.03482025
9   setosa          4.4         0.2 4.963968 0.06020298 -0.56517975
10  setosa          4.9         0.1 4.870201 0.11408783  0.04313845
# ... with 140 more rows

没有autoplot方法：

# plot model diagnostics
bayes_diagnostic_plots_df <- 
  bayes_xy %>%  
  mutate(diagnostic_plots = map(model, 
                                ~autoplot(., 
                                          which = 1:6, 
                                          ncol = 3, 
                                          label.size = 3)))

# Error, there doesn't seem to be an autoplot method for stan_lm output

shinystan::launch_shinystan(bayes_xy$model[[1]])

# This is quite interesting, but nothing at the level of specific data points

一些学术文献讨论了诸如model perturbations，phi-divergence, Cook's posterior mode distance and Cook's posterior mean distance， Kullback-Leibler divergence，etc.，etc.等方法。但我无法看到R代码已探索过的任何地方，而且我被卡住了。

在Cross-validated上有关于此主题的an unanswered question。我在这里发帖是因为我正在寻找有关编写代码来计算影响力统计数据的想法（而不是关于统计理论和方法的建议，等等应该针对另一个问题）

如何从rstanarm::stan_lm的输出中获得类似Cook的距离度量？

Answer 1

Aki Vehtari说的post说得最好：

lppd_i和loo_i之间的差异已被用作敏感度量度（参见，例如，Gelfand等1992）。帕累托形状参数估计k很可能如果lppd_i和loo_i之间的差异很大，则为大。它还没有我清楚帕累托形状参数估计k是否会好于 lppd_i-loo_i，但至少我们知道lppd_i-loo_i的估计太小了如果k接近1或更大，那么看k可能更好。在使用普通模型的堆栈示例中，一个观察的k很大，但是 student-t模型k更小。普通模型与student-t模型相同，但是在自由度上非常强大。所以这不仅仅是强大的先前或更多的收缩，但有一个可以描述观察的模型好。随着收缩率增加和非稳健的观察模型，一个观察可能仍然令人惊讶。当然，改变为更强大的并不总是最佳解决方案允许“异常值”的观察模型。相反，制作它可能会更好回归函数更加非线性（即具有较弱的先验），或变换协变量，或添加更多协变量。所以我建议看Pareto形状参数值，但我不这样做如果值很大，建议增加收缩率。

您可以从loo包中$pareto_k函数生成的列表的loo元素中获取Pareto形状参数估计值k，该函数由rstanarm软件包重新导出。如果此值高于0.7（默认情况下），loo函数将建议您重新拟合模型而忽略此观察结果，因为后验分布可能对此观察过于敏感以满足假设LOOIC，每次观察对后验分布的影响可以忽略不计。

在OP的情况下，只有第七次观察的帕累托形状参数估计略大于0.5，因此观察可能对后部没有极端影响。但是你肯定想要调查值大于1.0的观测值

您还可以为loo对象调用plot方法，尤其是使用非默认选项label_points = TRUE来显示Pareto形状参数估计值。

Answer 2

查看stan-users电子邮件列表中的一些讨论，我看到loo包中的输出，包含每个观察点的贡献值＆＃39;。因此，尝试与这些人合作：

# Bayesian linear model diagnostics
library(rstanarm)
library(loo)
bayes_xy <- 
  iris %>% 
  nest(-Species) %>% 
  mutate(model = map(data, 
                     ~stan_lm(Sepal.Length ~ Petal.Width, 
                         data = .,
                         prior = NULL, 
                         chains = 1, 
                         cores = 2, 
                         seed = 1)))


bayes_xy_loo <- 
bayes_xy %>% 
  mutate(loo_out = map(model, ~loo(.)))

library(ggplot2)
library(ggrepel)
n <-  5 # how many points to label


my_plots <- 
bayes_xy_loo %>% 
  select(loo_out) %>% 
  mutate(loo_pointwise = map(.$loo_out, ~data.frame(.$pointwise))) %>% 
  mutate(plots = map(.$loo_pointwise, 
      ~ggplot(., 
       aes(elpd_loo,
           looic)) +
       geom_point(aes(size = p_loo)) +
       geom_text_repel(data = .[tail(order(.$looic), n),] ,
                  aes(label = row.names(.[tail(order(.$looic), n),])),
                  nudge_x = -0.1,
                  nudge_y = -0.3) +
        geom_label_repel(data = .[tail(order(.$elpd_loo), n),] ,
                        aes(label = row.names(.[tail(order(.$elpd_loo), n),])),
                        nudge_x = 0.1,
                        nudge_y = 0.1) +
       xlab("Expected log pointwise \npredictive density") +
       ylab("LOO information \ncriterion") +
       scale_size_area(name = "Estimated \neffective\nnumber \nof parameters") +
       theme_minimal(base_size = 10)))

do.call(gridExtra::grid.arrange, my_plots$plots)

然而，建议有影响力的观点并不是一个很好的匹配。例如，在我们有问题的问题。具有高库克距离值的7,15和30。在loo输出中，似乎只有obs。 15通常被识别。所以也许这不是正确的做法。

使用rstan

2 个答案: