r - 用公式引用 hell

Question

我有一个需要重复执行的任务，因此我尝试为其编写一个函数。我的函数几乎完成了，除了一个缺陷:我无法将公式作为参数传递，除非它是字符串的形式。

library(lme4)
library(lazyeval)

get_pvals_qrhs <- function(df, cols, qrhs) {
    cols <- substitute(cols)
    col_pos <- setNames(as.list(seq_along(df)), names(df))
    pos <- eval(cols, col_pos)
    formulas <- lapply(pos, function(x) formula(paste(colnames(df[x]), "~", qrhs)))
    models <- lapply(formulas, lmer, data=df, REML=FALSE)
    tvals <- lapply(models, function(x) data.frame(coef(summary(x)))[c(2), ]$t.value)
    pvals <- lapply(tvals, function(x) { 2 * (1 - pnorm(abs(x))) })
    return(unlist(pvals))
}

works <- get_pvals_qrhs(iris, Sepal.Length:Sepal.Width, "Species + (1 + Petal.Length | Petal.Width)")
works

get_pvals_rhs <- function(df, cols, rhs) {
    cols <- substitute(cols)
    col_pos <- setNames(as.list(seq_along(df)), names(df))
    pos <- eval(cols, col_pos)
    formulas <- lapply(pos, function(x) formula(paste(colnames(df[x]), "~", quote(rhs))))
    models <- lapply(formulas, function(x) lmer, data=df, REML=FALSE)
    tvals <- lapply(models, function(x) data.frame(coef(summary(x)))[c(2), ]$t.value)
    pvals <- lapply(tvals, function(x) { 2 * (1 - pnorm(abs(x))) })
    return(unlist(pvals))
}

fails <- get_pvals_rhs(iris, Sepal.Length:Sepal.Width, Species + (1 + Petal.Length | Petal.Width))
fails

无论我对rhs做什么formulas <- ... 中的术语在第二个函数中的行中，我无法获得从第一个函数中获得的结果。我做错了什么？

Answer 1

您需要替换以获取表达式，然后您可以对其进行解析以将其转换为字符串

get_pvals_rhs <- function(df, cols, rhs) {
  cols <- substitute(cols)
  rhs <- deparse(substitute(rhs))
  col_pos <- setNames(as.list(seq_along(df)), names(df))
  pos <- eval(cols, col_pos)
  formulas <- lapply(pos, function(x) formula(paste(colnames(df[x]), "~", rhs)))
  models <- lapply(formulas, lmer, data=df, REML=FALSE)
  tvals <- lapply(models, function(x) data.frame(coef(summary(x)))[c(2), ]$t.value)
  pvals <- lapply(tvals, function(x) { 2 * (1 - pnorm(abs(x))) })
  return(unlist(pvals))
}

并进行了测试

get_pvals_rhs(iris, Sepal.Length:Sepal.Width, Species + (1 + Petal.Length | Petal.Width))

但实际上，在使用公式部分时，通常最好总是在它们前面加上 ~ 前缀，这样您就不必 substitute() 并且可以使用函数像 update() 一样可以更轻松地更改公式。更像是

get_pvals_rhs <- function(df, cols, rhs) {
  cols <- substitute(cols)
  col_pos <- setNames(as.list(seq_along(df)), names(df))
  pos <- eval(cols, col_pos)
  formulas <- lapply(colnames(df[pos]), function(x) update(rhs, reformulate(".", x)))
  models <- lapply(formulas, lmer, data=df, REML=FALSE)
  tvals <- lapply(models, function(x) data.frame(coef(summary(x)))[c(2), ]$t.value)
  pvals <- lapply(tvals, function(x) { 2 * (1 - pnorm(abs(x))) })
  return(unlist(pvals))
}
get_pvals_rhs(iris, Sepal.Length:Sepal.Width, ~ Species + (1 + Petal.Length | Petal.Width))