Самостоятельная работа
Цель: провести регрессионный анализ между зависимой величиной количества зарегистированных организаций от ликвидированных за январь 2020 года по регионам РФ
Источник - Росстат, ссылка - http://bi.gks.ru/biportal/contourbi.jsp?allsol=1&solution=Dashboard&project=%2FDashboard%2Fcompany_statistics
data <- read.csv(file = "businesses.csv", sep =";", dec = ",", encoding = "UTF-8")
Разделим выборку на тестовую и обучающую.
set.seed(56) split <- sample.split(data$liquidated_2020_01, SplitRatio = 0.75) train <- subset(data, split == TRUE) test <- subset(data, split == FALSE)
Построим модель линейной регрессии. В качестве зависимой переменной выступает – liquidated_2020_01, независимой – registered_2020_01. Выводим полную информацию о построенной модели.
model_1 <- lm(data=train, liquidated_2020_01 ~ registered_2020_01) summary(model_1)
## ## Call: ## lm(formula = liquidated_2020_01 ~ registered_2020_01, data = train) ## ## Residuals: ## Min 1Q Median 3Q Max ## -219.63 -65.61 -25.56 39.91 425.41 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 41.9134 25.2813 1.658 0.103 ## registered_2020_01 1.6733 0.1562 10.710 2.86e-15 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 129.6 on 57 degrees of freedom ## Multiple R-squared: 0.668, Adjusted R-squared: 0.6622 ## F-statistic: 114.7 on 1 and 57 DF, p-value: 2.863e-15
Согласно полученным результатам уравнение регрессии имеет вид: liquidated_2020_01 = 41.91 + 1.67*registered_2020_01
Проверим линейную связь F-критерий H0: a=b 0 , (т.е. линейная связь между x и y отсутствует); H1: a>0 или b>0 (т.е. наличие линейной связи).
mean_model <- mean(train$liquidated_2020_01) f <- sum((model_1$fitted.values - mean_model)^2) / summary(model_1)$sigma^2 f
## [1] 114.7112
f_tabl <- qf(0.95, 1, nrow(train)-2) f_tabl
## [1] 4.009868
F расч | > F табл => отвергаем H0 в пользу наличия линейной связи с вероятностью 0.95.
Находим коэффициенты детерминации:
#коэффициент множественной корреляции summary(model_1)$r.squared
## [1] 0.6680474
#квадрат коэфициента скоректированной корреляции summary(model_1)$adj.r.squared
## [1] 0.6622236
Находим остаточную дисперсию:
summary(model_1)$sigma^2
## [1] 16796.15
Средняя ошибка аппроксимации
A <- sum(abs((train$liquidated_2020_01 - model_1$fitted.values)/train$liquidated_2020_01)) / nrow(train) * 100 str(A)
## num 155
А > 5-7% => качество модели плохое
Применив функцию glance(), можно также найти вышеописанные параметры:
glance(model_1)
## # A tibble: 1 x 12 ## r.squared adj.r.squared sigma statistic p.value df logLik AIC BIC ## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 0.668 0.662 130. 115. 2.86e-15 1 -370. 745. 752. ## # ... with 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>
Удалим незначащий фактор. Построим модель линейной регрессии.
model_1 <- lm(data=train, liquidated_2020_01 ~ registered_2020_01 - 1) summary(model_1)
## ## Call: ## lm(formula = liquidated_2020_01 ~ registered_2020_01 - 1, data = train) ## ## Residuals: ## Min 1Q Median 3Q Max ## -258.14 -42.87 -1.86 54.57 447.65 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## registered_2020_01 1.8662 0.1058 17.63 <2e-16 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 131.5 on 58 degrees of freedom ## Multiple R-squared: 0.8428, Adjusted R-squared: 0.8401 ## F-statistic: 311 on 1 and 58 DF, p-value: < 2.2e-16
Согласно полученным результатам уравнение регрессии имеет вид: liquidated_2020_01 = 41.91 + 1.67*registered_2020_01
Проверим линейную связь F-критерий H0: a=b 0 , (т.е. линейная связь между x и y отсутствует); H1: a>0 или b>0 (т.е. наличие линейной связи).
mean_model <- mean(train$liquidated_2020_01) f <- sum((model_1$fitted.values - mean_model)^2) / summary(model_1)$sigma^2 f
## [1] 139.6951
f_tabl <- qf(0.95, 1, nrow(train)-2) f_tabl
## [1] 4.009868
F расч | > F табл => отвергаем H0 в пользу наличия линейной связи с вероятностью 0.95.
Находим коэффициенты детерминации:
#коэффициент множественной корреляции summary(model_1)$r.squared
## [1] 0.8428038
#квадрат коэфициента скоректированной корреляции summary(model_1)$adj.r.squared
## [1] 0.8400935
Находим остаточную дисперсию:
summary(model_1)$sigma^2
## [1] 17302.52
Средняя ошибка аппроксимации
A <- sum(abs((train$liquidated_2020_01 - model_1$fitted.values)/train$liquidated_2020_01)) / nrow(train) * 100 str(A)
## num 52.8
А > 5-7% => качество модели плохое