从提取物中获取对象名称

Get objects name from inside extract

我想编写一个函数 gnl() (getNamesLike),当在 extract 中进行评估时,它可以检索执行 extract 的对象的名称。 可能吗?

这是所需行为的一些代码:

gnl <- function(pattern) {grepl(pattern,names(mtcars))}
mtcars[,gnl("a")] %>% head
#                   drat am gear carb
# Mazda RX4         3.90  1    4    4
# Mazda RX4 Wag     3.90  1    4    4
# Datsun 710        3.85  1    4    1
# Hornet 4 Drive    3.08  0    3    1
# Hornet Sportabout 3.15  0    3    2
# Valiant           2.76  0    3    1

gnl <- function(pattern) {grepl(pattern,names(cars))}
cars[,gnl("i"),drop=F]  %>% head
#   dist
# 1    2
# 2   10
# 3    4
# 4   22
# 5   16
# 6   10

当然 gnl() 需要动态获取名称(mtcars、cars 等...)。

我最远的是:

gnl <- function(data,pattern) {
    dplyr::select(data,dplyr::matches(pattern))
    }
mtcars %>% gnl("a")

这似乎可行,但有点乱..

dig_call <- function(call, call0_chr) {

  new_call <- call[[which(grepl(call0_chr, call, fixed = TRUE))]]

  if (identical(deparse(new_call), call0_chr)) {
    call[[2]]
  } else {
    dig_call(new_call, call0_chr)
  }
}

gnl <- function(pattern) {

  call0_chr <- deparse(sys.call(i <- 0))

  repeat {
    i <- i + 1
    call <- sys.call(i)
    find_call <- grepl(call0_chr, call, fixed = TRUE)
    if (any(find_call)) break
  }

  grepl(pattern, names(eval(dig_call(call, call0_chr), parent.frame())))
}

原理:

  1. 您反复检查调用堆栈,直到收到一个 gnl

  2. 的调用
  3. 此调用可能由许多调用组成(例如带有 %>% head() 的调用),因此您需要递归地挖掘这些调用以仅获得带有 [=12] 的调用=]

  4. 此调用的第二个元素为您提供要子集化的对象的名称(例如,查看 as.list(substitute(mtcars[1]))

  5. 你对这个对象做了过滤

验证:

library(dplyr)
cars[gnl("i")]
cars[gnl("i")] %>% head()
cars[gnl("i")] %>% head() %>% head()
mtcars[gnl("i")]
mtcars[gnl("i")] %>% head()

有一个额外的 S3 class:

`[.gnlable` <- function(x, i, j, drop = FALSE) {
  if (!missing(j)) {
    j <- substitute(j)
    j <- if (identical(j[[1]], quote(gnl))) grepl(j[[2]], names(x)) else eval(j)
  }
  `[.data.frame`(x, i, j, drop = drop)
}

class(cars) <- c("gnlable", class(cars))

cars[1:6, gnl("i"), drop = FALSE]
#   dist
# 1    2
# 2   10
# 3    4
# 4   22
# 5   16
# 6   10