首页 文章

purrr映射不产生整洁的数据

提问于
浏览
2

感谢这个网站,我正在使用R purrr 包来聚合基于多列的数据 . 聚合是我想要的,但输出不是 . 以下是使用 mtcars 数据集的示例 .

library(dplyr)
library(purrr)
#pull in data
data <- mtcars
#get colnames
variable1 <- colnames(data)
#map the variables
t1 <- map(variable1, ~ data %>%
         group_by_at(.x) %>%
         summarize(number = mean(mpg))) %>%
    set_names(variable1) %>%
    bind_rows(., .id = 'variable')

如果我期望三列(预测变量,每个变量中的级别,聚合),我有8.见下图:

Output of above code

如何在顶部获取代码并生成整洁的数据集?

2 回答

  • 3

    一种简单的方法是将数据重新整形为长格式,这样您就可以使用普通的dplyr进行聚合:

    library(tidyverse)
    
    mpg_means <- mtcars %>% 
        gather(variable, value, -mpg) %>% 
        group_by(variable, value) %>% 
        summarise(mean_mpg = mean(mpg))
    
    mpg_means
    #> # A tibble: 146 x 3
    #> # Groups:   variable [?]
    #>    variable value mean_mpg
    #>    <chr>    <dbl>    <dbl>
    #>  1 am          0.     17.1
    #>  2 am          1.     24.4
    #>  3 carb        1.     25.3
    #>  4 carb        2.     22.4
    #>  5 carb        3.     16.3
    #>  6 carb        4.     15.8
    #>  7 carb        6.     19.7
    #>  8 carb        8.     15.0
    #>  9 cyl         4.     26.7
    #> 10 cyl         6.     19.7
    #> # ... with 136 more rows
    

    请注意,虽然 mtcars 完全是数字,但如果您有不同的类型,转换为长格式将强制变量类型 . 计算结果相同,但可能会导致问题 . 要解决此问题,请使用可处理不同类型的输出格式,例如

    mpg_means_in_list_cols <- mtcars %>% 
        as_tibble() %>%    # compact printing for list columns
        summarise_all(list) %>%    # collapse each column into a list of itself
        gather(group, group_values, -mpg) %>% 
        mutate(mpg_means = map2(mpg, group_values,    # for each mpg/value pair, ...
                                ~tibble(mpg = .x, group_value = .y) %>%    # ...reconstruct a data frame...
                                    group_by(group_value) %>% 
                                    summarise(mean_mpg = mean(mpg))))    # ...and aggregate
    
    mpg_means_in_list_cols
    #> # A tibble: 10 x 4
    #>    mpg        group group_values mpg_means        
    #>    <list>     <chr> <list>       <list>           
    #>  1 <dbl [32]> cyl   <dbl [32]>   <tibble [3 × 2]> 
    #>  2 <dbl [32]> disp  <dbl [32]>   <tibble [27 × 2]>
    #>  3 <dbl [32]> hp    <dbl [32]>   <tibble [22 × 2]>
    #>  4 <dbl [32]> drat  <dbl [32]>   <tibble [22 × 2]>
    #>  5 <dbl [32]> wt    <dbl [32]>   <tibble [29 × 2]>
    #>  6 <dbl [32]> qsec  <dbl [32]>   <tibble [30 × 2]>
    #>  7 <dbl [32]> vs    <dbl [32]>   <tibble [2 × 2]> 
    #>  8 <dbl [32]> am    <dbl [32]>   <tibble [2 × 2]> 
    #>  9 <dbl [32]> gear  <dbl [32]>   <tibble [3 × 2]> 
    #> 10 <dbl [32]> carb  <dbl [32]>   <tibble [6 × 2]>
    

    虽然这显然不是那么漂亮,但它能够整齐地保持多种类型 . 要提取上面的结果,只需添加 %>% unnest(mpg_means) . 按原样,分组变量分别保存在 group_values 的列表元素中,并在每个 mpg_means tibble的第一列中以聚合形式保存 .

  • 2

    map 中对数据进行分组时,可以将分组变量重命名为 "level" ,因为这些值将形成包含最终数据集中分组变量级别的列 .

    当您有混合类型的分组变量(例如数字和字符)时,您还需要将分组变量强制转换为字符,以便能够将结果绑定在一起 .

    有了这些补充,你应该得到你期望的 . (您也可以使用 map_df 而不是 map 来跳过 bind_rows ,以保存一些代码,就像我在下面所做的那样 . )

    reprex::reprex_info()
    #> Created by the reprex package v0.1.1.9000 on 2018-02-09
    
    library(purrr)
    library(dplyr)
    
    data <- iris
    vars <- names(data)
    
    set_names(vars) %>% 
      map_df(function(var) {
        var <- set_names(var, "level")
        data %>% 
          group_by_at(var) %>% 
          summarize_at("Sepal.Length", "mean") %>% 
          mutate_at("level", as.character)
      }, .id = "variable")
    #> # A tibble: 126 x 3
    #>        variable level Sepal.Length
    #>           <chr> <chr>        <dbl>
    #>  1 Sepal.Length   4.3          4.3
    #>  2 Sepal.Length   4.4          4.4
    #>  3 Sepal.Length   4.5          4.5
    #>  4 Sepal.Length   4.6          4.6
    #>  5 Sepal.Length   4.7          4.7
    #>  6 Sepal.Length   4.8          4.8
    #>  7 Sepal.Length   4.9          4.9
    #>  8 Sepal.Length     5          5.0
    #>  9 Sepal.Length   5.1          5.1
    #> 10 Sepal.Length   5.2          5.2
    #> # ... with 116 more rows
    

    您还可以将该过程包装在一个函数中,并允许多个变量汇总多个函数 . 你不得不花一点时间想出一个令人回味的名字(我被骗了,只是在这里使用 foo ) .

    foo <- function(data, vars, funs) {
      grps <- names(data)
      set_names(grps) %>% 
        map_df(function(grp) {
          grp <- set_names(grp, "level")
          data %>% 
            group_by_at(grp) %>% 
            summarize_at(vars, funs) %>% 
            mutate_at("level", as.character)
        }, .id = "variable")
    }
    
    foo(iris, vars(Sepal.Length, Sepal.Width), funs(mean, sd))
    #> # A tibble: 126 x 6
    #>        variable level Sepal.Length_mean Sepal.Width_mean Sepal.Length_sd
    #>           <chr> <chr>             <dbl>            <dbl>           <dbl>
    #>  1 Sepal.Length   4.3               4.3         3.000000             NaN
    #>  2 Sepal.Length   4.4               4.4         3.033333               0
    #>  3 Sepal.Length   4.5               4.5         2.300000             NaN
    #>  4 Sepal.Length   4.6               4.6         3.325000               0
    #>  5 Sepal.Length   4.7               4.7         3.200000               0
    #>  6 Sepal.Length   4.8               4.8         3.180000               0
    #>  7 Sepal.Length   4.9               4.9         2.950000               0
    #>  8 Sepal.Length     5               5.0         3.120000               0
    #>  9 Sepal.Length   5.1               5.1         3.477778               0
    #> 10 Sepal.Length   5.2               5.2         3.425000               0
    #> # ... with 116 more rows, and 1 more variables: Sepal.Width_sd <dbl>
    

相关问题