使用 purrr 映射到 2 个函数答案

【问题标题】：Use purrr to map to 2 functions使用 purrr 映射到 2 个函数
【发布时间】：2018-04-12 17:55:37
【问题描述】：

我有以下形式的数据

   date                  data              
   <chr>                <list>            
 1 2012-01-05           <tibble [796 x 5]>
 2 2012-01-12           <tibble [831 x 5]>
 3 2012-01-19           <tibble [820 x 5]>
 ...                       ...

我想使用类似于map() 的方法来计算平均值和标准差。

我目前可以单独使用以下，但可以同时计算两者。

mutate(stats = map(data, ~ sd(.$metric)))
mutate(stats = map(data, ~ mean(.$metric)))

另一种选择是创建一个类似于summary 的函数，它返回四分位数和平均值。但计算 mean 和 sd 代替。那么我可以在map 中使用该新功能，如下所示：

mutate(stats = map(data, ~ new_function(.$metric)))

有没有更好的选择？

【问题讨论】：

标签： r dplyr tidyverse purrr

【解决方案1】：

添加多个列的一个简单选项是创建另一个列表列，其中包含所需的汇总统计信息和unnest它：

library(tidyverse)
set.seed(47)

df <- data_frame(date = seq(as.Date('1970-01-01'), by = 1, length = 4), 
                 data = map(date, ~data_frame(metric = rnorm(10))))

df
#> # A tibble: 4 x 2
#>   date       data             
#>   <date>     <list>           
#> 1 1970-01-01 <tibble [10 × 1]>
#> 2 1970-01-02 <tibble [10 × 1]>
#> 3 1970-01-03 <tibble [10 × 1]>
#> 4 1970-01-04 <tibble [10 × 1]>

df %>% 
    mutate(stats = map(data, ~data.frame(mean = mean(.x$metric), 
                                         sd = sd(.x$metric)))) %>% 
    unnest(stats)
#> # A tibble: 4 x 4
#>   date       data                mean    sd
#>   <date>     <list>             <dbl> <dbl>
#> 1 1970-01-01 <tibble [10 × 1]> -0.106 0.992
#> 2 1970-01-02 <tibble [10 × 1]> -0.102 0.875
#> 3 1970-01-03 <tibble [10 × 1]> -0.833 0.979
#> 4 1970-01-04 <tibble [10 × 1]>  0.184 0.671

一种更加程序化的方法（可以更好地扩展）是在匿名函数中迭代函数列表。 lst 会自动给它们命名，所以结果会被命名，map_dfc 会将它们 cbind 成一个数据框：

df %>% 
    mutate(stats = map(data, 
                       ~map_dfc(lst(mean, sd), 
                                function(.fun) .fun(.x$metric)))) %>% 
    unnest(stats)

purrr 有一个专门构建的函数，用于迭代函数/参数，如下所示：invoke_map。如果您希望函数或参数被回收，它们必须在长度为 1 的列表中。由于参数应该已经收集在一个列表中，这里它必须是一个嵌套列表。

df %>% 
    mutate(stats = map(data, 
                       ~invoke_map_dfc(lst(mean, sd), 
                                       list(list(.x$metric))))) %>% 
    unnest(stats)

所有方法都返回相同的东西。

【讨论】：