УФИМСКИЙ ГОСУДАРСТВЕННЫЙ АВИАЦИОННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ

ФАКУЛЬТЕТ ИНФОРМАТИКИ И РОБОТОТЕХНИКИ

КАФЕДРА ВЫЧИСЛИТЕЛЬНОЙ МАТЕМАТИКИ И КИБЕРНЕТИКИ

		УТВЕРЖДАЮ Проректор университета по научной работе ФИО
		"___" ______________ _______г.
ОТЧЕТ О ПРОВЕДЕНИИ ЛАБОРАТОРНОЙ РАБОТЫ № 3 «Регрессионные уравнения»
по предмету: Статистическое моделирование
Преподаватель			Е.Ю. Сазонова
Исполнители			К.Б. Ибрагимова А.Р. Шакиров

Уфа 2021

Лабораторная работа №3

Ибрагимова К.Б., Шакиров А.Р.

13 05 2021

library(ggplot2) library(memisc)

## Loading required package: lattice

## Loading required package: MASS

## ## Attaching package: 'memisc'

## The following object is masked from 'package:ggplot2': ## ## syms

## The following objects are masked from 'package:stats': ## ## contr.sum, contr.treatment, contrasts

## The following object is masked from 'package:base': ## ## as.array

library(DescTools)

## ## Attaching package: 'DescTools'

## The following objects are masked from 'package:memisc': ## ## %nin%, Cor, Cov, Mean, Median, Range, Var

library(broom) library(caTools) library(lmtest)

## Loading required package: zoo

## ## Attaching package: 'zoo'

## The following objects are masked from 'package:base': ## ## as.Date, as.Date.numeric

library(dplyr)

## ## Attaching package: 'dplyr'

## The following objects are masked from 'package:memisc': ## ## collect, recode, rename, syms

## The following object is masked from 'package:MASS': ## ## select

## The following objects are masked from 'package:stats': ## ## filter, lag

## The following objects are masked from 'package:base': ## ## intersect, setdiff, setequal, union

library(readxl)

Загрузим набор данных − diamond.

dmnds <- diamonds

Разделим выборку на тестовую и обучающую.

set.seed(56) split <- sample.split(dmnds$price, SplitRatio = 0.75) train <- subset(dmnds, split == TRUE)

## Found more than one class "tbl_df" in cache; using the first, from namespace 'tibble'

## Also defined by 'memisc'

## Found more than one class "tbl_df" in cache; using the first, from namespace 'tibble'

## Also defined by 'memisc'

test <- subset(dmnds, split == FALSE)

Построим модель линейной регрессии. В качестве зависимой переменной выступает – price, независимой – carat. Выводим полную информацию о построенной модели.

model_1 <- lm(data = train, price ~ carat) summary(model_1)

## ## Call: ## lm(formula = price ~ carat, data = train) ## ## Residuals: ## Min 1Q Median 3Q Max ## -19246.6 -859.8 -23.7 566.4 12643.0 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -2317.63 15.48 -149.7 <2e-16 *** ## carat 7900.65 16.11 490.5 <2e-16 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 1626 on 42124 degrees of freedom ## Multiple R-squared: 0.851, Adjusted R-squared: 0.851 ## F-statistic: 2.406e+05 on 1 and 42124 DF, p-value: < 2.2e-16

Согласно полученным результатам уравнение регрессии имеет вид: price = -2317.63 + 7900.65 * carat

Находим коэффициенты детерминации:

#коэффициент множественной корреляции summary(lm(data = train, price ~ carat))$r.squared

## [1] 0.851

#квадрат коэфициента скоректированной корреляции (доля дисперсии зависимой переменной price) summary(lm(data = train, price ~ carat))$adj.r.squared

## [1] 0.8509965

Находим остаточную дисперсию:

summary(lm(data = train, price ~ carat))$sigma^2

## [1] 2643664

Средняя ошибка аппроксимации

A <- abs(sum((train$price - model_1$fitted.values)/train$price)) / nrow(train) * 100 str(A)

## num 5.81

А < 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.851 0.851 1626. 240587. 0 1 -371246. 742498. 742524. ## # ... with 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>