【问题标题】:Function which runs lm over different variables在不同变量上运行 lm 的函数
【发布时间】:2019-06-01 07:50:31
【问题描述】:

我想创建一个函数,它可以在给定数据集中的不同变量上运行回归模型(例如使用 lm)。在这个函数中,我将指定我正在使用的数据集、因变量 y 和自变量 x 作为参数。我希望这是一个函数而不是循环,因为我想在脚本的各个位置调用代码。我的幼稚函数看起来像这样:

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

这个函数显然不起作用,因为 lm 函数不能将 y 和 x 识别为数据集的变量。

我做了一些研究,偶然发现了以下有用的小插图:programming with 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”,没有默认值

有人知道如何修改代码以使其工作吗?

谢谢,

约斯特。

【问题讨论】:

    标签: r lm quosure


    【解决方案1】:

    您可以通过使用quo_nameformula 来解决此问题:

    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  
    

    【讨论】:

      【解决方案2】:

      这是另一种选择: 编辑: 这是一个重构的答案

      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  
      

      【讨论】:

        【解决方案3】:

        如果参数不带引号,则在将quosure更改为字符串(quo_name)后转换为符号(sym)并评估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

        【讨论】:

          【解决方案4】:

          另一种解决方案:

          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)
          }
          

          【讨论】:

            猜你喜欢
            • 2017-07-30
            • 1970-01-01
            • 2021-03-03
            • 1970-01-01
            • 1970-01-01
            • 1970-01-01
            • 2021-03-31
            • 2020-10-31
            • 1970-01-01
            相关资源
            最近更新 更多