Как надежно получить зависимое имя переменной от объекта формулы?

Скажем, у меня есть следующая формула:

myformula<-formula("depVar ~ Var1 + Var2")

Как надежно получить зависимое имя переменной из объекта формулы?

Мне не удалось найти встроенную функцию, которая служит этой цели. Я знаю, что as.character(myformula)[[2]] работает, как и

sub("^(\\w*)\\s~\\s.*$","\\1",deparse(myform))

Мне просто кажется, что эти методы более хакерские, чем надежный и стандартный метод для этого.

Кто-нибудь знает, что именно метод, например, lm использовать? Я видел его код, но он немного загадочен мне... вот цитата для вашего удобства:

    > lm
function (formula, data, subset, weights, na.action, method = "qr", 
    model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
    contrasts = NULL, offset, ...) 
{
    ret.x <- x
    ret.y <- y
    cl <- match.call()
    mf <- match.call(expand.dots = FALSE)
    m <- match(c("formula", "data", "subset", "weights", "na.action", 
        "offset"), names(mf), 0L)
    mf <- mf[c(1L, m)]
    mf$drop.unused.levels <- TRUE
    mf[[1L]] <- as.name("model.frame")
    mf <- eval(mf, parent.frame())
    if (method == "model.frame") 
        return(mf)
    else if (method != "qr") 
        warning(gettextf("method = '%s' is not supported. Using 'qr'", 
            method), domain = NA)
    mt <- attr(mf, "terms")
    y <- model.response(mf, "numeric")
    w <- as.vector(model.weights(mf))
    if (!is.null(w) && !is.numeric(w)) 
        stop("'weights' must be a numeric vector")
    offset <- as.vector(model.offset(mf))
    if (!is.null(offset)) {
        if (length(offset) != NROW(y)) 
            stop(gettextf("number of offsets is %d, should equal %d (number of observations)", 
                length(offset), NROW(y)), domain = NA)
    }
    if (is.empty.model(mt)) {
        x <- NULL
        z <- list(coefficients = if (is.matrix(y)) matrix(, 0, 
            3) else numeric(), residuals = y, fitted.values = 0 * 
            y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w != 
            0) else if (is.matrix(y)) nrow(y) else length(y))
        if (!is.null(offset)) {
            z$fitted.values <- offset
            z$residuals <- y - offset
        }
    }
    else {
        x <- model.matrix(mt, mf, contrasts)
        z <- if (is.null(w)) 
            lm.fit(x, y, offset = offset, singular.ok = singular.ok, 
                ...)
        else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, 
            ...)
    }
    class(z) <- c(if (is.matrix(y)) "mlm", "lm")
    z$na.action <- attr(mf, "na.action")
    z$offset <- offset
    z$contrasts <- attr(x, "contrasts")
    z$xlevels <- .getXlevels(mt, mf)
    z$call <- cl
    z$terms <- mt
    if (model) 
        z$model <- mf
    if (ret.x) 
        z$x <- x
    if (ret.y) 
        z$y <- y
    if (!qr) 
        z$qr <- NULL
    z
}

Ответы

Ответ 1

Попробуйте использовать all.vars:

all.vars(myformula)[1]

Ответ 2

Я нашел полезный пакет "formula.tools", который подходит для вашей задачи.

Пример кода:

f < - as.formula(a1 + a2 ~ a3 + a4)

lhs.vars(f) зависимые от #get переменные

[1] "a1" "a2"

rhs.vars(f) независимые переменные #get

[1] "a3" "a4"

Ответ 3

Я полагаю, вы могли бы также приготовить свою собственную функцию для работы с terms():

getResponse <- function(formula) {
    tt <- terms(formula)
    vars <- as.character(attr(tt, "variables"))[-1] ## [1] is the list call
    response <- attr(tt, "response") # index of response var
    vars[response] 
}

R> myformula <- formula("depVar ~ Var1 + Var2")
R> getResponse(myformula)
[1] "depVar"

Это так же вредно, как as.character(myformyula)[[2]], но у вас есть уверенность, что вы получите правильную переменную, так как упорядочение дерева синтаксиса вызова не изменится в ближайшее время.

Это не так хорошо с несколькими зависимыми переменными:

R> myformula <- formula("depVar1 + depVar2 ~ Var1 + Var2")
R> getResponse(myformula)
[1] "depVar1 + depVar2"

поскольку они нуждаются в дальнейшей обработке.

Ответ 4

На основе вашего редактирования, чтобы получить фактический ответ, а не только его имя, мы можем использовать нестандартную оценочную идиому, используемую lm(), и большинство других функций моделирования с интерфейсом формулы в базе R

form <- formula("depVar ~ Var1 + Var2")
dat <- data.frame(depVar = rnorm(10), Var1 = rnorm(10), Var2 = rnorm(10))

getResponse <- function(form, data) {
    mf <- match.call(expand.dots = FALSE)
    m <- match(c("formula", "data"), names(mf), 0L)
    mf <- mf[c(1L, m)]
    mf$drop.unused.levels <- TRUE
    mf[[1L]] <- as.name("model.frame")
    mf <- eval(mf, parent.frame())
    y <- model.response(mf, "numeric")
    y
} 

> getResponse(form, dat)
          1           2           3           4           5 
-0.02828573 -0.41157817  2.45489291  1.39035938 -0.31267835 
          6           7           8           9          10 
-0.39945771 -0.09141438  0.81826105  0.37448482 -0.55732976

Как вы видите, это получает фактические данные переменной ответа из предоставленного фрейма данных.

Как это работает, так это то, что функция сначала захватывает вызов функции без расширения аргумента ..., так как содержит вещи, которые не нужны для оценки данных для формулы.

Затем аргументы "formula" и "data" сопоставляются с вызовом. Строка mf[c(1L, m)] выбирает имя функции из вызова (1L) и местоположения двух согласованных аргументов. Аргумент drop.unused.levels model.frame() устанавливается в TRUE в следующей строке, а затем этот вызов обновляется для переключения имени функции в вызове от lm до model.frame. Все приведенные выше коды выполняют вызов lm() и процессы, вызывающие вызов функции model.frame().

Этот измененный вызов затем оценивается в родительской среде функции, которая в этом случае является глобальной средой.

В последней строке используется функция выделения model.response() для принятия переменной ответа из кадра модели.

Ответ 5

Это всегда должно давать вам все зависимые вары:

myformula<-formula("depVar1 + depVar2 ~ Var1 + Var2")
as.character(myformula[[2]])[-1]
#[1] "depVar1" "depVar2"

И я бы не стал считать это особенно "взломанным".

Edit:

Что-то странное случается с 3 иждивенцами:

myformula<-formula("depVar1 + depVar2 + depVar3 ~ Var1 + Var2")
as.character(myformula[[2]])
#[1] "+"                 "depVar1 + depVar2" "depVar3"

Так что это может быть не так надежно, как я думал.

Edit2:

Хорошо, myformula[[2]] - объект языка, а as.character, похоже, делает что-то похожее, как languageEl.

length(myformula[[2]])
#[1] 3
languageEl(myformula[[2]],which=1)
#`+`
languageEl(myformula[[2]],which=2)
#depVar1 + depVar2
languageEl(myformula[[2]],which=3)
#depVar3
languageEl(languageEl(myformula[[2]],which=2),which=2)
#depVar1

Если вы проверяете длину каждого элемента, вы можете создать свою собственную функцию извлечения. Но это, вероятно, слишком большая проблема.

Edit3: Основываясь на ответе @seancarmody all.vars(myformula[[2]]), это путь.