从提取物中获取对象名称
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())))
}
原理:
您反复检查调用堆栈,直到收到一个 gnl
的调用
此调用可能由许多调用组成(例如带有 %>% head()
的调用),因此您需要递归地挖掘这些调用以仅获得带有 [=12] 的调用=]
此调用的第二个元素为您提供要子集化的对象的名称(例如,查看 as.list(substitute(mtcars[1]))
)
你对这个对象做了过滤
验证:
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
我想编写一个函数 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())))
}
原理:
您反复检查调用堆栈,直到收到一个
gnl
的调用
此调用可能由许多调用组成(例如带有
%>% head()
的调用),因此您需要递归地挖掘这些调用以仅获得带有 [=12] 的调用=]此调用的第二个元素为您提供要子集化的对象的名称(例如,查看
as.list(substitute(mtcars[1]))
)你对这个对象做了过滤
验证:
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