Как построить функцию ранга, которая ранжирует по возрастанию или убыванию на основе определенных имен столбцов?

Question

Я собираюсь построить функцию, которая ранжирует переменные в порядке возрастания или убывания, основываясь на имени переменной, определенной в функции.

Я могу выполнить ранжирование вручную, но я хочу иметь возможность вызвать функцию, чтобы упростить код для моего df.Ищу кого-то, чтобы показать мне, как сделать функцию на широкую и длинную df.Мой пример кода ниже.Я смотрю на tov, и минуты ранжируются по возрастанию, а остальные столбцы ранжируются по убыванию.Было бы замечательно, если бы кто-то мог показать мне, как выполнить функцию, чтобы я определял имена переменных как для возрастающих, так и для убывающих ранжированных переменных, и еще один вариант, где я определяю только переменные, которые будут ранжироваться по убыванию, со всеми остальными столбцами по умолчанию:восходящие ряды.

library(tidyverse)

df <- tibble::tribble(
                ~Name, ~Team, ~minutes, ~ftm, ~fta, ~oreb, ~dreb, ~treb, ~ast, ~stl, ~blk, ~tov, ~pts, ~eff,
  "Russell Westbrook", "OKC",     34.6,  8.8, 10.4,   1.7,     9,  10.7, 10.4,  1.6,  0.4,  5.4, 31.6, 33.8,
       "James Harden", "HOU",     36.4,  9.2, 10.9,   1.2,     7,   8.1, 11.2,  1.5,  0.5,  5.7, 29.1, 32.4,
      "Isaiah Thomas", "BOS",     33.8,  7.8,  8.5,   0.6,   2.1,   2.7,  5.9,  0.9,  0.2,  2.8, 28.9, 24.7,
      "Anthony Davis", "NOP",     36.1,  6.9,  8.6,   2.3,   9.5,  11.8,  2.1,  1.3,  2.2,  2.4,   28, 31.1,
      "DeMar DeRozan", "TOR",     35.4,  7.4,  8.7,   0.9,   4.3,   5.2,  3.9,  1.1,  0.2,  2.4, 27.3, 22.7,
     "Damian Lillard", "POR",     35.9,  6.5,  7.3,   0.6,   4.3,   4.9,  5.9,  0.9,  0.3,  2.6,   27, 24.5,
   "DeMarcus Cousins", "NOP",     34.2,  7.2,  9.3,   2.1,   8.9,    11,  4.6,  1.4,  1.3,  3.7,   27, 28.5,
       "LeBron James", "CLE",     37.8,  4.8,  7.2,   1.3,   7.3,   8.6,  8.7,  1.2,  0.6,  4.1, 26.4,   31,
      "Kawhi Leonard", "SAS",     33.4,  6.3,  7.2,   1.1,   4.7,   5.8,  3.5,  1.8,  0.7,  2.1, 25.5, 25.3,
      "Stephen Curry", "GSW",     33.4,  4.1,  4.6,   0.8,   3.7,   4.5,  6.6,  1.8,  0.2,    3, 25.3, 25.2
  )

df_wide <- df %>% 
  mutate_at(vars(ftm, ast), funs(rank = rank(desc(.)))) %>%
  mutate_at(vars(tov, minutes), funs(rank = rank((.))))

df_wide
#> # A tibble: 10 x 18
#>    Name  Team  minutes   ftm   fta  oreb  dreb  treb   ast   stl   blk
#>    <chr> <chr>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#>  1 Russ~ OKC      34.6   8.8  10.4   1.7   9    10.7  10.4   1.6   0.4
#>  2 Jame~ HOU      36.4   9.2  10.9   1.2   7     8.1  11.2   1.5   0.5
#>  3 Isai~ BOS      33.8   7.8   8.5   0.6   2.1   2.7   5.9   0.9   0.2
#>  4 Anth~ NOP      36.1   6.9   8.6   2.3   9.5  11.8   2.1   1.3   2.2
#>  5 DeMa~ TOR      35.4   7.4   8.7   0.9   4.3   5.2   3.9   1.1   0.2
#>  6 Dami~ POR      35.9   6.5   7.3   0.6   4.3   4.9   5.9   0.9   0.3
#>  7 DeMa~ NOP      34.2   7.2   9.3   2.1   8.9  11     4.6   1.4   1.3
#>  8 LeBr~ CLE      37.8   4.8   7.2   1.3   7.3   8.6   8.7   1.2   0.6
#>  9 Kawh~ SAS      33.4   6.3   7.2   1.1   4.7   5.8   3.5   1.8   0.7
#> 10 Step~ GSW      33.4   4.1   4.6   0.8   3.7   4.5   6.6   1.8   0.2
#> # ... with 7 more variables: tov <dbl>, pts <dbl>, eff <dbl>,
#> #   ftm_rank <dbl>, ast_rank <dbl>, tov_rank <dbl>, minutes_rank <dbl>

df_long <- df %>%
  gather(key = data_col, value = "stat_value", 3:14) %>% 
  group_by(data_col) %>% 
  mutate(rank = if_else(data_col %in% c("tov", "minutes"), rank(stat_value, ties.method = "first"), rank(-stat_value, ties.method = "first")))

df_long
#> # A tibble: 120 x 5
#> # Groups:   data_col [12]
#>    Name              Team  data_col stat_value  rank
#>    <chr>             <chr> <chr>         <dbl> <int>
#>  1 Russell Westbrook OKC   minutes        34.6     5
#>  2 James Harden      HOU   minutes        36.4     9
#>  3 Isaiah Thomas     BOS   minutes        33.8     3
#>  4 Anthony Davis     NOP   minutes        36.1     8
#>  5 DeMar DeRozan     TOR   minutes        35.4     6
#>  6 Damian Lillard    POR   minutes        35.9     7
#>  7 DeMarcus Cousins  NOP   minutes        34.2     4
#>  8 LeBron James      CLE   minutes        37.8    10
#>  9 Kawhi Leonard     SAS   minutes        33.4     1
#> 10 Stephen Curry     GSW   minutes        33.4     2
#> # ... with 110 more rows

Мой желаемый результат будет таким же, как df, перечисленный выше.Я ищу, чтобы создать функцию, которая очищает руководство if_else, и 2 строки кода выше.Допустим, функция называлась stat_rank.Я хотел бы, чтобы код работал что-то вроде:

df_wide <- df %>% 
  mutate_at(vars(ftm, ast, tov, minutes), funs(rank = stat_rank(.)))) 


df_long <- df %>%
  gather(key = data_col, value = "stat_value", 3:14) %>% 
  group_by(data_col) %>% 
  mutate(rank = stat_rank(stat_value))

Answer 1

Если нам нужна одна функция, то

stat_rank <- function(x) {
     col1 <- deparse(substitute(x))
     if(col1 %in% c('ftm', 'ast')) {
     rank(desc(x)) 
     } else rank(x)

}

df %>% 
   mutate_at(vars(ftm, ast, tov, minutes), funs(rank = stat_rank))
# A tibble: 10 x 18
#   Name         Team  minutes   ftm   fta  oreb  dreb  treb   ast   stl   blk   tov   pts   eff ftm_rank ast_rank tov_rank minutes_rank
#   <chr>        <chr>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl>    <dbl>        <dbl>
# 1 Russell Wes… OKC      34.6   8.8  10.4   1.7   9    10.7  10.4   1.6   0.4   5.4  31.6  33.8        2      2        9            5  
# 2 James Harden HOU      36.4   9.2  10.9   1.2   7     8.1  11.2   1.5   0.5   5.7  29.1  32.4        1      1       10            9  
# 3 Isaiah Thom… BOS      33.8   7.8   8.5   0.6   2.1   2.7   5.9   0.9   0.2   2.8  28.9  24.7        3      5.5      5            3  
# 4 Anthony Dav… NOP      36.1   6.9   8.6   2.3   9.5  11.8   2.1   1.3   2.2   2.4  28    31.1        6     10        2.5          8  
# 5 DeMar DeRoz… TOR      35.4   7.4   8.7   0.9   4.3   5.2   3.9   1.1   0.2   2.4  27.3  22.7        4      8        2.5          6  
# 6 Damian Lill… POR      35.9   6.5   7.3   0.6   4.3   4.9   5.9   0.9   0.3   2.6  27    24.5        7      5.5      4            7  
# 7 DeMarcus Co… NOP      34.2   7.2   9.3   2.1   8.9  11     4.6   1.4   1.3   3.7  27    28.5        5      7        7            4  
# 8 LeBron James CLE      37.8   4.8   7.2   1.3   7.3   8.6   8.7   1.2   0.6   4.1  26.4  31          9      3        8           10  
# 9 Kawhi Leona… SAS      33.4   6.3   7.2   1.1   4.7   5.8   3.5   1.8   0.7   2.1  25.5  25.3        8      9        1            1.5
#10 Stephen Cur… GSW      33.4   4.1   4.6   0.8   3.7   4.5   6.6   1.8   0.2   3    25.3  25.2       10      4        6            1.5

---

Обратите внимание, что в вышеприведенной реализации имена столбцов жестко закодированы внутри функции.Если нужно быть более гибким, то можно передать имена столбцов в качестве другого аргумента

stat_rank <- function(x, descCols) {
     col1 <- deparse(substitute(x))
     if(col1 %in% descCols) {
     rank(desc(x)) 
     } else rank(x)

}

df %>% 
   mutate_at(vars(ftm, ast, tov, minutes), 
           funs(rank = stat_rank(., descCols = c('ftm', 'ast'))))

Для данных длинного формата функция может быть

stat_rankL = function(x, y, descCols) {
     ifelse(x %in% descCols, rank(desc(y)), rank(y))

}  
df %>%
   gather(key = data_col, value = "stat_value", 3:14) %>% 
   group_by(data_col) %>% 
   mutate(rank = stat_rankL(data_col, stat_value, c('ftm', 'ast')))