R dplyr如何通过列号而不是通过汇总的列名选择变量

Question

我正在使用 dplyr 和 Hmisc 按照下面的 R 代码按组准备加权统计数据表。

require(Hmisc)  # weighted statistcs

StTbl <- iris %>%
  group_by(Species) %>%                                                    # Group species
  summarise(n = n(),                                                       # number of records                  
            WtMn = wtd.mean(Sepal.Length, Petal.Width),                    # weighted mean
            WtSd = sqrt(wtd.var(Sepal.Length, Petal.Width)),               # weighted SD
            WtCV = WtMn/WtSd,                                              # weighted CV
            Minm = min(Sepal.Length),                                      # minumum
            Wp05 = wtd.quantile(Sepal.Length, Petal.Width , 0.05),         # p05
            Wp50 = wtd.quantile(Sepal.Length, Petal.Width , 0.50),         # p50
            Wp95 = wtd.quantile(Sepal.Length, Petal.Width , 0.95),         # p95 
            Wp975 = wtd.quantile(Sepal.Length, Petal.Width , 0.975),       # p975
            Wp99 = wtd.quantile(Sepal.Length, Petal.Width , 0.99),         # p99
            Maxm = max(Sepal.Length)                                       # maximum
  )

StTbl

A tibble: 3 x 12
  Species        n  WtMn  WtSd  WtCV  Minm  Wp05  Wp50  Wp95 Wp975  Wp99  Maxm
  <fct>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 setosa        50  5.05 0.356  14.2   4.3  4.61  5.06  5.62  5.70  5.72   5.8
2 versicolor    50  5.98 0.508  11.8   4.9  5.13  6     6.80  6.97  7      7  
3 virginica     50  6.61 0.626  10.6   4.9  5.8   6.5   7.7   7.7   7.9    7.9

现在，我希望使用列索引，而不是使用表的列名，这样我就可以循环遍历许多列，为每列准备统计表。我发现有很多关于如何在 StackOverflow 上执行此操作的建议，包括：

1. double square 或使用表名和索引号的单括号，例如在上面的代码中用“.[1]”或“iris1”代替“Sepal.Length”——这些建议运行没有错误，但返回 NA 结果
2. 使用 get 函数，例如“get(iris1)” - 此建议返回无效的第一个参数错误
3. dplyr does not really support column index 和列索引的建议是一个坏主意，我应该以另一种方式解决问题 - 我不确定这会是另一种“tidyverse”方式吗？
4. 写一个custom function - 我不知道从哪里开始我的例子

Answer 1

利用rlang 中的.data 代词，您可以编写一个自定义函数，该函数接受一个数据框、两个变量的名称和一些额外的分组变量，并计算您想要的汇总表，如下所示：

library(dplyr)
library(Hmisc)

summary_table <- function(.data, x, y, ...) {
  .data %>%
    group_by(...) %>%                                                    # Group species
    summarise(n = n(),                                                       # number of records                  
              WtMn = wtd.mean(.data[[x]], .data[[y]]),                    # weighted mean
              WtSd = sqrt(wtd.var(.data[[x]], .data[[y]])),               # weighted SD
              WtCV = WtMn/WtSd,                                              # weighted CV
              Minm = min(.data[[x]]),                                      # minumum
              Wp05 = wtd.quantile(.data[[x]], .data[[y]] , 0.05),         # p05
              Wp50 = wtd.quantile(.data[[x]], .data[[y]] , 0.50),         # p50
              Wp95 = wtd.quantile(.data[[x]], .data[[y]] , 0.95),         # p95 
              Wp975 = wtd.quantile(.data[[x]], .data[[y]] , 0.975),       # p975
              Wp99 = wtd.quantile(.data[[x]], .data[[y]] , 0.99),         # p99
              Maxm = max(.data[[x]])                                       # maximum
    )  
}

summary_table(iris, "Sepal.Length", "Petal.Width", Species)
#> # A tibble: 3 x 12
#>   Species        n  WtMn  WtSd  WtCV  Minm  Wp05  Wp50  Wp95 Wp975  Wp99  Maxm
#>   <fct>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 setosa        50  5.05 0.356  14.2   4.3  4.61  5.06  5.62  5.70  5.72   5.8
#> 2 versicolor    50  5.98 0.508  11.8   4.9  5.13  6     6.80  6.97  7      7  
#> 3 virginica     50  6.61 0.626  10.6   4.9  5.8   6.5   7.7   7.7   7.9    7.9

summary_table(iris, "Sepal.Width", "Petal.Width", Species)
#> # A tibble: 3 x 12
#>   Species        n  WtMn  WtSd  WtCV  Minm  Wp05  Wp50  Wp95 Wp975  Wp99  Maxm
#>   <fct>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 setosa        50  3.47 0.399  8.69   2.3  3.06  3.46  4.27  4.4    4.4   4.4
#> 2 versicolor    50  2.80 0.310  9.04   2    2.3   2.86  3.20  3.37   3.4   3.4
#> 3 virginica     50  3.00 0.320  9.38   2.2  2.5   3     3.6   3.8    3.8   3.8

Answer 2

要在dplyr 中使用列号而不是列名，您可以将cur_data() 中的数据子集化。

library(dplyr)

iris %>%
  group_by(Species) %>%                                                    
  summarise(n = n(),                                                       
            WtMn = wtd.mean(cur_data()[[1]], cur_data()[[4]]),             
            WtSd = sqrt(wtd.var(cur_data()[[1]], cur_data()[[4]])),        
            WtCV = WtMn/WtSd,                                              
            Minm = min(cur_data()[[1]]),                                   
            Wp05 = wtd.quantile(cur_data()[[1]], cur_data()[[4]] , 0.05),  
            Wp50 = wtd.quantile(cur_data()[[1]], cur_data()[[4]] , 0.50),  
            Wp95 = wtd.quantile(cur_data()[[1]], cur_data()[[4]] , 0.95),  
            Wp975 = wtd.quantile(cur_data()[[1]], cur_data()[[4]] , 0.975),
            Wp99 = wtd.quantile(cur_data()[[1]], cur_data()[[4]] , 0.99),  
            Maxm = max(cur_data()[[1]])                                    
  )

#  Species        n  WtMn  WtSd  WtCV  Minm  Wp05  Wp50  Wp95 Wp975  Wp99  Maxm
#  <fct>      <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 setosa        50  5.05 0.356  14.2   4.3  4.61  5.06  5.62  5.70  5.72   5.8
#2 versicolor    50  5.98 0.508  11.8   4.9  5.13  6     6.80  6.97  7      7  
#3 virginica     50  6.61 0.626  10.6   4.9  5.8   6.5   7.7   7.7   7.9    7.9

Answer 3

结合了 Ronak Shah 和 stefan 的出色解决方案，我认为自定义函数可以避免重复输入...

summaryfun <- function (x,y){
  c(
  length(x),
  wtd.mean(x,y),
  sqrt(wtd.var(x, y)),
  (wtd.mean(x,y)/  sqrt(wtd.var(x, y))),
  min(x),
  map_dbl(c(0.05, 0.50, 0.95, 0.975, 0.99), ~wtd.quantile(x,y,.x)),
  max(x))  %>%
    set_names(
      c('n', 'WtMn', 'WtSd', 'WtCV', 'Minm', 'Wp05', 'Wp50', 'Wp95', 'Wp975', 'Wp99', 'Maxm')) %>% 
  return
  }

iris %>% 
  group_by(Species) %>% 
  #summarise(index_by_name = list(summaryfun(x=Sepal.Length, y=Petal.Width))) %>% 
  summarise(index_by_position = list(summaryfun(x=cur_data()[[1]], y=cur_data()[[4]]))) %>%
  unnest_wider(index_by_position)

# A tibble: 3 x 12
  Species     n  WtMn  WtSd  WtCV  Minm  Wp05  Wp50  Wp95 Wp975  Wp99  Maxm
  <fct>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 setosa     50  5.05 0.356  14.2   4.3  4.61  5.06  5.62  5.70  5.72   5.8
2 versic~    50  5.98 0.508  11.8   4.9  5.13  6     6.80  6.97  7      7  
3 virgin~    50  6.61 0.626  10.6   4.9  5.8   6.5   7.7   7.7   7.9    7.9