Как я могу использовать purrr :: invoke_map () для функции, которая использует enquo ()? - PullRequest
Новая
       42

Как я могу использовать purrr :: invoke_map () для функции, которая использует enquo ()?

0 голосов
/ 08 июня 2018

Извините, я знаю, что заголовок не самый лучший.

Итак, я пытаюсь написать функцию, которая проверяет, совпадает ли вывод двух функций.Я пытаюсь сделать это с purrr::invoke_map().Тем не менее, я изо всех сил пытаюсь заставить его работать с любой функцией, которая использует enquo().

Я предполагаю, что проблема в том, что аргументы оцениваются, прежде чем я хочу, чтобы они были оценены.

library(tidyverse)

check_output <- function(function_list, param_list = NULL){
  param_list <- list(param_list) 
  output <- invoke_map(.f = function_list, .x = param_list) 
  identical(output[1], output[2])
}

check_output(function_list = list(cumprod, cumsum),  # This works
             param_list = list(x = iris$Sepal.Length))

check_output(function_list = list(cumsum, cumsum), # This works
             param_list = list(x = iris$Sepal.Length))

m <- function(data, col_name){ # Enquo test function
  col_name <- enquo(col_name)
 data %>% 
    select(!!col_name)
}
n <- m

n(iris, Species) # Seeing if the functions work

check_output(function_list = list(m, n),     # The call doesn't work
             param_list = list(data = iris, col_name = Species))

1 Ответ

0 голосов
/ 10 июня 2018

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

require(purrr)
require(magrittr) 
require(rlang) # add_quo uses this package

add_quo <- function(...) {
  ## Formats arguments for use in invoke_map()

  # Create a logical vector for use as an index below
  index <- exprs(...) %>%                       # Captures the arguments
    unlist() %>%                                # Makes them mappable
    map_if(negate(is.name), 
           .f = function(x) {return(TRUE)}) %>% # Replaces unnecessary args with TRUE
    map_if(is.name, as_character) %>%           # Converts named arguments to characters
    map_if(is.character, exists) %>%            # Replaces named args that aren't objects as FALSE
    unlist()                                    # To make index mappable

  # Wraps named args that aren't objects in new_quosure()
  exprs(...) %>%                    # Captures arguments
    unlist() %>%                    # Makes them mappable
    map_if(!index, new_quosure,     # Wraps non-object named arg in new_quosure()
           env = global_env()) %>%  # new_quosure() used instead of quo() as env must be global
    map_if(index, eval) %>%         # Removes expr() formatting
    list()                          # Makes arguments usable in invoke_map()
}

is.output.same<- function(.f_list, ...) {
  ## Checks to see if functions produce identical output

  param_list <- add_quo(...) # Enables function with dplyr syntax to work
  invoke_map(.f = .f_list, .x = param_list) %>%  # Pass args to functions
    reduce(identical) # Sees if all outputs are identical
}

check_output(function_list = list(m, n), data = iris, col_name = Species) #now works
...