如何用函数包装公式的 RHS 项答案

【问题标题】：How to wrap RHS terms of a formula with a function如何用函数包装公式的 RHS 项
【发布时间】：2016-03-06 16:39:27
【问题描述】：

我可以构造一个公式，从公式中术语的字符版本开始执行我想要的操作，但我在从公式对象开始时遇到了困难：

form1 <- Y ~ A + B 
form1[-c(1,2)][[1]]
#A + B

现在如何构建一个如下所示的公式对象：

 Y ~ poly(A, 2) + poly(B, 2) + poly(C, 2)

或者：

 Y ~ pspline(A, 4) + pspline(B, 4) + pspline(C, 4)

似乎它可能涉及沿 RHS 的递归遍历，但我没有取得进展。我突然想到我可能会使用

> attr( terms(form1), "term.labels")
[1] "A" "B"

然后使用as.formula(character-expr) 方法，但我很抱歉看到polyize（或者可能是polymer？）函数的lapply (RHS_form, somefunc) 版本。

【问题讨论】：

标签： r formula

【解决方案1】：

如果我借用我最初写的here 的一些函数，你可以做这样的事情。首先，辅助函数...

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))
}
transform_terms <- function(x, f) {
    symbols_to_formula(sum_symbols(sapply(extract_rhs_symbols(x), function(x) do.call("substitute",list(f, list(x=x))))))
}

然后你就可以使用了

update(form1, transform_terms(form1, quote(poly(x, 2))))
# Y ~ poly(A, 2) + poly(B, 2)

update(form1, transform_terms(form1, quote(pspline(x, 4))))
# Y ~ pspline(A, 4) + pspline(B, 4)

【讨论】：

我特别喜欢这个，因为它也可以用来自动改装模型。

【解决方案2】：

有一个formula.tools 包，它提供了用于处理公式的各种实用函数。

f <- y ~ a + b
rhs(f)                        # a + b
x <- get.vars(rhs(f))         # "a" "b"
r <- paste(sprintf("poly(%s, 4)", x), collapse=" + ")  # "poly(a, 4) + poly(b, 4)"
rhs(f) <- parse(text=r)[[1]]
f                             # y ~ poly(a, 4) + poly(b, 4)

【讨论】：

+1。欣赏指向包的指针。不过，文本操作是我试图避免的。