以编程方式构建公式而不使用字符串

时间:2015-04-17 04:05:31

标签: r string

为了举例,请考虑R中的基本回归模型:

form1 <- Petal.Length ~ Sepal.Length + Sepal.Width
fit1 <- lm(form1, iris)

(我向在此发帖的任何植物学家致歉。)

为了添加二次和交互项,我知道三种方法:

1)老式的方式

一次输入一个条款:

form2 <- . ~ Sepal.Length*Sepal.Width + I(Sepal.Length^2) + I(Sepal.Width^2)
fit2 <- update(fit1, form2)

这不会扩展到小公式之外,你不能用它编程。

2)丑陋的方式

字符串操作:

vars <- attr(terms(form1), "term.labels")
squared_terms <- sprintf("I(%s^2)", vars)
inter_terms <- combn(vars, 2, paste, collapse = "*")
form2 <- reformulate(c(inter_terms, squared_terms), ".")

这可以扩展,但它并不是真正可编程的,因为函数本身需要进行硬编码。

3)&#34;后门&#34;

直接处理数据

library(lazyeval)
library(dplyr)

square <- function (v) interp(~ I(v1^2), v1 = as.name(v))
inter <- function(v) interp(~ v1*v2, v1 = as.name(v[1]), v2 = as.name(v[2]))

vars <- attr(terms(form1), "term.labels")
squared_terms <- lapply(vars, square) %>%
  set_names(paste0(vars, " ^2"))
inter_terms <- combn(vars, 2, inter, simplify = FALSE) %>%
  set_names(combn(vars, 2, paste, collapse = " x "))

fit2 <- model.frame(fit1) %>%
  mutate_(.dots = squared_terms) %>%
  mutate_(.dots = inter_terms) %>%
  lm(Petal.Length ~ ., data = .)

这是相当可扩展的,可编程到可变命名。但它也有点疯狂,因为它首先违背了使用formula的目的。

我希望我能做什么

我希望我能做到这样的事情:

library(lazyeval)
library(dplyr)

square <- function (v) interp(~ I(v1^2), v1 = as.name(v))
inter <- function(v) interp(~ v1*v2, v1 = as.name(v[1]), v2 = as.name(v[2]))

squared_terms <- apply.formula(form1, squared_terms)
inter_terms <- combn.formula(form1, 2, inter)

fit2 <- form1 %>%
  append.formula(squared_terms) %>%
  append.formula(inter_terms) %>%
  update(fit1, .)

除了dplyr之外,这里有两个杀手锏:

  1. 以编程方式从基本R对象生成任意公式术语的能力
  2. 能够将术语添加到公式中,该公式的行为类似于手动输入的术语
  3. 特征1可以通过方法3获得,特征2可以通过方法2获得。是否有方法4 - 中间路径 - 同时获得两者?

1 个答案:

答案 0 :(得分:8)

好的,这里有很多动人的作品,但这里有一些辅助功能,非常具体的东西

extract_rhs_symbols <- function(x) {
    as.list(attr(delete.response(terms(x)), "variables"))[-1]
}
symbols_to_formula <- function(x) {
    as.call(list(quote(`~`), x))    
}
sum_symbols <- function(...) {
    Reduce(function(a,b) bquote(.(a)+.(b)), do.call(`c`, list(...), quote=T))
}
square_terms <- function(x) {
    symbols_to_formula(sum_symbols(sapply(extract_rhs_symbols(x), function(x) bquote(I(.(x)^2)))))
}
interact_rhs<-function(x) {
    x[[length(as.list(x))]] <- bquote((.(x[[length(as.list(x))]]))^2)
    x
}
add_rhs_dot <- function(x) {
   x[[length(as.list(x))]] <- sum_symbols(quote(.), x[[length(as.list(x))]])    
   x
}
add_terms<-function(f, x) {
    update(f, add_rhs_dot(x))
}

所有这些基本上都将公式操作为调用。

所以,如果你有像

这样的公式
my.formula <- Petal.Length ~ Sepal.Length + Sepal.Width + Other

您可以使用

添加平方术语
add_terms(my.formula, square_terms(my.formula))

您可以与

进行所有右手互动
interact_rhs(my.formula)

或用

做两件事
add_terms(interact_rhs(my.formula), square_terms(my.formula))

给出了

Petal.Length ~ Sepal.Length + Sepal.Width + Other + I(Sepal.Length^2) + 
    I(Sepal.Width^2) + I(Other^2) + Sepal.Length:Sepal.Width + 
    Sepal.Length:Other + Sepal.Width:Other

我还没有对此进行过彻底的测试,因此可能存在这种情况发生故障的情况,但它应该适用于大多数简单的情况。