Получить имя кадра данных, переданного через канал в R

Question

Я хотел бы иметь возможность печатать имя кадра данных, переданного через канал. Это возможно? Я могу сделать.

printname <- function(df){
    print(paste(substitute(df)))
}
printname(mtcars)
#[1] "mtcars"

Тем не менее, он возвращает "." когда эта функция передается с помощью magrittr труба.

mtcars %>% printname
# [1] "."

Это было бы полезно при написании пользовательских сообщений об ошибках функций, используемых в зарегистрированных производственных процессах - трудно понять, где что-то не получилось, если в журнале есть только "".

Вероятно, будет достаточно вернуть исходный вызов, который будет включать mtcars %>% кусок.

Answer 1

Это первая попытка, это своего рода взлом, но, похоже, это может сработать.

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

printfirstname <- function(df){
    ee <- find_chain_parts()
    print(deparse(ee$lhs))
}

mtcars %>% printfirstname
# [1] "mtcars"

pipe Функция создает среду, которая отслеживает части цепи. Я пытался пройтись по текущим средам выполнения, ища эту переменную, а затем использовать lhs информация хранится там, чтобы найти символ в начале трубы. Это не очень хорошо проверено.

Answer 2

Как Том и Лайонел Генри прокомментировали ответ MrFlick, принятый ответ больше не работает под более магритром 2.

Тогда новый ответ избегает deparse(substitute())за sys.calls(). Я получаю это из ответа Артема Соколова здесь . Я не буду притворяться, что полностью понимаю, что происходит, но это работает для меня:

      x_expression <- function(x) {
  getAST <- function(ee) purrr::map_if(as.list(ee), is.call, getAST)

  sc <- sys.calls()
  ASTs <- purrr::map( as.list(sc), getAST ) %>%
    purrr::keep( ~identical(.[[1]], quote(`%>%`)) )  # Match first element to %>%

  if( length(ASTs) == 0 ) return( enexpr(x) )        # Not in a pipe
  dplyr::last( ASTs )[[2]]    # Second element is the left-hand side
}

который дает желаемый результат как для конвейерной, так и для неконвейерной нотации:

      x_expression(mtcars)
# mtcars

mtcars %>% x_expression()
# mtcars