如何根据分组变量的值进行变异和映射?

How to mutate and map conditional on values of grouping variables?

假定以下示例工作流。这样的代码将允许将函数映射到分组变量

df <- tibble(group1 = rep(letters[1:10],100),
             group2 = rep(letters[1:10],100),
             var1 = rnorm(1000),
             var2 = rnorm(1000)) %>% 
group_by(group1,group2) %>% 
  nest() %>% 
  mutate(model = map(data, ~lm(var1 ~ var2, .)))

我想做的是 mutate()map() 以分组变量的值为条件。例如:

  mutate(model = map(data, ~lm(var1 ~ var2, .))) 

当 group2 %in% c("a","b","c") 和

  mutate(model = map(data, ~lm(var1 ~ 1, .))) 

当 group2 不在 c("a","b","c") 中时

您可以使用函数 purrr::map_if() 来完成此操作。它带有一个谓词函数,无论谓词是真还是假,它都可以执行不同的功能,就像这样:

purrr::map_if(
      .x = data, 
      .p = ~ group2 %in% c("a", "b", "c"),
      .f = ~lm(var1 ~ var2, .x), 
      .else = ~lm(var1 ~ 1, .x)
    )

完整的代表

这里是根据你的数据做的reprex(我加了一列来验证逻辑是否正确):

library(dplyr, warn.conflicts = FALSE)

tibble(
  group1 = rep(letters[1:10],100),
  group2 = rep(letters[1:10],100),
  var1 = rnorm(1000),
  var2 = rnorm(1000)
) %>% 
  group_by(group1, group2) %>% 
  tidyr::nest() %>% 
  mutate(
    model = purrr::map_if(
      .x = data, 
      .p = ~ group2 %in% c("a", "b", "c"),
      .f = ~lm(var1 ~ var2, .x), 
      .else = ~lm(var1 ~ 1, .x)
    )
  ) %>%
  # Note: I add this column to verify the logic
  mutate(
    formula = purrr::map_chr(.x = model, ~.x$call %>% rlang::as_label())
  )
#> # A tibble: 10 x 5
#> # Groups:   group1, group2 [10]
#>    group1 group2 data               model  formula                             
#>    <chr>  <chr>  <list>             <list> <chr>                               
#>  1 a      a      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ var2, data = .x)
#>  2 b      b      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ var2, data = .x)
#>  3 c      c      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ var2, data = .x)
#>  4 d      d      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#>  5 e      e      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#>  6 f      f      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#>  7 g      g      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#>  8 h      h      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#>  9 i      i      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)   
#> 10 j      j      <tibble [100 x 2]> <lm>   lm(formula = var1 ~ 1, data = .x)