【问题标题】：Applying simple function via across within nested data on each group通过在每个组的嵌套数据中应用简单函数
【发布时间】：2020-09-22 16:56:26
【问题描述】：

背景

鉴于nested data，我想在任意选择的列上应用一个使用across 的简单函数。使用across，我想遍历传递给函数一个参数的列选择，并保持第二个参数不变。

示例

# Using across within nested data frame

# Gapminder data from gapminder package
library("tidyverse")
data("gapminder", package = "gapminder")

# Sample function
sample_function <- function(.data, var_a, var_b) {
    var_a <- enquo(var_a)
    var_b <- enquo(var_b)
    .data %>%
        mutate(some_res = log(!!var_a) + !!var_b) %>%
        pull(some_res)
}


# Basic example, not working
gapminder %>%
    group_by(country, continent) %>%
    nest() %>%
    mutate(sample_res = map(
        .x = data,
        .f = across(
            .cols = vars(year, lifeExp, pop),
            .fns = ~ sample_function(var_a = .x),
            var_b = gdpPercap
        )
    )) %>%
    unnest(sample_res)

示例失败并出现以下错误：

错误：mutate() 输入 sample_res 有问题。 x 必须子集具有有效下标向量的列。 x 下标类型错误 quosures。 ℹ 必须是数字或字符。 ℹ 输入sample_res 是 map(...)。 ℹ 第1组出现错误：国家=“阿富汗”，大陆=“亚洲”。运行rlang::last_error()查看错误在哪里发生了。

期望的结果

我可以遍历选定的列，总是在var_a 中传递不同的参数。在这种情况下，这些值反映了 year、lifeExp 和 gdpPercap 变量。

gapminder %>%
    group_by(country, continent) %>%
    nest() %>%
    mutate(
        res_year = map(.x = data, 
                       .f = sample_function, var_a = year, var_b = gdpPercap),
        res_lifeExp = map(.x = data, 
                          .f = sample_function, var_a = lifeExp, 
                          var_b = gdpPercap),
        res_pop = map(.x = data, 
                      .f = sample_function, var_a = pop, var_b = gdpPercap)
    )

寻求解决方案

在所需结果中获得的解决方案相当不切实际且容易出错，因为会为每个变量强制新行。我想找到使用across 和map 的组合，这样我就可以通过向across 添加变量来运行映射函数的不同变体。

【问题讨论】：

在across 中，您使用的是sample_function(var_a = .x)，在这里，我想是传递的值而不是列名
你接受不整齐的评价答案吗？通过我想象的那种循环，确实可以通过一个整洁的评估
受@Brunos 方法的启发，我在下面更新了我的答案以使用nest_by 的另一种方法。

标签： r nested dplyr tibble

【解决方案1】：

最终更新（使用nest_by & across）

受@Brunos 回答的启发，我修改了使用nest_by / rowwise 而不是map 的方法（我猜，这是一种新的推荐嵌套小标题的方法）。

使用nest_by 可以轻松复制我原始答案的结果：

gapminder %>%
  nest_by(country, continent) %>%
  mutate(sample_res = list(transmute(data,
                                     across(c(year, lifeExp, pop),
                                            ~ sample_function(data, var_a = .x, var_b = gdpPercap))
  ))
  )

但是，它返回一个包含tibbles 的列表列。如果输出是法线向量，我们可以删除 sample_res = list() 并且新列将添加到您现有的小标题中。但是，在此示例中，每个新列的输出都是包含向量的列表列。我没有设法在对mutate(across(...)) 的一次调用中产生此输出。

虽然可以使用unnest，然后再次调用summarise(across(...)) 来完成工作。

gapminder %>%
  nest_by(country, continent) %>%
  mutate(sample_res = list(transmute(data,
                             across(c(year, lifeExp, pop),
                                    ~ sample_function(data, var_a = .x, var_b = gdpPercap))
                      ))
         ) %>% 
  unnest(cols = sample_res) %>%
  summarise(across(c(year, lifeExp, pop), list, .names = "res_{col}"))

原始答案（使用group_by、nest、map 和across）

您在across 调用中错误指定了sample_function。应该是

function(x) sample_function(.x, var_a = x, var_b = gdpPercap)

而不是

~ sample_function(var_a = .x),
                var_b = gdpPercap

由于您嵌套了map 和mutate(across(...))，我更喜欢使用至少一个“普通”匿名函数而不是lamda ~ 表示法。否则，两个.xs 可能会让事情变得混乱。

进一步的across 应在其自己的单独mutate 中调用。

这应该可行：

library("tidyverse")
data("gapminder", package = "gapminder")

# Sample function
sample_function <- function(.data, var_a, var_b) {
  var_a <- enquo(var_a)
  var_b <- enquo(var_b)

  .data %>%
    mutate(some_res = log(!!var_a) + !!var_b) %>%
    pull(some_res)
}

gapminder %>%
  group_by(country, continent) %>%
  nest() %>%  
  mutate(sample_res = map(
    data,
    ~ mutate(.x, across(c(year, lifeExp, pop),
                       function(x) { 
                         sample_function(.x, var_a = x, var_b = gdpPercap)
                        }
                       )
    )
   )
  )
#> # A tibble: 142 x 4
#> # Groups:   country, continent [142]
#>    country     continent data              sample_res       
#>    <fct>       <fct>     <list>            <list>           
#>  1 Afghanistan Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#>  2 Albania     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#>  3 Algeria     Africa    <tibble [12 × 4]> <tibble [12 × 4]>
#>  4 Angola      Africa    <tibble [12 × 4]> <tibble [12 × 4]>
#>  5 Argentina   Americas  <tibble [12 × 4]> <tibble [12 × 4]>
#>  6 Australia   Oceania   <tibble [12 × 4]> <tibble [12 × 4]>
#>  7 Austria     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#>  8 Bahrain     Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#>  9 Bangladesh  Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#> 10 Belgium     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#> # … with 132 more rows

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

当使用 map 和自定义函数在列表列中循环 tibbles 时，在循环之外构建第一个版本非常有帮助。

test_dat <- gapminder %>%
  nest_by(country, continent) 

test_dat$data[[1]] %>% 
  mutate(across(
    c(year, lifeExp, pop),
    ~ sample_function(test_dat$data[[1]], var_a = .x, var_b = gdpPercap)
    )
    )

一旦成功，最后一步是将要循环的对象替换为.x。

另一种方法（原始答案的一部分）

另一种方法是重写您原来的sample_function 并在您的mutate 调用中包含across。我们可以让它接受一个变量名的字符串向量，该向量将被传递给across。我可能更喜欢这种方法，因为它更灵活。现在，您可以拥有另一个列表列，其中包含不同数据子集的不同变量名称，并使用 map2 遍历它们和您的数据列。

library("tidyverse")
data("gapminder", package = "gapminder")

sample_function2 <- function(.data, .vars, var_b) {
  .vars <- syms(.vars)
  var_b <- enquo(var_b)

  .data %>%
    mutate(across(c(!!!.vars), function(y) log(y) + !!var_b))
}


gapminder %>%
  group_by(country, continent) %>%
  nest() %>% 
  mutate(sample_res = map(
    data,
    ~ sample_function2(.x,
                       .vars = c("year", "lifeExp", "pop"),
                       var_b = gdpPercap)
  )
  )

#> # A tibble: 142 x 4
#> # Groups:   country, continent [142]
#>    country     continent data              sample_res       
#>    <fct>       <fct>     <list>            <list>           
#>  1 Afghanistan Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#>  2 Albania     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#>  3 Algeria     Africa    <tibble [12 × 4]> <tibble [12 × 4]>
#>  4 Angola      Africa    <tibble [12 × 4]> <tibble [12 × 4]>
#>  5 Argentina   Americas  <tibble [12 × 4]> <tibble [12 × 4]>
#>  6 Australia   Oceania   <tibble [12 × 4]> <tibble [12 × 4]>
#>  7 Austria     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#>  8 Bahrain     Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#>  9 Bangladesh  Asia      <tibble [12 × 4]> <tibble [12 × 4]>
#> 10 Belgium     Europe    <tibble [12 × 4]> <tibble [12 × 4]>
#> # … with 132 more rows

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

添加（原始答案）

正如@Bruno 指出的那样，上述方法不是 OP 指定的格式，这是基于我上面的第二种方法的替代解决方案，它应该会产生所需的输出。

library("tidyverse")
data("gapminder", package = "gapminder")

sample_function2 <- function(.data, .vars, var_b) {
  .vars <- syms(.vars)
  var_b <- enquo(var_b)

  .data %>%
    transmute(across(c(!!!.vars), function(y) log(y) + !!var_b)) %>% 
    unlist()

}

my_vars <- c("year", "lifeExp", "pop")

gapminder %>%
  group_by(country, continent) %>%
  nest() %>% 
  crossing(vars = my_vars) %>% 
  mutate(sample_res = map2(
    data,
    vars, 
    ~ sample_function2(.x,
                       .vars = .y,
                       var_b = gdpPercap)
  )
  ) %>% 
  pivot_wider(names_from = vars,
              names_prefix = "res_",
              values_from = sample_res) 

#> # A tibble: 142 x 6
#>    country     continent data              res_lifeExp res_pop    res_year  
#>    <fct>       <fct>     <list>            <list>      <list>     <list>    
#>  1 Afghanistan Asia      <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  2 Albania     Europe    <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  3 Algeria     Africa    <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  4 Angola      Africa    <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  5 Argentina   Americas  <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  6 Australia   Oceania   <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  7 Austria     Europe    <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  8 Bahrain     Asia      <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#>  9 Bangladesh  Asia      <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#> 10 Belgium     Europe    <tibble [12 × 4]> <dbl [12]>  <dbl [12]> <dbl [12]>
#> # … with 132 more rows

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

【讨论】：

我不认为这是正确的答案，理想情况下会有 3 个额外的列，如示例答案
你是对的，我没有注意到所需的输出是三个不同的列。请看我修改后的答案。

【解决方案2】：

给你，不花哨，但可以完成工作

library("tidyverse")
data("gapminder", package = "gapminder")

# Sample function

sample_function <- function(.data,vars_a,var_b){
  var_b <- rlang::parse_expr(var_b)

  for (i in vars_a) {

    namer <- paste0("res_",i)
    var_a <- rlang::parse_expr(i)
    .data <- .data %>%
      mutate(!!namer := log(!!var_a) + !!var_b)
  }
  .data


}
sample_function(gapminder,c("year","lifeExp","pop"),"gdpPercap")


gapminder %>% 
  nest_by(country,continent) %>% 
  mutate(result = list(sample_function(data,c("year","lifeExp","pop"),"gdpPercap")))

这里是比较慢的整理方式

tidy_sample_function <- function(.data,vars_a,var_b){

  vars_a <- .data %>% 
    select({{vars_a}}) %>% 
    names()

  for (i in vars_a) {

    namer <- paste0("res_",i)
    var_a <- rlang::parse_expr(i)
    .data <- .data %>%
      mutate(!!namer := log(!!var_a) + {{var_b}})
  }
  .data


}

gapminder %>% 
  nest_by(country,continent) %>% 
  mutate(result = list(tidy_sample_function(data,c(year,lifeExp,pop),gdpPercap)))

【讨论】：