自动化，数据框 %>% 嵌套 %>% purrr:map / walk tidyverse 工作流，有条件地选择列答案

【问题标题】：Automating, dataframe %>% nest %>% purrr:map / walk tidyverse workflow with conditional selection of columns自动化，数据框 %>% 嵌套 %>% purrr:map / walk tidyverse 工作流，有条件地选择列
【发布时间】：2020-06-23 14:28:13
【问题描述】：

在tidyverse 理念中，对于data.frame 驱动的分析，使用管道进行嵌套和映射似乎是一个非常可行的工作流程。不利的一面是，要掌握语法需要花点功夫……

受到这个想法的启发，当我通过这个Coding in R: Nest and map your way to efficient code 时。一切都很好，但想知道是否可以简化工作流程，简而言之，结合：

嵌套并不可怕，您的数据也没有消失和
绘制你的巢穴，

一行，而不是两步。

为了可重复性，我们可以提出另一个 SO 问题：Using nest and purrr::map outside of mutate，可以轻松删除 cyl 列，但是，如果我想这样做

选择一些特定的列，例如，mpg、disp 和 vs 用于 4 圆柱体和
仅mpg、disp 用于8 气缸 和
删除/取消修改与6 气缸和相关的所有内容
使用map() 函数族和所选变量拟合lm() 模型和
使用walk() 之类的方式保存模型。

library(tidyverse)
mtcars %>%
  split(.$cyl) %>%
  map(~ .x %>% select(-cyl)) %>%
  walk2(names(.), ~write_csv(.x, paste0(.y, '.csv')))

这可以正常工作，但是当我尝试使用 nest 和 map 的方法时，即使没有尝试目标 1-3，它也会引发错误：

mtcars %>% group_by(cyl) %>% nest() %>% map(.$data, lm(.$mpg ~ .$disp + .$vs, .data))

错误：索引 1 的长度必须为 1，而不是 10 运行rlang::last_error() 以查看错误发生的位置。如果解决方案使用新引入的 across() 和 dplyr 1.0.0，那就太好了。

【问题讨论】：

标签： tidyverse data.frame nest map r dplyr tidyverse purrr

【解决方案1】：

你可以试试这样的。我希望这会有所帮助（不确定您在第 3 点中想要什么，但我提供了一种方法）：

data("mtcars")
#Create list
List <- split(mtcars,mtcars$cyl)
#Create function
models <- function(x)
{
  cyl <- unique(x$cyl)
  if(cyl==4)
  {
    mymodel <- lm(mpg ~ disp+vs, data=x)
  } else if(cyl==8)
  {
    mymodel <- lm(mpg ~ disp, data=x)
  } else
  {
    mymodel <- lm(mpg ~ 1, data=x)
  }
  #Dataframe
  dfmymodel <- cbind(data.frame(Group=cyl,model=as.character(mymodel$call)[2]),as.data.frame(t(mymodel$coefficients)))
  return(dfmymodel)
}
#Apply function
List2 <- lapply(List, models)
#Final output
DF <- do.call(plyr::rbind.fill,List2)

  Group           model (Intercept)        disp        vs
1     4 mpg ~ disp + vs    42.65658 -0.13845873 -1.579492
2     6         mpg ~ 1    19.74286          NA        NA
3     8      mpg ~ disp    22.03280 -0.01963409        NA

【讨论】：

【解决方案2】：

这是使用purrr 的另一种方法，类似于these 示例。

library(tidyverse)

mtcars %>% 
  group_by(cyl) %>% 
  nest() %>% 
  mutate(model = case_when(
    cyl == 4 ~ map(data, function(df) lm(mpg ~ disp + vs, data = df)),
    cyl == 8 ~ map(data, function(df) lm(mpg ~ disp , data = df)),
    TRUE     ~ map(data, function(df) lm(mpg ~ 1 , data = df))
    ),
    model_tidy = map(model, broom::tidy)) %>%
  select(cyl, model_tidy) %>%
  unnest


#-------
# A tibble: 6 x 6
    cyl term        estimate std.error statistic      p.value
  <dbl> <chr>          <dbl>     <dbl>     <dbl>        <dbl>
1     6 (Intercept)  19.7      0.549      35.9   0.0000000310
2     4 (Intercept)  42.7      5.16        8.26  0.0000346   
3     4 disp         -0.138    0.0353     -3.93  0.00438     
4     4 vs           -1.58     3.14       -0.503 0.629       
5     8 (Intercept)  22.0      3.35        6.59  0.0000259   
6     8 disp         -0.0196   0.00932    -2.11  0.0568

【讨论】：