假设我想写anscombe %>% lm_tidy("x1", "y1")(实际上，我想写anscombe %>% lm_tidy(x1, y1)，其中x1和y1是数据帧的一部分)． 因此，下面的函数似乎可以工作:
plot_gg <- function(df, x, y) {
x <- enquo(x)
y <- enquo(y)
ggplot(df, aes(x = !!x, y = !!y)) + geom_point() +
geom_smooth(formula = y ~ x, method="lm", se = FALSE)
}
我开始写下面的函数:
lm_tidy_1 <- function(df, x, y) {
x <- enquo(x)
y <- enquo(y)
fm <- y ~ x ##### I tried many stuff here!
lm(fm, data=df)
}
## Error in model.frame.default(formula = fm, data = df, drop.unused.levels = TRUE) :
## object is not a matrix
将列名作为参数传递的注释指出，embrace {{...}}是引号-反引号模式的速记符号。不幸的是，两种情况下的错误消息是不同的:
lm_tidy_2 <- function(df, x, y) {
fm <- !!enquo(y) ~ !!enquo(x) # alternative: {{y}} ~ {{x}} with different errors!!
lm(fm, data=df)
}
## Error:
## ! Quosures can only be unquoted within a quasiquotation context.
这似乎工作(基于@jubas的回答，但我们坚持字符串处理和paste):
lm_tidy_str <- function(df, x, y) {
fm <- formula(paste({{y}}, "~", {{x}}))
lm(fm, data=df)
}
再次，{{y}} != !!enquo(y)。但更糟糕的是:下面的函数崩溃了，出现了与前面相同的Quosure错误:
lm_tidy_str_1 <- function(df, x, y) {
x <- enquo(x)
y <- enquo(y)
fm <- formula(paste(!!y, "~", !!x))
lm(fm, data=df)
}
- 是
{{y}} != !!enquo(y)? 如何将数据变量传递给
lm?编辑:抱歉，这是我试了很多次后剩下的。我想直接将数据变量(说x1和y1)传递给将要使用它们作为公式组件(如lm)而不是它们的字符串版本("x1"和"y1")的函数:我尽量避免字符串尽可能长，从用户的角度来看它更精简。
@BiranSzydek的回答非常好。然而，它有3个缺点:
Call:
lm(formula = fm, data = .)
- 看不到公式，也看不到实际使用的数据。
- 必须以字符串形式输入符号。
- 来自
rlang的依赖——尽管它是一个很棒的包。
你确实可以用纯R来解决这个问题!
纯碱溶液R
R实际上是一个Lisp。它适用于这样的元编程任务。R语言唯一的缺点是它可怕的语法。特别是在面对元编程时，它不像Lisp语言那样漂亮和优雅。语法确实会让人很困惑——当你自己尝试解决这个问题时就会遇到这种情况。
解决方案是使用substitute()，通过它您可以以引用的方式替换代码片段:
lm_tidy <- function(df, x, y) {
# take the arguments as code pieces instead to evaluate them:
.x <- substitute(x)
.y <- substitute(y)
.df <- substitute(df)
# take the code piece `y ~ x` and substitute using list lookup table
.fm <- substitute(y ~ x, list(y=.y, x=.x))
# take the code `lm(fm, data=df)` and substitute with the code pieceses defined by the lookup table
# by replacing them by the code pieces stored in `.fm` and `.df`
# and finally: evaluate the substituted code in the parent environment (the environment where the function was called!)
eval.parent(substitute(lm(fm, data=df), list(fm=.fm, df=.df)))
}
技巧是使用eval.parent(substitute( <your expression>, <a list which determines the evaluation lookup-table for the variables in your expression>))。
小心作用域!只要<your expression>只使用在函数内部定义的变量或在给substitute()的查找列表中定义的变量来构造，就不会有任何作用域问题!但是要避免引用<your expression>中的任何其他变量!-所以这是你在这种情况下安全使用eval()/eval.parent()必须遵守的唯一规则!但即使，eval.parent()注意到，替换的代码在调用该函数的环境中执行。
现在，你可以做:
lm_tidy(mtcars, cyl, mpg)
输出现在是所需的:
Call:
lm(formula = mpg ~ cyl, data = mtcars)
Coefficients:
(Intercept) cyl
37.885 -2.876
我们用纯R做过!
安全使用eval()的技巧实际上是substitute()表达式中的每个变量都是在substitute()或函数参数的查找表中定义/给出的。换句话说:所有被替换的变量都不会引用函数定义之外的悬垂变量。
plot_gg函数
因此，遵循这些规则，您的plot_gg函数将定义为:
plot_gg <- function(df, x, y) {
.x <- substitute(x)
.y <- substitute(y)
.df <- substitute(df)
.fm <- substitute( y ~ x, list(x=.x, y=.y))
eval.parent(substitute(
ggplot(df, aes(x=x, y=y)) + geom_point() +
geom_smooth(formula = fm, method="lm", se=FALSE),
list(fm=.fm, x=.x, y=.y, df=.df)
))
}
当您想将x和y作为字符串输入时
lm_tidy_str <- function(df, x, y) {
.x <- as.name(x)
.y <- as.name(y)
.df <- substitute(df)
.fm <- substitute(y ~ x, list(y=.y, x=.x))
eval.parent(substitute(lm(fm, data=df), list(fm=.fm, df=.df)))
}
plot_gg_str <- function(df, x, y) {
.x <- as.name(x)
.y <- as.name(y)
.df <- substitute(df)
.fm <- substitute( y ~ x, list(x=.x, y=.y))
eval.parent(substitute(
ggplot(df, aes(x=x, y=y)) + geom_point() +
geom_smooth(formula = fm, method="lm", se=FALSE),
list(fm=.fm, x=.x, y=.y, df=.df)
))
}
lm_tidy_str(mtcars, "cyl", "mpg")
# Call:
# lm(formula = mpg ~ cyl, data = mtcars)
#
# Coefficients:
# (Intercept) cyl
# 37.885 -2.876
#
require(ggplot2)
plot_gg_str(mtcars, "cyl", "mpg")
考虑:
lm_tidy_1 <- function(df, x, y) {
fm <- reformulate(as.character(substitute(x)), substitute(y))
lm(fm, data=df)
}
lm_tidy_1(iris, Species, Sepal.Length)
lm_tidy_1(iris, 'Species', Sepal.Length)
lm_tidy_1(iris, Species, 'Sepal.Length')
lm_tidy_1(iris, 'Species', 'Sepal.Length')
如果需要显示公式，请更改调用对象:
lm_tidy_1 <- function(df, x, y) {
fm <- reformulate(as.character(substitute(x)), substitute(y))
res<-lm(fm, data=df)
res$call[[2]]<- fm
res
}
lm_tidy_1(iris, Species, Sepal.Length)
Call:
lm(formula = Sepal.Length ~ Species, data = df)
Coefficients:
(Intercept) Speciesversicolor Speciesvirginica
5.006 0.930 1.582
用"expr，"然后求值
library(dplyr)
lm_tidy <- function(df, x, y) {
x <- sym(x)
y <- sym(y)
fm <- expr(!!y ~ !!x)
lm(fm, data = df)
}
这个函数等价:
lm_tidy <- function(df, x, y) {
fm <- expr(!!sym(y) ~ !!sym(x))
lm(fm, data = df)
}
然后
lm_tidy(mtcars, "cyl", "mpg")
为
Call:
lm(formula = fm, data = .)
Coefficients:
(Intercept) cyl
37.885 -2.876
编辑下面的评论:
library(rlang)
lm_tidy_quo <- function(df, x, y){
y <- enquo(y)
x <- enquo(x)
fm <- paste(quo_text(y), "~", quo_text(x))
lm(fm, data = df)
}
你可以传递符号作为参数
lm_tidy_quo(mtcars, cyl, mpg)
我是这样用的:
fm <- as.formula(paste0(y, ' ~ ', x))
lm(fm, data=df)
:
?as.formula