使用 purrr + map 过滤列表答案

【问题标题】：Filtering through a list using purrr + map使用 purrr + map 过滤列表
【发布时间】：2021-01-25 22:14:50
【问题描述】：

我有一个数据框，我使用整个数据集在其上运行多个 GLM。

  df <- data.frame(Var1 = sample(as.factor(0:1), replace = TRUE, 1000),
                   Var2 = runif(100),
                   Var3 = runif(100),
                   Var4 = runif(100),
                   Var5 = sample(as.factor(0:1), replace = TRUE, 1000),
                   Var6 = sample(as.factor(0:1), replace = TRUE, 1000))

  df %>%
  pivot_longer(cols = c("Var3","Var4")) %>%
  group_by(name)  %>%  nest() %>%
  mutate(model = map(data,~glm(Var1 ~ value, data = .x,family=binomial("logit"))))  %>%
  mutate(tidy= map(model, tidy)) %>%
  unnest(tidy)

现在我想使用 Var5 和 Var6 来过滤我的数据集。

我想要 4 个可能的数据集 Var52 * Var62

中的每一个的 GLM

使用 cross() 我可以得到 Var 5 和 Var 6 的值的所有组合。

list <-  df %>% 
  expand(Var5,Var6) %>%
  cross()

现在我想使用列表过滤我的数据框。所以我想为 4 个可能的数据帧中的每一个运行一个 GLM。

例如在手动模式下。

  df %>%
  filter(Var5 == 1 & Var6 == 1) %>%
  pivot_longer(cols = c("Var3","Var4")) %>%
  group_by(name)  %>%  nest() %>%
  mutate(model = map(data,~glm(Var1 ~ value, data = .x, family=binomial("logit"))))  %>%
  mutate(tidy= map(model, tidy)) %>%
  unnest(tidy)

  df %>%
  filter(Var5 == 1 & Var6 == 0) %>%
  pivot_longer(cols = c("Var3","Var4")) %>%
  group_by(name)  %>%  nest() %>%
  mutate(model = map(data,~glm(Var1 ~ value, data = .x, family=binomial("logit"))))  %>%
  mutate(tidy= map(model, tidy)) %>%
  unnest(tidy)

ect...

感谢您就实现这一目标给我的任何建议。

【问题讨论】：

是您的mutate 代码的一部分，即df %>% mutate..。关于filter，您可以使用split(df, list(df['Var4', 'Var5'), drop = TRUE) 或与group_split 即df%>% group_split(Var5, Var5) 一起使用list
非常感谢您关注这个问题。我忘了发布一些代码来进一步澄清我的问题。我已经用额外的信息更新了它。如果我正确阅读了您的解决方案，您将在嵌套 Var5 和 Var6 的嵌套中放置一个嵌套，以便获得我的 4 种组合？

标签： r dictionary purrr

【解决方案1】：

以下是使用 {dplyr} 的 rowwise 表示法（而不是 purrr::map）的方法。

library(tidyverse)

df <- data.frame(Var1 = sample(as.factor(0:1), replace = TRUE, 1000),
                 Var2 = runif(100),
                 Var3 = runif(100),
                 Var4 = runif(100),
                 Var5 = sample(as.factor(0:1), replace = TRUE, 1000),
                 Var6 = sample(as.factor(0:1), replace = TRUE, 1000))

df %>%
  pivot_longer(cols = c("Var3","Var4")) %>%
  nest_by(name) %>% 
  crossing(Var5 = c(0,1), Var6 = c(0,1)) %>% 
  rowwise() %>% 
  mutate(data =  list(filter(data, Var5 == .env$Var5 & Var6 == .env$Var6)),
         model = list(glm(Var1 ~ value, data = data, family = binomial("logit")))) %>%
  mutate(tidy = list(broom::tidy(model))) %>%
  unnest(tidy)     
#> # A tibble: 16 x 10
#>    name  data       Var5  Var6 model term   estimate std.error statistic p.value
#>    <chr> <list>    <dbl> <dbl> <lis> <chr>     <dbl>     <dbl>     <dbl>   <dbl>
#>  1 Var3  <tibble ~     0     0 <glm> (Inte~  0.304       0.265    1.14     0.253
#>  2 Var3  <tibble ~     0     0 <glm> value  -0.321       0.432   -0.743    0.457
#>  3 Var3  <tibble ~     0     1 <glm> (Inte~  0.201       0.267    0.751    0.452
#>  4 Var3  <tibble ~     0     1 <glm> value  -0.357       0.436   -0.819    0.413
#>  5 Var3  <tibble ~     1     0 <glm> (Inte~ -0.197       0.252   -0.779    0.436
#>  6 Var3  <tibble ~     1     0 <glm> value   0.362       0.420    0.863    0.388
#>  7 Var3  <tibble ~     1     1 <glm> (Inte~ -0.428       0.261   -1.64     0.101
#>  8 Var3  <tibble ~     1     1 <glm> value   0.668       0.417    1.60     0.109
#>  9 Var4  <tibble ~     0     0 <glm> (Inte~  0.212       0.234    0.906    0.365
#> 10 Var4  <tibble ~     0     0 <glm> value  -0.166       0.403   -0.413    0.680
#> 11 Var4  <tibble ~     0     1 <glm> (Inte~ -0.00765     0.211   -0.0363   0.971
#> 12 Var4  <tibble ~     0     1 <glm> value   0.0328      0.357    0.0919   0.927
#> 13 Var4  <tibble ~     1     0 <glm> (Inte~  0.142       0.219    0.649    0.516
#> 14 Var4  <tibble ~     1     0 <glm> value  -0.316       0.378   -0.835    0.404
#> 15 Var4  <tibble ~     1     1 <glm> (Inte~  0.0682      0.222    0.307    0.759
#> 16 Var4  <tibble ~     1     1 <glm> value  -0.280       0.385   -0.728    0.467

^{由reprex package (v0.3.0) 于 2021-01-27 创建}

【讨论】：