Вы сможете
- Подобрать модель множественной линейной регрессии
- Протестировать ее статистическую значимость и валидность
Фрагментация лесных местообитаний - одна из важнейших проблем Австралии. От каких характеристик лесного участка зависит обилие птиц во фрагментированных лесных массивах? (Loyn, 1987)
Mystic Forest - Warburton, Victoria by ¡kuba! on flickr
56 лесных участков:
Пример из кн. Quinn, Keugh, 2002, данные из Loyn, 1987)
bird <- read.csv("data/loyn.csv")
Все ли правильно открылось?
str(bird)
## 'data.frame': 56 obs. of 7 variables: ## $ ABUND : num 5.3 2 1.5 17.1 13.8 14.1 3.8 2.2 3.3 3 ... ## $ AREA : num 0.1 0.5 0.5 1 1 1 1 1 1 1 ... ## $ YRISOL: int 1968 1920 1900 1966 1918 1965 1955 1920 1965 1900 ... ## $ DIST : int 39 234 104 66 246 234 467 284 156 311 ... ## $ LDIST : int 39 234 311 66 246 285 467 1829 156 571 ... ## $ GRAZE : int 2 5 5 3 5 3 5 5 4 5 ... ## $ ALT : int 160 60 140 160 140 130 90 60 130 130 ...
Есть ли пропущенные значения?
colSums(is.na(bird))
## ABUND AREA YRISOL DIST LDIST GRAZE ALT ## 0 0 0 0 0 0 0
cor(bird)
## ABUND AREA YRISOL DIST LDIST GRAZE ALT ## ABUND 1.0000 0.25597 0.50336 0.236 0.0872 -0.683 0.386 ## AREA 0.2560 1.00000 -0.00149 0.108 0.0346 -0.310 0.388 ## YRISOL 0.5034 -0.00149 1.00000 0.113 -0.0833 -0.636 0.233 ## DIST 0.2361 0.10834 0.11322 1.000 0.3172 -0.256 -0.110 ## LDIST 0.0872 0.03458 -0.08332 0.317 1.0000 -0.028 -0.306 ## GRAZE -0.6825 -0.31040 -0.63557 -0.256 -0.0280 1.000 -0.407 ## ALT 0.3858 0.38775 0.23272 -0.110 -0.3060 -0.407 1.000
\[y_i = b_0 + b_1x_{1i} + b_2x_{2i} + b_3x_{3i} + ... + b_{p - 1}x_{p - 1\;i} + e_i\]
\[y_i = b_0 + b_1x_{1i} + b_2x_{2i} + b_3x_{3i} + ... + b_{p - 1}x_{p - 1\;i} + \varepsilon_i\]
Плоскость в n-мерном пространстве, оси которого образованы значениями предикторов
Аналитик, строящий модель, должен быть уверен в том,
что он не построит колосса на глиняных ногах.
Главный принцип — “garbage in, garbage out”.
Сбор данных часто проходит по принципу “ДДПР” (“Давай-давай, потом разберемся”), аналитик может не знать подводных камней сбора материала, но он должен их выявить.
Данные могут не отвечать многочисленным ограничениям регрессионного анализа.
Характер данных и связей между ними может требовать доработки данных (преобразования, стандартизации и т.п.).
Но! Самое главное гипотеза должна быть сформулирована до начала анализа, точнее, до начала сбора материала.
Часть осмысления данных необходимо провести до построения модели (разведочный анализ).
Часть — после того как модель построена (анализ валидности модели).
Давайте подробнее рассмотрим тактику анализа данных.
Прежде всего, нужно осмыслить дизайн сбора материала, чтобы понять являются ли отдельные наблюдения взаимно-независимыми.
Нужно проверить, нет ли отскакивающих значений.
Такие значения иногда могут быть следствием ошибки в исходных данных.
Простая линейная регрессия часто не подходит для моделирования некоторых величин (например для счетных данных).
Связь между откликом и предикторами может выглядеть нелинейной.
Если выявляются нелинейные зависимости, то нужно правильно выбрать тип модели.
Не все зависимости можно моделировать с помощью простых регрессионных моделей.
Нужно проверить, нет ли взаимозависимости (коллинеарности) между предикторами.
О том, почему это важно и как это проверять, поговорим позже.
Строим модель, соответствующую нашей гипотезе.
Для моделей с нормальным распределением отклика:
Если нарушений условий применимости не выявлено, то можно начать осмыслять результаты построения модели.
Если выявлены нарушения условий применимости, то надо задуматься о том, верно ли подобран тип модели и все ли хорошо с данными. Возвращаемся к пункту 1.
library(car) pairs(bird)
Большая часть значений AREA, DIST, LDISТ сгруппирована в начале области определения. Связь между AREA и откликом выглядит нелинейной. Нужно логарифмировать эти переменные.
Переменная GRAZE — это уровень выпаса скота в баллах, ее лучше было бы анализировать как дискретную переменную. Технически, ее можно анализировать и как непрерывную, но нужно помнить, это предполагает одинаковые различия между разными соседними уровнями выпаса скота. Это нереалистично.
Трансформируем переменные
bird$logAREA <- log(bird$AREA) bird$logDIST <- log(bird$DIST) bird$logLDIST <- log(bird$LDIST)
Отскоки (выбросы, outliers) - наблюдения, которые имеют более высокие (или низкие) значения относительно большинства других наблюдений.
ggplot(bird, aes(y = 1:nrow(bird), x = ABUND)) + geom_point() + labs(y = 'Порядковый номер \nв датасете', x = 'Значения переменной')
ggplot(bird, aes(y = 1:nrow(bird), x = AREA)) + geom_point() + labs(y = 'Порядковый номер \nв датасете', x = 'Значения переменной')
ggplot(bird, aes(y = 1:nrow(bird), x = logAREA)) + geom_point() + labs(y = 'Порядковый номер \nв датасете', x = 'Значения переменной')
Код для графика
gg_dot <- ggplot(bird, aes(y = 1:nrow(bird))) + geom_point() + ylab('index') Pl1 <- gg_dot + aes(x = ABUND) Pl2 <- gg_dot + aes(x = YRISOL) Pl3 <- gg_dot + aes(x = logAREA) Pl4 <- gg_dot + aes(x = logDIST) Pl5 <- gg_dot + aes(x = logLDIST) Pl6 <- gg_dot + aes(x = ALT) Pl7 <- gg_dot + aes(x = GRAZE) library(cowplot) # пакет для группировки графиков theme_set(theme_bw()) plot_grid(Pl1, Pl2, Pl3, Pl4, Pl5, Pl6, Pl7, ncol = 3, nrow = 3)
\[\begin{aligned}{ABUND}_i &= b_0 + b_1 \cdot logAREA_i + b_2 \cdot YRISOL_i + \\ &+ b_3 \cdot logDIST_i + b_4 \cdot logLDIST_i + b_5 \cdot GRAZE_i + b_6 \cdot ALT_i + e_i\\ \end{aligned}\]
Возможно, что эту модель придется изменить.
В начале нам нужно убедиться, что условия применимости линейной регрессии выполняются.
Мультиколлинеарность — наличие линейной зависимости между независимыми переменными (предикторами) в регрессионной модели.
При наличии мультиколлинеарности оценки параметров неточны, а значит сложно интерпретировать влияние предикторов на отклик.
Пусть наша модель \(y_i = b_0 + b_1 x_{1i} + b_2 x_{2i} + \ldots + b_{p - 1} x_{p - 1\;i} + e_i\).
Нужно оценить какую долю изменчивости конкретного предиктора могут объяснить другие предикторы (т.е. насколько предикторы независимы).
Для каждого предиктора:
В случае наличия мультиколлинеарности:
ABUND
) от других переменных (logAREA
, YRISOL
, logDIST
, logLDIST
, GRAZE
, ALT
)\[\begin{aligned}{ABUND}_i &= b_0 + b_1 \cdot logAREA_i + b_2 \cdot YRISOL_i + \\ &+ b_3 \cdot logDIST_i + b_4 \cdot logLDIST_i + b_5 \cdot GRAZE_i + b_6 \cdot ALT_i + e_i\\ \end{aligned}\]
vif()
, чтобы проверить, коллинеарны ли предикторы.Дополните код:
mod1 <- lm(formula = , data = ) vif()
# Строим модель mod1 <- lm(formula = ABUND ~ logAREA + YRISOL + logDIST + logLDIST + GRAZE + ALT, data = bird) # Проверяем, есть ли коллинеарность? vif(mod1)
## logAREA YRISOL logDIST logLDIST GRAZE ALT ## 1.91 1.80 1.65 2.01 2.52 1.47
В нашей модели сильной мультиколлинеарности нет.
Однако, возможно GRAZE
— избыточный предиктор.
mod2 <- update(mod1, . ~ . -GRAZE) vif(mod2)
## logAREA YRISOL logDIST logLDIST ALT ## 1.62 1.20 1.62 2.01 1.35
Теперь мультиколлинеарности нет. В модели осталось пять предикторов (и шесть параметров).
\[\begin{aligned}{ABUND}_i &= b_0 + b_1 \cdot logAREA_i + b_2 \cdot YRISOL_i + \\ &+ b_3 \cdot logDIST_i + b_4 \cdot logLDIST_i + b_5 \cdot ALT_i + e_i\\ \end{aligned}\]
\[\begin{aligned}{ABUND}_i &= b_0 + b_1 \cdot logAREA_i + b_2 \cdot YRISOL_i + \\ &+ b_3 \cdot logDIST_i + b_4 \cdot logLDIST_i + b_5 \cdot ALT_i + e_i\\ \end{aligned}\]
Мы подобрали коэффициенты и можем записать уравнение модели.
coef(mod2)
## (Intercept) logAREA YRISOL logDIST logLDIST ## -226.0006 3.6882 0.1207 -0.1033 -0.3281 ## ALT ## 0.0318
\[\begin{aligned}{ABUND}_i &= -226.00 + 3.69 \cdot logAREA_i + 0.12 \cdot YRISOL_i - \\ &-0.10 \cdot logDIST_i -0.33 \cdot logLDIST_i + 0.03 \cdot ALT_i + e_i\\ \end{aligned}\]
Аналогично простой регрессии
\[ \mathbf{Y} = \mathbf{Xb} + \mathbf{e} \]
Отличие лишь в форме модельной матрицы
X <- model.matrix(mod2) head(X)
## (Intercept) logAREA YRISOL logDIST logLDIST ALT ## 1 1 -2.303 1968 3.66 3.66 160 ## 2 1 -0.693 1920 5.46 5.46 60 ## 3 1 -0.693 1900 4.64 5.74 140 ## 4 1 0.000 1966 4.19 4.19 160 ## 5 1 0.000 1918 5.51 5.51 140 ## 6 1 0.000 1965 5.46 5.65 130
summary(mod2)
## ## Call: ## lm(formula = ABUND ~ logAREA + YRISOL + logDIST + logLDIST + ## ALT, data = bird) ## ## Residuals: ## Min 1Q Median 3Q Max ## -15.439 -3.669 0.332 2.765 15.759 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -226.0006 74.2526 -3.04 0.0037 ** ## logAREA 3.6882 0.5989 6.16 0.00000012 *** ## YRISOL 0.1207 0.0377 3.20 0.0024 ** ## logDIST -0.1033 1.1759 -0.09 0.9303 ## logLDIST -0.3281 0.9417 -0.35 0.7290 ## ALT 0.0318 0.0235 1.36 0.1814 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 6.52 on 50 degrees of freedom ## Multiple R-squared: 0.664, Adjusted R-squared: 0.631 ## F-statistic: 19.8 on 5 and 50 DF, p-value: 7.97e-11
Сейчас оставим все как есть.
Теперь давайте проверим, выполняются ли оставшиеся условия применимости, а после этого попытаемся выяснить, какие предикторы влияют сильнее всего.
Проверьте, выполняются ли условия применимости для модели mod2
. Дополните код:
library() mod2_diag <- data.frame(fortify(), $GRAZE) # 1) График расстояния Кука ggplot(data = , aes(x = 1:, y = .cooksd)) + geom_bar(stat = "") # 2) График остатков от предсказанных значений gg_resid <- ggplot(data = , aes(x = , y = )) + geom_point() + geom_hline() gg_resid # 3) Графики остатков от предикторов в модели и нет res_1 <- gg_resid + aes(x = logAREA) res_1 res_2 <- gg_resid res_3 <- gg_resid res_4 <- gg_resid res_5 <- gg_resid res_6 <- gg_resid # все графики вместе library(gridExtra) grid.arrange(res_1, res_2, nrow = 2) # 4) Квантильный график остатков library(car) qq
library(ggplot2) mod2_diag <- data.frame(fortify(mod2), GRAZE = bird$GRAZE) ggplot(data = mod2_diag, aes(x = 1:nrow(mod2_diag), y = .cooksd)) + geom_bar(stat = "identity")
gg_resid <- ggplot(data = mod2_diag, aes(x = .fitted, y = .stdresid)) + geom_point() + geom_hline(yintercept = 0) gg_resid
res_1 <- gg_resid + aes(x = logAREA) res_2 <- gg_resid + aes(x = YRISOL) res_3 <- gg_resid + aes(x = logDIST) res_4 <- gg_resid + aes(x = logLDIST) res_5 <- gg_resid + aes(x = GRAZE) res_6 <- gg_resid + aes(x = ALT) library(gridExtra) grid.arrange(res_1, res_2, res_3, res_4, res_5, res_6, nrow = 2)
library(car) qqPlot(mod2)
## [1] 18 47
coef(summary(mod2))
## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -226.0006 74.2526 -3.0437 0.003720242 ## logAREA 3.6882 0.5989 6.1580 0.000000124 ## YRISOL 0.1207 0.0377 3.2029 0.002368469 ## logDIST -0.1033 1.1759 -0.0879 0.930317686 ## logLDIST -0.3281 0.9417 -0.3485 0.728962858 ## ALT 0.0318 0.0235 1.3554 0.181365853
Для ответа на этот вопрос надо “уравнять” шкалы, всех предикторов, то есть стандартизовать их.
Коэффициенты при стандартизованных предикторах покажут, насколько сильно меняется отклик при изменении предиктора на одно стандартное отклонение.
Для стандартизации используем функцию scale()
mod2_scaled <- lm(ABUND ~ scale(logAREA) + scale(YRISOL) + scale(logDIST) + scale(logLDIST) + scale(ALT), data = bird)
coef(summary(mod2_scaled))
## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 19.5143 0.872 22.3848 1.03e-27 ## scale(logAREA) 6.8992 1.120 6.1580 1.24e-07 ## scale(YRISOL) 3.0885 0.964 3.2029 2.37e-03 ## scale(logDIST) -0.0985 1.120 -0.0879 9.30e-01 ## scale(logLDIST) -0.4344 1.247 -0.3485 7.29e-01 ## scale(ALT) 1.3842 1.021 1.3554 1.81e-01
Для простой линейной регрессии легко нарисовать график на плоскости, поскольку есть только две переменные: отклик и предиктор.
Во множественной линейной регрессии один отклик, но предикторов много, поэтому чтобы изобразить на плоскости нужны ухищрения.
Самое частое решение — построить график \(y\) от наиболее важного предиктора при средних значениях всех остальных предикторов. Но можно рассмотреть и любые другие интересные вам сценарии.
\[\begin{aligned}\widehat{ABUND}_i = &-226.00 + 3.69 \cdot logAREA_i + 0.12 \cdot YRISOL_i \\ &- 0.10 \cdot logDIST_i - 0.33 \cdot logLDIST_i + 0.03 \cdot ALT_i\\ \end{aligned}\]
coef(mod2_scaled)
## (Intercept) scale(logAREA) scale(YRISOL) scale(logDIST) ## 19.5143 6.8992 3.0885 -0.0985 ## scale(logLDIST) scale(ALT) ## -0.4344 1.3842
Судя по стандартизованным коэффициентам, самая важная здесь переменная — это логарифм площади леса.
Построим график предсказанных значений обилия птиц для лесов разной площади при средних значениях всех остальных предикторов.
\[\begin{aligned}\widehat{ABUND}_i = &-226.00 + 3.69 \cdot logAREA_i + 0.12 \cdot YRISOL_i \\ &- 0.10 \cdot logDIST_i - 0.33 \cdot logLDIST_i + 0.03 \cdot ALT_i\\ \end{aligned}\]
В нашей модели предикторы трансформированы и ABUND от них зависит линейно.
# Искусственный датафрейм для предсказаний MyData <- data.frame( logAREA = seq(min(bird$logAREA), max(bird$logAREA), length.out = 100), YRISOL = mean(bird$YRISOL), logDIST = mean(bird$logDIST), logLDIST = mean(bird$logLDIST), ALT = mean(bird$ALT)) # Предсказанные значения Predictions <- predict(mod2, newdata = MyData, interval = 'confidence') MyData <- data.frame(MyData, Predictions) # График предсказаний модели Pl_predict <- ggplot(MyData, aes(x = logAREA, y = fit)) + geom_ribbon(alpha = 0.2, aes(ymin = lwr, ymax = upr)) + geom_line() Pl_predict
\[\begin{aligned}\widehat{ABUND}_i = &-226.00 + 3.69 \cdot logAREA_i + 0.12 \cdot YRISOL_i \\ &- 0.10 \cdot logDIST_i - 0.33 \cdot logLDIST_i + 0.03 \cdot ALT_i\\ \end{aligned}\]
Для удобства восприятия лучше сделать обратную трансформацию предикторов.
# Обратная трансформация предиктора, который будем изображать MyData$AREA <- exp(MyData$logAREA) # График предсказаний модели Pl_predict <- ggplot(MyData, aes(x = AREA, y = fit)) + geom_ribbon(alpha = 0.2, aes(ymin = lwr, ymax = upr)) + geom_line() + xlab("Площадь леса") + ylab("Обилие птиц") Pl_predict
Имеет ли смысл на таком графике изображать исходные наблюдения?