Как совместить линейную модель с пошаговой функцией - PullRequest
0 голосов
/ 28 февраля 2019

Предположим, у нас есть эти данные:

library(tidyverse)
library(modelr)

set.seed(42)
d1 <- tibble(x =  0:49, y = 5*x  + rnorm(n = 50))
d2 <- tibble(x = 50:99, y = 10*x + rnorm(n = 50))
data <- rbind(d1, d2)   
ggplot(data, aes(x, y)) +
  geom_point()

enter image description here

Как вписать эти данные?

Что я пробовал:

Линейная модель

m1 <- lm(y ~ x, data = data)
data %>%
  add_predictions(m1) %>%
  gather(key = cat, value = y, -x) %>%
  ggplot(aes(x, y, color = cat)) +
  geom_point()

enter image description here

Шаговая функция



# step model
m2 <- lm(y ~ cut(x, 2), data = data)
data %>%
  add_predictions(m2) %>%
  gather(key = cat, value = y, -x) %>%
  ggplot(aes(x, y, color = cat)) +
  geom_point()

enter image description here

Как объединить оба?

1 Ответ

0 голосов
/ 28 февраля 2019

Математически ваша модель принимает форму

    { a_0 + a_1 x  when x < 50
y = {
    { b_0 + b_1 x when x >= 50

Вы можете комбинировать это с функциями индикатора, чтобы получить форму в уравнении из одной строки:

y = a_0 + (b_0 - a_0) * 1[x >= 50] + a_1 * x + (b_1 - a_1) * x * 1[x >= 50] + error

Упрощение, мыможно написать так:

y = c_0 + c_1 * x + c_2 * z + c_3 * x * z + error

Где я пишу z = 1[x >= 50], чтобы подчеркнуть, что эта индикаторная функция - просто еще один регрессор

В R мы можем подобрать это как

lm(y ~ x * I(x >= 50), data = data)

Где * будет полностью взаимодействовать x и 1[x >= 50] по желанию.

with(data, {
  plot(x, y)
  reg = lm(y ~ x * I(x >= 50))

  lines(x, predict(reg, data.frame(x)))
})

enter image description here

Если вы неНе знаю, что скачок происходит в 50, дорога широко открыта, но вы можете, например, сравнить среднеквадратические ошибки:

x_range = 1:100
errs = sapply(x_range, function(BREAK) {
  mean(lm(y ~ x * I(x >= BREAK), data = data)$residuals^2)
})
plot(x_range, errs)
x_min = x_range[which.min(errs)]
axis(side = 1L, at = x_min)
abline(v = x_min, col = 'red')

enter image description here

...