Функция, которая запускает lm для разных переменных - PullRequest
0 голосов
/ 06 января 2019

Я хотел бы создать функцию, которая может запускать регрессионную модель (например, используя lm) для различных переменных в данном наборе данных. В этой функции я бы указал в качестве аргументов набор данных, который я использую, зависимую переменную y и независимую переменную x. Я хочу, чтобы это была функция, а не цикл, поскольку я хотел бы вызывать код в разных местах моего скрипта. Моя наивная функция будет выглядеть примерно так:

lmfun <- function(data, y, x) {
  lm(y ~ x, data = data)
}

Эта функция, очевидно, не работает, поскольку функция lm не распознает y и x как переменные набора данных.

Я провел некоторое исследование и наткнулся на следующую полезную виньетку: программирование с помощью dplyr . Виньетка дает следующее решение проблемы, аналогичной той, с которой я столкнулся:

df <- tibble(
  g1 = c(1, 1, 2, 2, 2),
  g2 = c(1, 2, 1, 2, 1),
  a = sample(5),
  b = sample(5)
)

my_sum <- function(df, group_var) {
  group_var <- enquo(group_var)
  df %>%
    group_by(!! group_var) %>%
    summarise(a = mean(a))
}

Мне известно, что lm не является функцией, входящей в пакет dplyr, но хотел бы найти решение, подобное этому. Я пробовал следующее:

lmfun <- function(data, y, x) {
  y <- enquo(y)
  x <- enquo(x)

  lm(!! y ~ !! x, data = data)
}

lmfun(mtcars, mpg, disp)

Запуск этого кода выдает следующее сообщение об ошибке:

Ошибка в is_quosure (e2): отсутствует аргумент "e2", без значения по умолчанию

У кого-нибудь есть идеи о том, как изменить код, чтобы это работало?

Спасибо

Joost.

Ответы [ 4 ]

0 голосов
/ 06 января 2019

Другое решение:

lmf2 <- function(data,y,x){
  fml <- substitute(y~x, list(y=substitute(y), x=substitute(x)))
  lm(eval(fml), data)
}

lmf2(mtcars, mpg, disp)
# Call:
# lm(formula = eval(fml), data = data)
# 
# Coefficients:
# (Intercept)         disp  
#    29.59985     -0.04122  

Или, что эквивалентно:

lmf3 <- function(data,y,x){
  lm(eval(call("~", substitute(y), substitute(x))), data)
}
0 голосов
/ 06 января 2019

Вот еще один вариант: EDIT: Вот рефакторированный ответ

lmfun<-function(data,yname,xname){
 formula1<-as.formula(paste(yname,"~",xname))
  lm.fit<-do.call("lm",list(data=quote(data),formula1))
  lm.fit
}
lmfun(mtcars,"mpg","disp")

И оригинальный ответ:

 lmfun<-function(data,y,x){
      formula1<-as.formula(y~x)
      lm.fit<-do.call("lm",list(data=quote(data),formula1))
      lm.fit
    }
lmfun(mtcars,mtcars$mpg,mtcars$disp)

Урожайность:

Call:
lm(formula = y ~ x, data = data)

Coefficients:
(Intercept)            x  
   29.59985     -0.04122  
0 голосов
/ 06 января 2019

Если аргументы не заключены в кавычки, тогда преобразуйте в символ (sym) после изменения выражения в строку (quo_name) и оцените выражение в lm (аналогично синтаксису OP в lm)

library(rlang)
lmfun <- function(data, y, x) {
  y <- sym(quo_name(enquo(y)))
  x <- sym(quo_name(enquo(x)))
  expr1 <- expr(!! y ~ !! x)

  model <- lm(expr1, data = data)
  model$call$formula <- expr1 # change the call formula
  model
}

lmfun(mtcars, mpg, disp)
#Call:
#lm(formula = mpg ~ disp, data = data)

#Coefficients:
#(Intercept)         disp  
#   29.59985     -0.04122  

Опция, если мы передаем строки, будет преобразована в символы с ensym, а затем quote это в lm

lmfun <- function(data, y, x) {
  y <- ensym(y)
  x <- ensym(x)
  expr1 <- expr(!! y ~ !! x)

  model <- lm(expr1, data = data)
  model$call$formula <- expr1 # change the call formula
  model

}

lmfun(mtcars, 'mpg', 'disp')
#Call:
#lm(formula = mpg ~ disp, data = data)


#Coefficients:
#(Intercept)         disp  
#   29.59985     -0.04122  

ПРИМЕЧАНИЕ. Оба варианта относятся к tidyverse

0 голосов
/ 06 января 2019

Вы можете решить эту проблему, используя quo_name и formula:

lmfun <- function(data, y, x) {
  y <- enquo(y)
  x <- enquo(x)

  model_formula <- formula(paste0(quo_name(y), "~", quo_name(x)))
  lm(model_formula, data = data)
}

lmfun(mtcars, mpg, disp)

# Call:
#   lm(formula = model_formula, data = data)
# 
# Coefficients:
#   (Intercept)         disp  
#      29.59985     -0.04122  
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...