Удаление смещения из формулы

R имеет удобный инструмент для манипулирования формулами, update.formula(). Это хорошо работает, если вы хотите получить что-то вроде "формулы, содержащей все термины в предыдущей формуле, кроме x", например.

f1 <- z ~ a + b + c
(f2 <- update.formula(f1, . ~ . - c))
## z ~ a + b

Однако, похоже, это не работает со смещением:

f3 <- z ~ a + offset(b) 
update(f3, . ~ . - offset(b))
## z ~ a + offset(b)

Я откопал до terms.formula, который ?update.formula ссылается:

[после подстановки,...] Результат затем упрощается через "terms.formula(simplify = TRUE).

terms.formula(z ~ a + offset(b) - offset(b), simplify=TRUE)
## z ~ a + offset(b)

(т.е. это, кажется, не удаляет offset(b)...)

Я знаю, что могу взломать решение, используя deparse() и текстовую обработку, или обработкой формулы рекурсивно, чтобы удалить термин, который я не хочу, но эти решения являются уродливыми и/или раздражающими для реализации. Либо просвещение о том, почему это не работает, либо разумно компактное решение, было бы здорово...

Ответ 1

1) Рекурсия Рекурсивно спуститесь через формулу, заменив offset(...) на offset, а затем удалите offset с помощью update. Никакой манипуляции с строкой не выполняется, и хотя для этого требуется несколько строк кода, он все еще довольно короткий и удаляет одиночные и множественные термины offset.

Если есть несколько смещений, можно сохранить некоторые из них, установив preserve так, например, если preserve = 2, то второе смещение сохраняется и любые другие удаляются. Значение по умолчанию - сохранить его, т.е. Удалить все.

no.offset <- function(x, preserve = NULL) {
  k <- 0
  proc <- function(x) {
    if (length(x) == 1) return(x)
    if (x[[1]] == as.name("offset") && !((k<<-k+1) %in% preserve)) return(x[[1]])
    replace(x, -1, lapply(x[-1], proc))
  }
  update(proc(x), . ~ . - offset)
}

# tests

no.offset(z ~ a + offset(b))
## z ~ a

no.offset(z ~ a + offset(b) + offset(c))
## z ~ a

Обратите внимание: если вам не нужен аргумент preserve, тогда строка инициализация k может быть опущена, а if упрощена до:
if (x[[1]] == as.name("offset")) return(x[[1]])

2) термины, это не использует прямую манипуляцию напрямую или рекурсию. Сначала получите объект terms, запишите его атрибут offset и исправьте его, используя fixFormulaObject, который мы извлекаем из кишок terms.formula. Это можно сделать немного менее хрупким, скопировав исходный код fixFormulaObject в ваш источник и удалив строку eval ниже. preserve действует как в (1).

no.offset2 <- function(x, preserve = NULL) {
  tt <- terms(x)
  attr(tt, "offset") <- if (length(preserve)) attr(tt, "offset")[preserve]
  eval(body(terms.formula)[[2]]) # extract fixFormulaObject
  f <- fixFormulaObject(tt)
  environment(f) <- environment(x)
  f
}

# tests

no.offset2(z ~ a + offset(b))
## z ~ a

no.offset2(z ~ a + offset(b) + offset(c))
## z ~ a

Обратите внимание: если вам не нужен аргумент preserve, то строка, которая zaps атрибут offset может быть упрощен до:
attr(tt, "offset") <- NULL

Ответ 2

Это похоже на дизайн. Но простым обходным решением является

offset2 = offset
f3 <- z ~ a + offset2(b) 
update(f3, . ~ . - offset2(b))
# z ~ a

Если вам нужна гибкость для принятия формул, которые включают offset(), например, если формула предоставлена пользователем пакета, который может не знать о необходимости использовать offset2 вместо offset, тогда мы должен также добавить строку для изменения любых экземпляров offset() во входящей формуле:

f3 <- z ~ a + offset(b) 

f4 <- as.formula(gsub("offset\\(", "offset2(", deparse(f3)))
f4 <- update(f4, . ~ . - offset2(b))

# finally, just in case there are any references to offset2 remaining, we should revert them back to offset
f4 <- as.formula(gsub("offset2\\(", "offset(", deparse(f4)))
# z ~ a