Программируемая версия подмножества – для оценки ее состояния при вызове из другой функции

Просто потому, что это такая увлекательная забава (??), вот несколько другое решение, которое решает проблему, о которой Хэдли указал в комментариях к моему принятому решению.

Хэдли опубликовал суть, демонстрирующую ситуацию, в которой моя принятая функция идет вразрез. Твист в этом примере (скопирован ниже) заключается в том, что символ, переданный SUBSET() , определен в теле (а не в аргументах) одной из вызывающих функций; он, таким образом, захватывается substitute() вместо предполагаемой глобальной переменной. Я знаю, что это путают.

 f <- function() { cyl <- 4 g() } g <- function() { SUBSET(mtcars, cyl == 4)$cyl } f() 

Вот лучшая функция, которая заменит только значения символов, найденных в списках аргументов вызывающих функций. Он работает во всех ситуациях, которые до сих пор предлагал Хэдли или я.

 SUBSET <- function(`_dat`, expr) { ff <- sys.frames() n <- length(ff) ex <- substitute(expr) ii <- seq_len(n) for(i in ii) { ## 'which' is the frame number, and 'n' is # of frames to go back. margs <- as.list(match.call(definition = sys.function(n - i), call = sys.call(sys.parent(i))))[-1] ex <- eval(substitute(substitute(x, env = ll), env = list(x = ex, ll = margs))) } `_dat`[eval(ex, envir = `_dat`),] } ## Works in Hadley's counterexample ... f() # [1] 4 4 4 4 4 4 4 4 4 4 4 ## ... and in my original test cases. sub <- function(x, condition) SUBSET(x, condition) sub2 <- function(AA, BB) sub(AA, BB) a <- SUBSET(mtcars, cyl == 4) ## Direct call to SUBSET() b <- sub(mtcars, cyl == 4) ## SUBSET() called one level down c <- sub2(mtcars, cyl == 4) all(identical(a, b), identical(b, c)) # [1] TRUE 

ВАЖНО: Обратите внимание, что это все еще не является (и не может быть сделано) полезной функцией. Функция не знает, какие символы вы хотите использовать во всех подстановках, которые она выполняет при работе над стеком вызовов. Существует множество ситуаций, когда пользователи захотят использовать значения символов, назначаемых внутри тел функции, но эта функция всегда будет игнорировать их.

[Функция – это то, что вы ищете. ? “[“. mtcars[mtcars$cyl == 4,] эквивалентен команде подмножества и безопасен для программирования.

 sub = function(x, condition) { x[condition,] } sub(mtcars, mtcars$cyl==4) 

Делает то, что вы просите, неявно with() в вызове функции. Специфика сложна, однако такая функция, как:

 sub = function(x, quoted_condition) { x[with(x, eval(parse(text=quoted_condition))),] } sub(mtcars, 'cyl==4') 

Сорта делает то, что вы ищете, но есть крайние случаи, когда это приведет к неожиданным результатам.

используя data.table и [ функцию подмножества, вы можете получить неявное with(...) вы ищете.

 library(data.table) MT = data.table(mtcars) MT[cyl==4] 

есть лучшие, более быстрые способы сделать это подмножество в data.table , но это хорошо иллюстрирует точку.

используя data.table вы также можете построить выражения для последующей оценки

 cond = expression(cyl==4) MT[eval(cond)] 

эти два теперь могут быть переданы через функции:

 wrapper = function(DT, condition) { DT[eval(condition)] } 

Вот альтернативная версия subset() которая продолжает работать, даже если она вложена – по крайней мере, до тех пор, пока логическое выражение подмножества (например, cyl == 4 ) будет отправлено на вызов функции верхнего уровня.

Он работает, поднимаясь вверх по стеку вызовов, substitute() на каждом шаге, чтобы в конечном счете захватить выражение логического подмножества, переданное пользователем. Например, в вызове sub2() ниже цикл for sub2() стек вызовов из expr в x в AA и, наконец, в cyl ==4 .

 SUBSET <- function(`_dat`, expr) { ff <- sys.frames() ex <- substitute(expr) ii <- rev(seq_along(ff)) for(i in ii) { ex <- eval(substitute(substitute(x, env=sys.frames()[[n]]), env = list(x = ex, n=i))) } `_dat`[eval(ex, envir = `_dat`),] } ## Define test functions that nest SUBSET() more and more deeply sub <- function(x, condition) SUBSET(x, condition) sub2 <- function(AA, BB) sub(AA, BB) ## Show that it works, at least when the top-level function call ## contains the logical subsetting expression a <- SUBSET(mtcars, cyl == 4) ## Direct call to SUBSET() b <- sub(mtcars, cyl == 4) ## SUBSET() called one level down c <- sub2(mtcars, cyl == 4) ## SUBSET() called two levels down identical(a,b) # [1] TRUE > identical(a,c) # [1] TRUE a[1:5,] # mpg cyl disp hp drat wt qsec vs am gear carb # Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 # Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 # Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 # Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1 # Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2 

** Для некоторого объяснения конструкции внутри цикла for см. Раздел 6.2 , параграф 6 руководства по определению языка R.

Обновить:

Вот новая версия, которая устраняет две проблемы:

a) предыдущая версия просто прошла через sys.frames() назад. Эта версия следует parent.frames() пока не достигнет .GlobalEnv . Это важно, например, в subscramble , когда кадр scramble следует игнорировать.

b) В этой версии есть один substitute уровень за уровень. Это предотвращает второй substitute вызов от замены символов с одного уровня выше, которые были введены первым substitute вызовом.

 subset <- function(x, condition) { call <- substitute(condition) frames <- sys.frames() parents <- sys.parents() # starting one frame up, keep climbing until we get to .GlobalEnv i <- tail(parents, 1) while(i != 0) { f <- sys.frames()[[i]] # copy x into f, except for variable with conflicting names. xnames <- setdiff(ls(x), ls(f)) for (n in xnames) assign(n, x[[n]], envir=f) call <- eval(substitute(substitute(expr, f), list(expr=call))) # leave f the way we found it rm(list=xnames, envir=f) i <- parents[i] } r <- eval(call, x, .GlobalEnv) x[r, ] } 

Эта версия проходит тест @ hadley из комментариев:

 mtcars $ condition <- 4; subscramble(mtcars, cyl == 4) 

К сожалению, следующие два примера ведут себя по-другому:

 cyl <- 6; subset(mtcars, cyl==4) local({cyl <- 6; subset(mtcars, cyl==4)}) 

Это небольшая модификация первой функции Джоша. На каждом фрейме в стеке мы заменяем от x до замены из фрейма. Это означает, что символы в кадре данных имеют приоритет на каждом шаге. Мы можем избежать псевдо-gensyms, таких как _dat , пропуская рамку subset в цикле for .

 subset <- function(x, condition) { call <- substitute(condition) frames <- rev(sys.frames())[-1] for(f in frames) { call <- eval(substitute(substitute(expr, x), list(expr=call))) call <- eval(substitute(substitute(expr, f), list(expr=call))) } r <- eval(call, x, .GlobalEnv) x[r, ] } 

Эта версия работает в простом случае (стоит проверить, что у нас не было регрессии):

 subset(mtcars, cyl == 4) # mpg cyl disp hp drat wt qsec vs am gear carb # Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 # Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 # Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 # Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1 # Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2 # Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1 # Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1 # Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1 # Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2 # Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2 # Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2 

Он также работает с subscramble и f :

 scramble <- function(x) x[sample(nrow(x)), ] subscramble <- function(x, condition) scramble(subset(x, condition)) subscramble(mtcars, cyl == 4) $ cyl # [1] 4 4 4 4 4 4 4 4 4 4 4 f <- function() {cyl <- 4; g()} g <- function() subset(mtcars, cyl == 4) $ cyl g() # [1] 4 4 4 4 4 4 4 4 4 4 4 

И даже работает в некоторых более сложных ситуациях:

 gear5 <- function(z, condition) { x <- 5 subset(z, condition & (gear == x)) } x <- 4 gear5(mtcars, cyl == x) # mpg cyl disp hp drat wt qsec vs am gear carb # Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.7 0 1 5 2 # Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.9 1 1 5 2 

Строки внутри цикла for могут потребовать некоторого объяснения. Предположим, что call назначается следующим образом:

 call <- quote(y == x) str(call) # language y == x 

Мы хотим подставить значение 4 для x в call . Но простой способ не работает, поскольку мы хотим, чтобы содержимое call , а не call символа.

 substitute(call, list(x=4)) # call 

Поэтому мы создаем выражение, в котором мы нуждаемся, используя другой substitute вызов.

 substitute(substitute(expr, list(x=4)), list(expr=call)) # substitute(y == x, list(x = 4)) 

Теперь у нас есть объект языка, который описывает то, что мы хотим сделать. Все, что осталось на самом деле:

 eval(substitute(substitute(expr, list(x=4)), list(expr=call))) # y == 4