如何从 R 的列表中 plot 线性模型的集合

Question

我正在从R for Data Science做一个练习，要求我将线性 model 拟合到模拟数据集的几次运行中。 我是手动完成的，但后来想扩展这个想法。 我试图根据另一个网站的解决方案扩展这个想法。 该解决方案如下：

对我来说，这个解决方案的问题是我还不熟悉/不习惯使用methods 。 所以我尝试根据我所知道的知识重新创建这个解决方案。 接下来是我的评论解决方案以及我陷入困境的地方。

1. 首先，我生成了要在本练习中使用的数据：

simt = function(i) {
   tibble(
    x = rep(1:10, each = 3),
    y = x * 1.5 + 6 + rt(length(x), df = 2),
    .id = i
  )
}

sims = map_df(1:12, simt)

2. 由于我想拥有多个线性模型，因此我使用.id作为参考将我的数据分成数据框列表。 我使用for循环对列表进行了分区：

partition_sims = list()   #initialize a list of data frames

for(i in 1:10){                                     #Created a for loop to partition the large data frame  
  partition_sims[[i]] = filter(sims, .id == i)        #into a smaller data frames and put into
  }                                                   #my list of data frames. Note the use of [[ instead 
                                                      #of [. Needed to do this to select the 
                                                       #individual data frames for list  

3. 下一步是通过计算每个数据帧的截距和斜率来创建线性模型列表。 我也将这个线性模型集合放入一个列表中。 我通过编写另一个 for 循环来做到这一点：

lm_list = list()    #initialize list of linear models

for(i in 1:10){
  lm_list[[i]] = lm(y ~ x, data = partition_sims[[i]])
  }

所以这就是我的问题开始的地方。 我一直在尝试将 plot 我的线性模型集合与原始数据集sims进行对比。 我所设想的是将每个线性 model 分别针对与其.id编号对应的原始数据集进行绘制，并将其全部显示在一个方面。

作为我尝试做的一个示例，我尝试针对分离的数据帧绘制一个线性 model：

ggplot(data = sims, mapping = aes(x,y)) + geom_point() + geom_abline(intercept = coef(lm_list[[1]])[1], slope = coef(lm_list[[1]])[2]) + facet_wrap(~.id)

那行得通，所以我想对此进行扩展。 我认为我的挑战是试图以某种方式将geom_abline命令复制到我的lm_list中的一个元素而不是所有元素上。 所以我希望循环可以处理以下形式：

我认为可能有用的一件事是利用 R 的回收向量功能，所以我编写了一个for循环来提取必要的值并将它们放入向量中：

vec_of_slope = vector()
vec_of_inter = vector()

for(i in 1:10){
    vec_of_inter[i] = coef(lm_list[[i]])[1]
    vec_of_slope[i] = coef(lm_list[[i]])[2]
}

然后将这些向量放入我的ggplot命令中：

我走得更近了，但这个问题是所有十个线性模型都绘制在每个数据帧上。

我的最后一个想法可能是制作一个地块列表，然后根据列表中的索引号对它们进行分面。 我再次尝试用 for 循环填充列表：

collection_of_plots = list()

for(i in 1:10){
    collection_of_plots[i] = ggplot(data = sims, mapping = aes(x,y)) + geom_point() + geom_abline(intercept = coef(lm_list[[i]])[1], slope = coef(lm_list[[i]])[2])
}

好吧，这次尝试向我射击了In collection_of_plots[i] <- ggplot(data = sims, mapping = aes(x, : number of items to replace is not a multiple of replacement length 。所以不用说这也不起作用.

所以我呼吁这里有知识的人，我能做些什么来挽救这个解决方案？

一些免责声明：

1. 我知道可能有比我介绍的更清洁的解决方案。 我现在不是在寻找最肮脏的东西。 我试图先了解基础。

2. 我正在使用 Tidyverse package

3. 写问题时如何使文本丰富多彩？

编辑：我可能已经更近了一步。 我决定对截距和斜率做一个小标题：

collection_of_plots = tibble(
  interc = vector()
  slope = vector()
)

for(i in 1:10){
  collection_of_plots[i,1] =  coef(lm_list[[i]])[1] 
  collection_of_plots[i,2] =  coef(lm_list[[i]])[2]
}

仍然不完整，但可能更接近。

Answer 1

使用更多的purrr魔法（for-loops 也可以）以及broom和一些tidyr可以像这样实现：

1. 使用split()拆分数据
2. 通过purrr::map对拆分后的数据进行 ping 操作来制作模型
3. 使用broom::tidy列出整洁的 model 结果列表。
4. 使用dplyr::bind_rows将结果列表绑定到一个 df 中。
5. 为了便于绘图，请使用tidyr::pivot_wider将 df 带入正确的形状
6. 使用geom_point中的原始数据，使用带有 model 的 df 导致geom_abline

library(dplyr)
library(ggplot2)
library(purrr)
library(tidyr)

simt = function(i) {
  tibble(
    x = rep(1:10, each = 3),
    y = x * 1.5 + 6 + rt(length(x), df = 2),
    .id = i
  )
}
sims = map_df(1:12, simt)

# Split with split
partition_sims <- split(sims, sims$.id)

# Make models by "map"ping over the the data
lm_list <- map(partition_sims, ~ lm(y ~ x, data = .x))
# Make a tidy df of model results by using broom. 
# Bind the single models in one df using bind_rows.
# For easy plotting use pivot_wider to bring the df into the right shape
lm_tidy <- map(lm_list, broom::tidy) %>% 
  bind_rows(.id = ".id") %>% 
  select(.id, term, estimate) %>% 
  pivot_wider(names_from = "term", values_from = "estimate")

# Plot. Use original data for points, model results for abline
ggplot() + 
  geom_point(data = sims, mapping = aes(x, y, color = factor(.id))) + 
  geom_abline(data = lm_tidy, aes(intercept = `(Intercept)` , slope = x)) + 
  facet_wrap(~.id) +
  guides(color = FALSE)

^{由reprex package (v0.3.0) 于 2020 年 7 月 16 日创建}