Как обернуть RHS-термины формулы функцией

Я могу построить формулу, которая делает то, что я хочу, начиная с символьных версий терминов в формуле, но я спотыкаюсь, начиная с объекта формулы:

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

Теперь, как создать объект формулы, который выглядит так:

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

Or:

 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?).


r formula
person IRTFM    schedule 06.03.2016    source источник

Ответы (2)


arrow_upward
4
arrow_downward

Если я заимствую некоторые функции, которые я изначально написал здесь, вы можете сделать что-то вроде этого. Во-первых, вспомогательные функции...

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)
person MrFlick    schedule 06.03.2016
comment
Мне это особенно нравится, потому что его также можно использовать для автоматической переделки модели. - person IRTFM; 07.03.2016

arrow_upward
4
arrow_downward

Существует пакет 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)
person Hong Ooi    schedule 06.03.2016
comment
+1. Оцените указатель на пакет. Однако манипуляций с текстом я старался избегать. - person IRTFM; 07.03.2016