Создание функции, которая принимает вызов функции в качестве аргумента в конвейерную функцию. - PullRequest
Новая
       35

Создание функции, которая принимает вызов функции в качестве аргумента в конвейерную функцию.

0 голосов
/ 11 июня 2018 
require(magrittr)
require(purrr)

is.out.same <- function(.call, ...) {
  ## Checks if args in .call will produce identical output in other functions
  call <- substitute(.call)               # Captures function call
  f_names <- eval(substitute(alist(...))) # Makes list of f_names


  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[1]] <- .y; return(.x)} 
  ) %>%
    map(eval) %>%                         # Evaluates function calls
    map_lgl(identical, x = .call) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

is.out.same(map(1:3, cumsum), lapply) # This works
map(1:3, cumsum) %>%                  # Is there any way to make this work?
  is.out.same(lapply)

Моя функция принимает вызов функции в качестве аргумента.

Есть ли способ сделать мою функцию работоспособной?Сейчас проблема в том, что любая функция, которую я вызываю, будет оценена перед конвейером.Единственное, о чем я могу думать, - это использовать функцию для «недооценки» значения, но это кажется невозможным.

1 Ответ

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

Я бы не советовал, кто бы это ни делал.Трубный оператор спроектирован так, чтобы было легко передавать выходные данные одной функции как входные данные следующей.Но это совсем не то, что вы здесь делаете.Вы хотите манипулировать всем стеком вызовов.Но технически это возможно сделать.Вам просто нужно проделать дополнительную работу, чтобы найти цепочку «метаданных», чтобы увидеть, что было первоначально передано. Здесь я вставил две вспомогательные функции для извлечения соответствующей информации. 

find_chain_parts <- function() {
  i <- 1
  while(!("chain_parts" %in% ls(envir=parent.frame(i))) && i < sys.nframe()) {
    i <- i+1
  }
  parent.frame(i)
}

find_lhs <- function(x) {
  env <- find_chain_parts()
  if(exists("chain_parts",env)) {
    return(env$chain_parts$lhs)
  } else {
    return(do.call("substitute", list(substitute(x), parent.frame())))
  }
}

Эти функции идутвверх по стеку вызовов, чтобы найти исходный канал вызова.Если он присутствует, он извлечет выражение из левой части, в противном случае он просто заменит исходный параметр.Вы просто изменили бы свою функцию на использование 

is.out.same <- function(.call, ...) {
  call <- find_lhs(.call)                # Captures function call
  f_names <- eval(substitute(alist(...))) # Makes list of f_names

  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[1]] <- .y; return(.x)} 
  )  %>% 
    map(eval) %>%                         # Evaluates function calls
    map_lgl(identical, x = .call) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

Тогда оба из них запустились бы 

is.out.same(map(1:3, cumsum), lapply)
# [1] TRUE 
map(1:3, cumsum) %>%                  
  is.out.same(lapply)
# [1] TRUE

Но если вы действительно проверяете функциональную эквивалентность выражений, это имело бы гораздо больший смыслпереходить в позы.Тогда вам не понадобятся разные ветви.Такая функция выглядела бы так 

library(rlang)
is.out.same <- function(call, ...) {
  f_names <- eval(substitute(alist(...))) # Makes list of f_names

  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[2]][[1]] <- .y; return(.x)} 
  )  %>% 
    map(eval_tidy) %>%                         # Evaluates function calls
    map_lgl(identical, x = eval_tidy(call)) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

, и вы бы назвали ее одним из следующих способов 

is.out.same(quo(map(1:3, cumsum)), lapply) 

quo(map(1:3, cumsum)) %>%
  is.out.same(lapply)

Это, на мой взгляд, делает намерение намного яснее.

...