Как вызвать `eval` с функцией` with`? - PullRequest
Новая
       66

Как вызвать `eval` с функцией` with`?

3 голосов
/ 20 февраля 2020

Имея объект lm, мне нужно создать функцию на основе ее переменных, представленных в виде символьного вектора. Я попытался использовать комбинацию eval и expr для создания функции f, которая в дальнейшем будет использоваться при оптимизации obj и nlm последней. 

library(tidyverse)
df <- drop_na(airquality)
model <- lm(Ozone~. - Temp, data = df, x=TRUE, y=TRUE)
base_vars <- all.vars(formula(model)[-2])
k <- length(base_vars)

f <- function(base_df, x, y, parms) {
  with(base_df, parms[1] + 
         eval(expr(paste(paste(paste0('parms[', 2:(k+1), ']'), base_vars, sep = '*'), collapse = '+'))) + 
         log(parms[k+2] * (x - parms[k+3] ^ 2)))
}
obj <- function(parms, y, x) mean((residuals(model) - f(df, x, y, parms))^2) 
fit <- with(data, nlm(obj, c(0, 0, 0, 0, 0, 0, 0), y = e, x = x))

Но вызов f(model$x, df$Temp, model$y, c(0, 0, 0, 0, 0, 0, 0)) приводит к следующей ошибке: 

Error in eval(substitute(expr), data, enclos = parent.frame()) : 
  numeric 'envir' arg not of length one 
4.
eval(substitute(expr), data, enclos = parent.frame()) 
3.
with.default(base_df, parms[1] + eval(expr(paste(paste(paste0("parms[", 
    2:(k + 1), "]"), base_vars, sep = "*"), collapse = "+"))) + 
    log(parms[k + 2] * (x - parms[k + 3]^2))) 
2.
with(base_df, parms[1] + eval(expr(paste(paste(paste0("parms[", 
    2:(k + 1), "]"), base_vars, sep = "*"), collapse = "+"))) + 
    log(parms[k + 2] * (x - parms[k + 3]^2))) 
1.
f(model$x, df$Temp, model$y, c(0, 0, 0, 0, 0, 0, 0))

Я полагаю, что может быть конфликт между средой eval и средой, подразумеваемой функцией with, но не могу понять, почему. Любые идеи, как я могу создать пользовательскую функцию f для переменных моделей?

Ожидаемый результат для f(model$x, df$Temp, model$y, c(0, 0, 0, 0, 0, 0, 0)) будет: 

with(base_df, parms[1]+parms[2]*Solar.R+parms[3]*Wind+parms[4]*Temp+parms[5]*Month+
              parms[6]*Day+log(parms[7] * (Temp - parms[8] ^ 2)))

, но для другой модели это может быть что-то вроде : 

with(base_df, 
     parms[1]+parms[2]*var1+parms[3]*var2+log(parms[4]*(var3-parms[5]^2)))

, поэтому число переменных и параметров различается при каждом вызове.

Ответы [ 2 ]

5 голосов
/ 21 февраля 2020

R поддерживает вычисления на языке, но это не должно быть вашим первым вариантом. Если вы делаете это, это никогда не должно включать текстовую обработку кода. У вас нет случая, когда вам нужно вычислить на языке. Я понятия не имею, как вы думали, что ваша попытка сработает, но я не знаю функцию expr, и я отказываюсь устанавливать пакет tidyverse и его ginormous дерево зависимостей.

Также, как правило, вам следует избегать with вне интерактивного использования. Но with здесь не проблема.

Вот как я бы это сделал: 

df <- airquality[complete.cases(airquality),]
model <- lm(Ozone~. - Temp, data = df)

f <- function(base_df, x, parms) {

  m <- model.matrix(model, data = base_df)
  k <- ncol(m)
  stopifnot(length(parms) == (k + 2L))
  #I use exp(parms[k+1]) to ensure a positive value within the log
  m %*% parms[seq_len(k)] + log(exp(parms[k + 1L]) * (x - parms[k + 2L] ^ 2))

}

obj <- function(parms, y, x, base_df) mean((residuals(model) - f(base_df, x, parms))^2) 

#some x:
x <- rpois(nrow(df), 10)

fit <- nlm(obj, c(0, 0, 0, 0, 0, 0, 0), x = x, base_df = df)
#works

Вы, кажется, не используете y, и поэтому я удалил его из code.

Обратите внимание, как я создаю матрицу проектирования для линейной части (используя model.matrix) и использую матричное умножение с параметрами. Вы также должны убедиться, что log не возвращает Inf / -Inf / NaN.

1 голос
/ 07 марта 2020

Я думаю, что @Roland дал хороший ответ, освещающий вашу актуальную проблему. Я выделяю то, что, по-моему, вы конкретно спрашивали, основываясь на заголовке вопроса, без комментариев по поводу того, хорошая это идея или нет. Это, вероятно, не в этом случае использования.

Но то, что вы искали более чем вероятно, это eval_tidy() из rlang. Я оставил обозначение функции :: только для того, чтобы было очевидно, какой пакет используется здесь.

Примечание. Я исправил пару вещей, которые казались ошибками в коде. Я также использую все единицы вместо нулей для проверки в parms из-за журнала. 

library(rlang)
library(tidyr)

# dropped y since it was an unused argument
f <- function(base_df, x, parms) {
  # set an expression to evaluate using parse_expr()
  .f <- rlang::parse_expr(paste(paste(paste0('parms[', 2:(k+1), ']'),
                                      base_vars, sep = '*'), collapse = '+'))

  # use eval_tidy() with the data mask  
  y_part1 <- rlang::eval_tidy(.f, data = base_df)
  y_part2 <- log(parms[k + 2] * (x - parms[k + 3] ^ 2))

  parms[1] + y_part1 + y_part2
}

# using your code
df <- tidyr::drop_na(airquality)
model <- lm(Ozone~. - Temp, data = df, x=TRUE, y=TRUE)
base_vars <- all.vars(formula(model)[-2])
k <- length(base_vars)

# changed to all ones, I think this is what you wanted for length
parms <- rep(1, k + 3)

method_1 <- f(df, df$Temp, parms)

method_2 <- with(df, parms[1]+parms[2]*Solar.R+parms[3]*Wind+parms[4]*Temp+parms[5]*Month+
                   parms[6]*Day+log(parms[7] * (Temp - parms[8] ^ 2)))


all.equal(method_1, method_2)
# [1] TRUE
...