Returning formula argument 'as is'-CodePudding

Suppose I have a function like this:

my_lm <- function(formula, data) {
  lm(formula, data)
}
my_lm(Sepal.Length ~ Sepal.Width, iris)

I'd LIKE it to return something like this:

Call:
lm(formula = Sepal.Length ~ Sepal.Width, data = iris)

Coefficients:
(Intercept)  Sepal.Width  
     6.5262      -0.2234

But instead, it returns this:

Call:
lm(formula = t, data = data)

Coefficients:
(Intercept)  Sepal.Width  
     6.5262      -0.2234

How do I make this happen? I'm assuming non-standard evaluation or environments are involved, but vague and hand-wavey is as good of an answer as I can provide.

CodePudding user response：

Maybe the easiest way to do this is to hack the relevant components of the $call element of the model. The formula is easy because formulas are already unevaluated/symbolic objects. To get the correct result for data you need substitute(data):

my_lm <- function(formula, data) {
  m <- lm(formula, data)
  m$call$formula <- formula
  m$call$data <- substitute(data)
  m
}
my_lm(Sepal.Length ~ Sepal.Width, iris)
## Call:
## lm(formula = Sepal.Length ~ Sepal.Width, data = iris)
## 
## Coefficients:
## (Intercept)  Sepal.Width  
##      6.5262      -0.2234

CodePudding user response：

We can just wrap the function body in eval(bquote()) and evaluate the formula early with .():

my_lm <- function(formula, data) {
  eval(bquote(lm(.(formula), data)))
}

my_lm(Sepal.Length ~ Sepal.Width, iris)
#> 
#> Call:
#> lm(formula = Sepal.Length ~ Sepal.Width, data = data)
#> 
#> Coefficients:
#> (Intercept)  Sepal.Width  
#>      6.5262      -0.2234

^{Created on 2022-10-01 by the reprex package (v0.3.0)}