Блог

Я написал функцию, которая принимает символ в качестве входных данных, а затем преобразуется в quosure, а enquo() затем оценивается !! оператором в функциях tidyverse. Упрощенная версия функции выглядит следующим образом (полная функция возвращает фрейм данных и делает больше вместо простого вычисления числа, но только для иллюстрации этого должно быть достаточно).:

 query <- function(test){
  #colnames are different tests, obtain quosure of the test name
  test = enquo(test)
   avg_test_score = scores %>% 
    group_by(student) %>% summarise(mean.score = mean(!!test))
}
 

Функция отлично работает, если я query(english.test) , например, это сделаю. Однако теперь я хочу поместить его в цикл for для всех различных столбцов, получить их имена и запустить его через функцию, а затем сохранить выходные данные в списке

 output_list = list()
for (i in length(test.name)){
  this.test = test.name[i] #test.name is a vector of strings
  output_list[[i]] = query(test = this.test)
}
 

Но я получаю эту ошибку:

 In mean.default(~this.test) :
  argument is not numeric or logical: returning NA
 

Поэтому я вроде как понял, что мне нужно преобразовать символьную строку в символ, прежде чем вводить ее в функцию, но я пробовал разные способы преобразования, например, test.name[i] %>% as.symbol() или test.name[i] %>% rlang::sym() все же они все еще не совсем работают. Есть ли какой-либо способ правильно обработать эти преобразования, чтобы цикл for мог запускать мою функцию? Спасибо!

Вот воспроизводимый подход для вычисления среднего значения нескольких столбцов в фрейме данных/tibble:

 library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, as_function, flatten, flatten_chr, flatten_dbl, flatten_int,
#>     flatten_lgl, flatten_raw, invoke, list_along, modify, prepend,
#>     splice

nms <- c('cyl', 'hwy', 'cty')

nms %>%
map(~ mpg %>% 
                group_by(manufacturer) %>% 
                summarise('mean_{.x}' := mean(eval_tidy(sym(.x)))) )
#> [[1]]
#> # A tibble: 15 x 2
#>    manufacturer mean_cyl
#>    <chr>           <dbl>
#>  1 audi             5.22
#>  2 chevrolet        7.26
#>  3 dodge            7.08
#>  4 ford             7.2 
#>  5 honda            4   
#>  6 hyundai          4.86
#>  7 jeep             7.25
#>  8 land rover       8   
#>  9 lincoln          8   
#> 10 mercury          7   
#> 11 nissan           5.54
#> 12 pontiac          6.4 
#> 13 subaru           4   
#> 14 toyota           5.12
#> 15 volkswagen       4.59
#> 
#> [[2]]
#> # A tibble: 15 x 2
#>    manufacturer mean_hwy
#>    <chr>           <dbl>
#>  1 audi             26.4
#>  2 chevrolet        21.9
#>  3 dodge            17.9
#>  4 ford             19.4
#>  5 honda            32.6
#>  6 hyundai          26.9
#>  7 jeep             17.6
#>  8 land rover       16.5
#>  9 lincoln          17  
#> 10 mercury          18  
#> 11 nissan           24.6
#> 12 pontiac          26.4
#> 13 subaru           25.6
#> 14 toyota           24.9
#> 15 volkswagen       29.2
#> 
#> [[3]]
#> # A tibble: 15 x 2
#>    manufacturer mean_cty
#>    <chr>           <dbl>
#>  1 audi             17.6
#>  2 chevrolet        15  
#>  3 dodge            13.1
#>  4 ford             14  
#>  5 honda            24.4
#>  6 hyundai          18.6
#>  7 jeep             13.5
#>  8 land rover       11.5
#>  9 lincoln          11.3
#> 10 mercury          13.2
#> 11 nissan           18.1
#> 12 pontiac          17  
#> 13 subaru           19.3
#> 14 toyota           18.5
#> 15 volkswagen       20.9


# or 
nms %>%
    map_dfc(~ mpg %>% 
            group_by(manufacturer) %>% 
            summarise('mean_{.x}' := mean(eval_tidy(sym(.x)))) %>% 
            `[`(, 2) ) %>% #avoid duplicated manufacturer columns
    mutate(group_by(mpg, manufacturer) %>% summarise())
#> # A tibble: 15 x 4
#>    mean_cyl mean_hwy mean_cty manufacturer
#>       <dbl>    <dbl>    <dbl> <chr>       
#>  1     5.22     26.4     17.6 audi        
#>  2     7.26     21.9     15   chevrolet   
#>  3     7.08     17.9     13.1 dodge       
#>  4     7.2      19.4     14   ford        
#>  5     4        32.6     24.4 honda       
#>  6     4.86     26.9     18.6 hyundai     
#>  7     7.25     17.6     13.5 jeep        
#>  8     8        16.5     11.5 land rover  
#>  9     8        17       11.3 lincoln     
#> 10     7        18       13.2 mercury     
#> 11     5.54     24.6     18.1 nissan      
#> 12     6.4      26.4     17   pontiac     
#> 13     4        25.6     19.3 subaru      
#> 14     5.12     24.9     18.5 toyota      
#> 15     4.59     29.2     20.9 volkswagen
 

^{Создано 2021-06-13 пакетом reprex (v2.0.0)}

Вы можете изменить функцию на прием строк.

 library(dplyr)

query <- function(test){
  avg_test_score = scores %>% 
    group_by(student) %>% summarise(mean.score = mean(.data[[test]]))
}
 

Для одной колонки это будет работать query("english.test") .

Для нескольких столбцов вы можете использовать lapply / map —

 multiple_cols <- c('english.test', 'french.test')
purrr::map(multiple_cols, query)