1

我的目标是编写一个take_by_rank函数

  • 可以对数据框中任意选择的数字列进行操作；
  • 使用非标准评估，如base::subset或dplyr动词；
  • 自然理解减号，所以这-foo意味着“最大的值得foo到最低的等级”；
  • n按总排名返回顶部或底部行，这是为每个选定变量计算的排名总和。

我对学习最新的dplyr 方法和寻找替代方法都很感兴趣，即对包选择没有限制（纯base或data.table可能？）。

我目前的解决方案是 

library(data.table)
library(dplyr)
library(rlang)

take_by_rank <- function(df, ..., n = 100) {
    selected_vars <- quos(...)
    if (!length(selected_vars))
        stop("No variables to rank!")
    prefix <- ".rank_"
    for (i in seq_along(selected_vars)) {
        rank_name <- paste0(prefix, quo_name(selected_vars[[i]]))
        df <- df %>%
            mutate(!!rank_name := frankv(!!selected_vars[[i]]))
    }
    df %>%
        mutate(TotalRank = rowSums(select(df, starts_with(prefix)))) %>%
        arrange(TotalRank) %>%
        top_n(n, -TotalRank)
}

这似乎没问题，但也许我错过了更直接的东西。如果有办法替换 for 循环，那也很好。

使用示例（供参考）

take_by_rank(mtcars, mpg, qsec, n = 3)
   mpg cyl disp  hp drat   wt  qsec vs am gear carb .rank_mpg .rank_qsec TotalRank
1 13.3   8  350 245 3.73 3.84 15.41  0  0    3    4         3          3         6
2 15.0   8  301 335 3.54 3.57 14.60  0  1    5    8         6          2         8
3 14.3   8  360 245 3.21 3.57 15.84  0  0    3    4         4          5         9

take_by_rank(mtcars, mpg, qsec, n = -3)
   mpg cyl  disp hp drat    wt  qsec vs am gear carb .rank_mpg .rank_qsec TotalRank
1 22.8   4 140.8 95 3.92 3.150 22.90  1  0    4    2      24.5         32      56.5
2 32.4   4  78.7 66 4.08 2.200 19.47  1  1    4    1      31.0         27      58.0
3 33.9   4  71.1 65 4.22 1.835 19.90  1  1    4    1      32.0         28      60.0

take_by_rank(mtcars, mpg, -qsec, n = 3)
   mpg cyl disp  hp drat    wt  qsec vs am gear carb .rank_mpg .rank_-qsec TotalRank
1 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1      14.0           2      16.0
2 10.4   8  472 205 2.93 5.250 17.98  0  0    3    4       1.5          15      16.5
3 10.4   8  460 215 3.00 5.424 17.82  0  0    3    4       1.5          16      17.5
4

3 回答 3

2

您可以在将点传递给vars()之前将它们传递给mutate_at()

mutate_at(df, vars(...), myfuns)

这相当于将点传递给tidyselect::vars_select()然后传递给mutate_at()：

vars <- tidyselect::vars_select(tbl_vars(df), ...)
mutate_at(df, vars, myfuns)
于 2017-07-27T10:57:18.843 回答
1

正如 Alex P 还建议您可以使用mutate_at()删除 for 循环一样，我们可以将函数重写为：

take_by_rank <- function(df, ..., n = 100) {
  selected_vars <- quos(...)
  if (!length(selected_vars))
    stop("No variables to rank!")
  df <- df %>% 
    mutate_at(selected_vars,  funs(rank = frankv)) %>%  
    mutate(TotalRank = rowSums(select(., ends_with("_rank")))) %>%
    arrange(TotalRank) %>%
    top_n(n, -TotalRank)
}

这将应用于frankv所有选定的变量并添加后缀为 _rank 的新列。我还更改了 select 语句以引用管道 data.frame。如果您想对 Totalrank 计算进行完整的变量名称匹配，这将起作用。

 take_by_rank_matching <- function(df, ..., n = 100) {
      selected_vars <- quos(...)
      if (!length(selected_vars))
        stop("No variables to rank!")
      df <- df %>% 
        mutate_at(selected_vars,  funs(rank = frankv)) %>%  
        mutate(TotalRank = rowSums(
          select_at(., unlist(lapply(selected_vars,
                                     function(x)
                                       paste0(quo_label(x), "_rank")))))) %>%
        arrange(TotalRank) %>%
        top_n(n, -TotalRank)
    }

虽然我认为可能有更清洁的方法。

于 2017-07-26T21:46:49.193 回答
0

正如您所指出的，使用mutate_atmake it 不可能（或非常难以）处理该-foo行为。

我向你推荐这个解决方案。这与你所做的并没有太大的不同。
我更改了for-loopwith purrr::map，并简化了total_rank.

library(tidyverse)
# ....
library(rlang)
# ....

take_by_rank <- function(df, ..., n = 100) {
    # original quosures
    selected_vars <- quos(...)

    if (!length(selected_vars))
        stop("No variables to rank!")

    suffixed_vars <- map(selected_vars, ~ {
        paste0(quo_name(.x), '_rank') %>%
            as.name() %>%
            as_quosure()
    })

    selected_vars %>%
        map( ~ {
            rank_name <- paste0(quo_name(.x), '_rank')
            df %>%                   # or whatever rank function you want
                mutate(!!rank_name := dense_rank(!!.x))
        }) %>%
        reduce(full_join) %>%
        mutate(total_rank = '+'(!!!suffixed_vars)) %>% # !!! = unquote and splice
        top_n(n, -total_rank)

}

take_by_rank(mtcars, mpg, qsec, n = 3)
#> Joining, by = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
#>    mpg cyl disp  hp drat   wt  qsec vs am gear carb mpg_rank qsec_rank
#> 1 14.3   8  360 245 3.21 3.57 15.84  0  0    3    4        3         5
#> 2 13.3   8  350 245 3.73 3.84 15.41  0  0    3    4        2         3
#> 3 15.0   8  301 335 3.54 3.57 14.60  0  1    5    8        5         2
#>   total_rank
#> 1          8
#> 2          5
#> 3          7

take_by_rank(mtcars, mpg, qsec, n = -3)
#> Joining, by = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
#>    mpg cyl  disp hp drat    wt  qsec vs am gear carb mpg_rank qsec_rank
#> 1 22.8   4 140.8 95 3.92 3.150 22.90  1  0    4    2       19        30
#> 2 32.4   4  78.7 66 4.08 2.200 19.47  1  1    4    1       24        25
#> 3 33.9   4  71.1 65 4.22 1.835 19.90  1  1    4    1       25        26
#>   total_rank
#> 1         49
#> 2         49
#> 3         51

take_by_rank(mtcars, mpg, -qsec, n = 3)
#> Joining, by = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
#>    mpg cyl disp  hp drat    wt  qsec vs am gear carb mpg_rank -qsec_rank
#> 1 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1       12          2
#> 2 10.4   8  472 205 2.93 5.250 17.98  0  0    3    4        1         14
#> 3 10.4   8  460 215 3.00 5.424 17.82  0  0    3    4        1         15
#>   total_rank
#> 1         14
#> 2         15
#> 3         16

take_by_rank(mtcars, mpg,  n = 3)
#>    mpg cyl disp  hp drat    wt  qsec vs am gear carb mpg_rank total_rank
#> 1 10.4   8  472 205 2.93 5.250 17.98  0  0    3    4        1          1
#> 2 10.4   8  460 215 3.00 5.424 17.82  0  0    3    4        1          1
#> 3 13.3   8  350 245 3.73 3.840 15.41  0  0    3    4        2          2
于 2017-07-28T08:05:12.463 回答