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

Ответ 1

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

Hadley опубликовал суть, демонстрируя ситуацию, в которой моя принятая функция идет вразрез. Твист в этом примере (скопирован ниже) состоит в том, что символ, переданный в 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 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

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

Ответ 2

[функция - это то, что вы ищете.? "[". 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)]
}

Ответ 3

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

Он работает, поднимаясь вверх по стеку вызовов, substitute() на каждом шаге, чтобы в конечном счете захватить выражение логического подмножества, переданное пользователем. При вызове sub2() ниже, например, цикл for обрабатывает стек вызовов от 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.

Ответ 4

Update:

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

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