Получить имя объекта изнутри экстракта - PullRequest
Новая
       6

Получить имя объекта изнутри экстракта

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

Я хотел бы написать функцию gnl() (getNamesLike), которая при оценке внутри извлечения может извлечь имя объекта, над которым выполняется 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")

Ответы [ 2 ]

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

С дополнительным классом S3: 

`[.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
0 голосов
/ 12 июня 2018

Кажется, что это работает, но это немного хак.с gnl

Этот вызов может состоять из множества вызовов (например, с вызовом %>% head()), поэтому вам нужно рекурсивно копаться в этих вызовах, чтобы получить только одинс gnl

второй элемент этого вызова дает вам имя объекта, который вы пытаетесь установить (например, посмотрите на 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()
...