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

Поскольку в subset() указано вручную:

Предупреждение . Это функция удобства, предназначенная для интерактивного использования

Из этой замечательной статьи я узнал не только секрет этого предупреждения, но и хорошее понимание substitute() , match.call() , eval() , quote() , вызовов, promise и других связанных с ними субъектов R, которые являются немного сложнее.

Теперь я понимаю, для чего это предупреждение. Суперпростая реализация subset() может быть следующей:

 subset = function(x, condition) x[eval(substitute(condition), envir=x),] 

Хотя subset(mtcars, cyl==4) возвращает таблицу строк в mtcars которые удовлетворяют cyl==4 , обнуление subset() в другой функции не выполняется:

 sub = function(x, condition) subset(x, condition) sub(mtcars, cyl == 4) # Error in eval(expr, envir, enclos) : object 'cyl' not found 

Использование исходной версии subset() также дает точно такое же условие ошибки. Это связано с ограничением пары substitute()-eval() : оно работает нормально, а condition – это cyl==4 , но когда condition передается через огибающую функцию sub() , аргумент condition subset() будет уже не cyl==4 , но nested condition в sub() , а eval() терпит неудачу – это немного сложно.

Но существует ли какая-либо другая реализация subset() с точно такими же аргументами, которые были бы безопасны в программировании, т. Е. Могли бы оценивать ее состояние, пока оно вызвано другой функцией?

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

Хэдли опубликовал суть, демонстрирующую ситуацию, в которой моя принятая функция идет вразрез. Твист в этом примере (скопирован ниже) заключается в том, что символ, переданный 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 
  • Как подсчитать количество уникальных значений по группе?
  • Автоматически создавать формулы для всех возможных линейных моделей
  • Есть ли способ сделать R звуковой сигнал / воспроизвести звук в конце скрипта?
  • Евклидово расстояние двух векторов
  • Добавление нового столбца к каждому элементу в списке таблиц или фреймов данных
  • В R, как получить имя объекта после его отправки в функцию?
  • Ошибка в model.frame.default ... переменная длина отличается
  • Как вставить элементы в вектор?
  • условие имеет длину> 1, и только первый элемент будет использоваться в if else statement
  • R: gsub, pattern = vector и replacement = vector
  • Проверить наличие директории и создать, если не существует
  • Давайте будем гением компьютера.