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

Question

我可以构建一个公式，从公式中术语的字符版本开始，我想要做什么，但我在从公式对象开始时遇到了困难：

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) 方法，但我非常喜欢看到lapply (RHS_form, somefunc)一个polyize（或者可能是polymer？）函数的版本。

Answer 1

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

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)