340-lm.qmd

#  Линейная регрессия {#sec-lm}

Вы уже умеете считать коэффициент корреляции Пирсона:

```{r}
library(tidyverse)
library(Stat2Data)
data(Backpack)
back <- Backpack %>%
  mutate(backpack_kg = 0.45359237 * BackpackWeight,
         body_kg = 0.45359237 * BodyWeight)
cor.test(back$backpack_kg, back$body_kg)
```

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

```{r}
class(y ~ x)
```

Если видите эту волнистую линию - тильду (`~`), это значит, что перед вами формула. Мы уже сталкивались с формулами ранее, они иногда используются для задания отношений между переменными, например, для определения фасеток на графике (\@ref(gg_base)).

Давайте исследуем зависимость размера рюкзака от массы тела. В простой линейной регрессии, в отличие от корреляции, есть направленность: одна переменная является как бы независимой переменной или предиктором, другая - как бы объясняемой переменной (outcome). В формуле предикторы находятся справа от тильды, а объясняемая переменная - слева.

Я специально написал "как бы": если одна переменная предиктор, а другая объясняется этим предиктором, то кажется, что они должны быть обязательно связаны причинно-следственной связью. Это не так: обозначения условны, более того, вы можете поменять переменные местами и ничего не изменится! Короче говоря, линейная регрессия не дает никакой магической каузальной силы исследуемым переменным.

## Функция `lm()` {#sec-lm_func}

Давайте посчитаем линейную регрессию функцией `lm()`.

```{r}
model <- lm(backpack_kg ~ body_kg, data = back)
model
```

`print(model)` или просто `model` выводит коэфициенты линейной регрессии - это коэффициенты прямой, которая лучше всего подогнанна к данным. Как измеряется качество этой подгонки? В расстоянии точек исходных точек до прямой. По идее, расстояние до прямой нужно было бы считать просто по модулю. И так делают, хоть и очень редко. Обычно в линейной регрессии используются квадратичные расстояния точек до прямой для оценки расстояния (метод наименьших квадратов - ordinary least squares). Это дает кучу клевых математических свойств, например, возможность легко аналитически найти коэффициенты прямой линейной регрессии.

Давайте теперь нарисуем регрессионную прямую поверх диаграммы рассеяния:

```{r}
ggplot(data = back,aes(x = body_kg, y = backpack_kg))+
  geom_point(alpha = 0.3)+
  geom_abline(slope = model$coefficients[2], intercept = model$coefficients[1])
```

Функция `predict()` позволяет скормить модели новые данные и получить предсказания для новых значений предикторов. Попробуем поиграть с этим немного. Допустим, предскажем вес рюкзака для студента весом в 100 кг:

```{r}
predict(model, newdata = data.frame(body_kg = 100))
```

Мы можем даже попробовать какие-нибудь экстремальные значения для предикторов. Например, сколько будет весить рюкзак студента весом 1000 кг?

```{r}
predict(model, newdata = data.frame(body_kg = 1000))
```

Очевидно, что в этом не очень много смысла: студент весом 1000 кг не сможет ходить на занятия, поэтому и про вес рюкзака как-то не имеет смысл спрашивать. Это проблема экстрополяции: линейная регрессия позволяет более-менее достоверно предсказывать значения внутри диапазона значений, на которых была построена модель. Еще один "странный" пример - студент весом 0 кг.

```{r}
predict(model, newdata = data.frame(body_kg = 0))
```

Здесь бессмысленность происходящего еще очевиднее. Конечно, вес студента не может быть равен нулю, иначе это не студент вовсе. Однако это позволяет понять, что такое intercept модели - это значение зависимой переменой в случае, если предиктор равен нулю. А коэффициент предиктора означает, насколько килограммов увеличивается вес рюкзака при увеличении веса студента на 1 кг: на `r model$coefficients[2]`. Не очень много!

## Интерпретация вывода линейной регрессии {#sec-interpret_lm}

Гораздо более подробные результаты мы получим, если применим уже известную нам generic функцию `summary()` на нашу модель.

```{r}
summary(model)
```

Теперь мы понимаем, что это за коэффициенты. Однако это всего лишь их оценка. Это значит, что мы допускаем, что в реальности есть некие настоящие коэффициенты линейной регрессии, а каждый раз собирая новые данные, они будут посчитаны как немного разные. Короче говоря, эти коэффициенты - те же статистики, со своим выборочным распределением и стандартными ошибками. На основе чего и высчитывается p-value для каждого коэффициента - вероятность получить такой и более отклоняющийся от нуля коэффициент при верности нулевой гипотезы - независимости зависимой переменной от предиктора.

Кроме p-value, у линейной регрессии есть $R^2$ - доля объясненной дисперсии. Как ее посчитать? Для начала давайте сохраним как отдельные колонки ошибки (необъясненную часть модели) и предсказанные значения (они означают объясненную часть модели). Можно убедиться, что сумма предсказанных значений и ошибок будет равна зависимой переменной.

```{r}
head(model$residuals)
back$residuals <- residuals(model)
back$fitted <-  fitted(model)

back %>%
  transmute(backpack_kg - (fitted + residuals))
```

Соответственно, вся сумма объясненной дисперсии разделяется на объясненую и необъясненную. Полная дисперсия (total sum of squares = TSS) может быть посчитана как сумма квадратов разниц со средним. Необъясненная дисперсия - это сумма квадратов ошибок - residual sum of squares (RSS).

```{r}
rss <- sum(back$residuals^2)
rss
tss <- sum((back$backpack_kg - mean(back$backpack_kg))^2)
tss
1- rss/tss
```

Это очень мало, мы объяснили всего `r (1- rss/tss)*100`% дисперсии. Собственно, и *p-value* больше, чем $0.05$.

```{r}
summary(model)
```

При этом *p-value* тот же, что и при коэффициенте корреляции Пирсона. Это не случайно: $R^2$ - это квадрат коэффициента корреляции Пирсона, если речь идет только об одном предикторе. Давайте это проверим:

```{r}
cor.test(back$body_kg, back$backpack_kg)$estimate^2
```

## Допущения линейной регрессии {#sec-lm_a}

Как и в случае с другими параметрическими методами, линейная регрессия имеет определенные допущения относительно используемых данных. Если они не соблюдаются, то все наши расчеты уровня значимости могут некорректными.

> Очень важно ставить вопрос о том, насколько результаты будут некорректными. Как сильно нарушения допущений будет влиять на модель? Ответ на этот вопрос может быть контринтуитивен. Например, достаточно большие отклонения от нормальности нам обычно не страшны при условии того, что выборка достаточно большая.

Допущения линейной регрессии связаны с ошибками: они должны быть нормально распределены, а разброс ошибок должен не уменьшаться и не увеличиваться в зависимости от предсказанных значений. Это то, что называется гомоскедастичностью или гомогенностью (когда все хорошо) и гетероскедастичностью или гетерогенностью (когда все плохо).

Если мы применим функцию `plot()`, то получим 4 скаттерплота:

1.  *Зависимость ошибок от предсказанных значений.* На что здесь смотреть? На симметричность относительно нижней и верхней части графика, на то, что разброс примерно одинаковый слева и справа.

2.  *Q-Q plot.* Здесь все довольно просто: если ошибки являются выборкой из нормального распределения, то они выстраиваются в прямую линию. Если это мало похоже на прямую линию, то имеет место отклонение от нормальности.

3.  *Scale-Location plot.* Этот график очень похож на график 1, только по оси *у* используются квадратные корни модуля ошибки. Еще один способ исследовать гетеро(гомо)скедастичность и находить выбросы.

4.  *Residuals-Leverage plot.* Здесь по оси *х* - расстояние Кука, а по оси *у* - стандартизированный размер выбросов. Расстояние Кука показывает *high-leverage points* - точки, которые имеют экстремальные предсказанные значения, то есть очень большие или очень маленькие значения по предикторам. Для линейной регрессии такие значения имеют большее значение, чем экстремальные точки по предсказываемой переменной. Особенно сильное влияние имеют точки, которые имеют экстремальные значения и по предикторам, и по предсказываемой переменной. Одна такая точка может поменять направление регрессионной прямой! Расстояние Кука отражает уровень *leverage*, а стандартизированные ошибки отражают экстремальные значения по *у* (вернее, экстремальные отклонения от предсказанных значений). В этом графике нужно смотреть на точки с правой стороны графика, особенно если они находятся высоко или низко по оси *у*.

```{r}
plot(model)
```

## Влияние выбросов на линейную модель {#sec-outliers_lm}

Давайте теперь попробуем посмотреть, как изменится модель, если выкинуть ***high leverage points*** **(экстремальные значения по предиктору** - body) и что будет, если выкинуть экстремальные значения по у. Обычная линия - регрессионная прямая для модели со всеми точками, штрихованная линия - регрессионная прямая для модели без экстремальных значений по предиктору, пунктирная линия - регрессионная прямая для модели без экстремальных значений по предсказываемой переменной.

```{r}

is_outlier <- function(x, n = 2, centr = mean, vary = sd) {
  (x > centr(x) + n * vary(x)) | (x < centr(x) - n * vary(x))
}

back <- back %>%
  mutate(body_outlier = is_outlier(body_kg),
         backpack_outlier = is_outlier(backpack_kg))

model_without_outliers_by_x <- back %>%
  filter(!body_outlier) %>%
  lm(formula = backpack_kg ~ body_kg)
summary(model_without_outliers_by_x)

model_without_outliers_by_y <- back %>%
  filter(!backpack_outlier) %>%
  lm(formula = backpack_kg ~ body_kg)
summary(model_without_outliers_by_y)


ggplot(data = back, aes(x = body_kg, y = backpack_kg,
                        shape = body_outlier, colour = backpack_outlier))+
  geom_point(alpha = 0.3)+
  geom_abline(intercept = model$coefficients[1], slope = model$coefficients[2])+
  geom_abline(intercept= model_without_outliers_by_x$coefficients[1], 
              slope = model_without_outliers_by_x$coefficients[2], linetype = "dashed")+
  geom_abline(intercept= model_without_outliers_by_y$coefficients[1], 
              slope = model_without_outliers_by_y$coefficients[2], linetype = "dotted")+
  theme_minimal()
```

Таким образом, именно экстремальные значения по предиктору, а не по объяснияемой переменной имеют особенно сильное значение на регрессионную модель.

## Множественная линейная регрессия {#sec-lm_mult}

В множественной линейной регрессионной регрессии у нас появляется несколько предикторов. Какая модель лучше: где есть много предикторов или где мало предикторов? С одной стороны, чем больше предикторов, тем лучше: каждый новый предиктор может объяснить чуть больше необъясненной дисперсиии. С другой стороны, если эта прибавка маленькая (а она всегда будет не меньше нуля), то, возможно, новый предиктор просто объясняет "случайный шум". В действительности, если у нас будет достаточно много предикторов, то мы сможем объяснить любые данные! Парадоксальным образом такая модель будет давать очень хорошие результаты на той выборке, по которой мы считаем коэффициенты, но делать очень плохие предсказания на новой выборке - это то, что в машинном обучении называют **переобучением (*overfitting*).** Идеальная модель будет включать минимум предикторов, которые лучше всего объясненяют исследуемую переменную. Это что-то вроде [бритвы Оккама](https://ru.wikipedia.org/wiki/Бритва_Оккама) в статистике.

Поэтому часто используются показатели качества модели, которые "наказывают" модель за большое количество предикторов. Например, adjusted R^2^:

$$R_{adj} = 1 - (1 - R^2) \frac{n -1}{n - p - 1}$$

Здесь *n* - это количество наблюдений, *p* - количество параметров.

Итак, добавим новый предиктор - *Units*. Это количество кредитов, которые студенты взяли в четверти[^340-lm-1]. Можно предположить, что чем больше у студента набрано кредитов, тем более тяжелый у нее/него рюкзак. Давайте добавим это как второй предиктор. Для этого нужно просто записать второй предиктор в формуле через плюс.

[^340-lm-1]: Кредиты - это что-то вроде часов во многих зарубежных системах образования. Более "тяжелые" курсы дают больше кредитов. Студентам необходимо набрать определенное количество кредитов, чтобы закончить вуз.

```{r}
model_mult <- lm(backpack_kg ~ body_kg + Units, data = back)
summary(model_mult)
```

Множественная линейная регрессия имеет еще одно допущение: отсутствие мультиколлинеарности. Это значит, что предикторы не должны коррелировать друг с другом.

Для измерения мультколлинеарности существует *variance inflation factor* (*VIF-фактор*). Считается он просто: для предиктора $i$ считается линейная регрессия, где все остальные предикторы предсказывают предиктор $i$.

Сам VIF-фактор считается на основе полученного R^2^ регрессии:

$$VIF_i = \frac{1}{1 - R_i^2}$$

Если R~i~^2^ большой, то и VIF~i~ выходит большим. Это означает, что предиктор сам по себе хорошо объясняется другими предикторами. Какой VIF считать большим? Здесь нет единого мнения, но если он выше 3 и особенно если он выше 10, то с этим нужно что-то делать.

```{r}
car::vif(model_mult)
```

В нашем случае это не так. Но если бы VIF был большим для какого-либо предиктора, то можно было бы либо попробовать его выкинуть или же использовать анализ главных компонент (см. @sec-dim_red_pca), о котором пойдет речь в один из следующих дней.