Трансплантация коэффициентов уравнения линейной регрессии от одной модели другой, в R Опции

[ИНО]

Задача в том, чтобы обучить модель линейной регрессии (см. тему соседнюю) на одних данных, а потом применить к другим, при этом не меняя коэффициентов. Извлечь коэффициенты из объекта класса "lm" легко, но как правильно передать другой модели? С некоторым удивлением не обнаружил в синтаксисе функции lm() возможности задачи пользовательских коэффициентов для каждого члена уравнения. На буржуйских формах что-то пишут о применении служебной функции offset(), но я так и не понял как ее запрограммировать в случае множественной регрессии со взаимодействиями категориальных переменных с числовыми. Поэтому возникла идея тупой "пересадки органов". Логика подсказывает, что помимо $coefficients требуется пересадить еще и $fitted.values (в моем случае все наблюдения во модели-реципиенте являются подмножеством наблюдений на которых построена модель-донор, так что можно просто выкинуть лишние значения). Если бы это было не так, можно было бы подогнать новые, применив к модели-донору функцию predict() с наблюдениями, используемыми в модели-реципиенте, в качестве аргумента newdata. Далее следует поменять остатки ($residuals). Их можно не пересаживать, а вычислить, вычтя пересаженные $fitted.values из родных для реципиента $model$имя_зависимой_переменной. Достаточно ли перечисленных операций для того, чтобы модель-реципиент стала вести себя так, будто была построена на априорно заданных коэффициентах в таких задачах как построение доверительных интервалов, вычисление F-статистики и R2? Или надо пересаживать что-то еще? Просто внутри объекта "lm", помимо вышеназванного, напихано много всякого, что недоступно моему разумению. Быть может, без редактирования чего-нибудь из этого в дополнение к проделанным трансплантациям органов, чье назначение мне ясно, организм донора будет функционировать не совcем правильно, выдавая вместо ожидаемых от него результатов погоду на Луне?

Сообщение отредактировал ИНО - 28.04.2025 - 19:05

[ИНО]

Да, проблема именно в конкретной реализации. Окзалось, что нельзя вот-так просто вставить в готовую функцию пользовательские коэффициенты, и заставить программу посчитать статистики по остаткам. Просто не предусмотрены такие аргументы. В случае простой линейной регрессии, конечно, несложно свой код написать, или даже в электронной таблице посчитать, но вот если предикторов много, уже сложнее. По крайней мере для меня. Да еще и хочется, чтобы все другие функции для работы с объектами класса "lm", работали коорректно.

ИМХО в случае с lm трансплантация - рабочий лайфхак. Даже если у нас нет донора, можно вырастить органы in vitro! Вот алгоритм:
1. Строим модель обычным образом.
2. Редактируем в полученном объекте $coefficients на свой вкус, не трогая имен перменных.
3. Делаем predict(отредактированная_модель) и заменяем его выдачей значения $fitted.values.
4. Заменяем значения $residuals на разность $model$имя_зависимой_переменной - $fitted.values (замененные ранее).

Вроде бы, это все, что требуется для корректной работы summary() на перепрошитой модели. Осталось разобраться, то за зверь $effects, и кто к нему обращается при вызове.

Но это все касалось функции lm() и ее порождений.

А вот в lm_robust из пакета estimatr все иначе, я даже не смог найти, где там хранится инфа об остатках либо о значениях зависимой переменной. Кажется, вообще не хранится, зато хранится готовый список всех возможных статистик. Такой объект вышеописанным способом не хакнешь.

[comisora]

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

Я предположил, что функция nls для Вас может подойти лучше, так как присутствует ручная установка коэффициентов. Попробовал смастерить (правда для lm) эквивалентные реализации, можете ознакомиться.

CODE

testdata <- data.frame(
group = factor(
c(rep("A", 7), rep("B", 6))
),
time = c(
15, 17, 18, 19, 20, 21, 22,
15, 18, 19, 20, 21, 22
),
response=c(
1.078, 0.949, 0.793, -2.201, -1.181, -1.95, -2.391,
2.628, 2.525, 2.852, 2.811, 3.484, 2.206
)
)

fit <- lm(response~I(time^2):group,
data = testdata)

fit1 <- fit
fit1$coefficients <- c(1, 2, 3)
fit1$fitted.values <- predict(fit1)
fit1$residuals <- fit$fitted.values-fit1$fitted.values

fit2 <- lm(
response ~ -1 +
offset(I(rep(1, 13))) +
offset(
I(
ifelse(group == 'A', I(time^2)*2, 0)
)
) +
offset(
I(
ifelse(group == 'B', I(time^2)*3, 0)
)
)
,
data = testdata
)

fit3 <- nls(
response ~ c +
ifelse(group == 'A', I(time^2)*a, 0) +
ifelse(group == 'B', I(time^2)*b, 0),
start = list(c = 1, a = 2, b = 3),
lower = list(b = 1, a = 2, b = 3),
upper = list(b = 1, a = 2, b = 3),
data = testdata, algorithm = 'port'
)

rsq <- function(actual, predicted) {
ss_total <- sum((actual - mean(actual)) ^ 2)
ss_residual <- sum((actual - predicted) ^ 2)
r_squared <- 1 - (ss_residual / ss_total)

return(r_squared)
}

Также бегло посмотрел stackoverflow по схожим вопросам. все упирается в умение решать задачи по (не)линейному программированию, самому писать функции и т.д., что неудивительно.