Приложение 1 листинг программы

library("XML")

library("plotrix")

library("moments")

library("writexl")

library("dplyr")

library("ggplot2")

library("cowplot")

library("car")

library("lattice")

urlVor <- "http://www.pogodaiklimat.ru/history/34123.htm"

tableVor <- readHTMLTable(urlVor, which = 2)

tableVor[tableVor == 999.9] <- NA

tableVor <- na.omit(tableVor)

tableVor <- tableVor %>% mutate_at(c("янв", "фев", "мар", "апр", "май", "июн", "июл", "авг", "сен", "окт", "ноя", "дек", "за год"), as.numeric)

#1

#формируем таблицу со столбцами X и Y, где X- месяц с января по сентябрь (численно с 1 до 9), а Y - средняя температура в этот месяц

x <- c()

y<-c()

for (i in (nrow(tableVor)-9):nrow(tableVor)){

for (j in 1:9){

y<- append(y, tableVor[i, j])

x <- append(x, j)

}

}

table <- data.frame(X=x, Y=y)

#table - исходная таблица

#2

#диаграмма разброса без дрожания

dotplot(Y~X, data=table)

#диаграмма разброса с эффектом дрожания

graphDrozh <- ggplot(table) + aes(x=X, y=Y, color=x) + geom_jitter() + theme(legend.position = "none")

graphDrozh

#3

cor.test(x, y)

#корреляция равна 0.8604653, результат оценки значимости при помощи t-теста (Стьюдент):

#p-value < 2.2e-16

#4

model <- lm(Y~X, table)

coefficients(model)

#Получаем коэффициент сдвига: -6.790556, коэффициент наклона: 3.451667, уравнение регрессии -6.790556 + 3.451667x = y

#5

sse <- sum (( fitted (model) - table$Y)^2)

sse

#sse=2506.375

ssr <- sum (( fitted (model) - mean(table$Y))^2)

ssr

#ssr=7148.402

sst <- ssr + sse

sst

#sst=9654.777

model_summ <- summary(model)

mean(model_summ$residuals^2)

#Среднеквадратическая ошибка оценки равна 27.84861

summary(model)$r.squared

#Коэффициент детерминации равен 0.7404005

#6

confint(model, level = 0.90)

#доверительный интервал для коэффициента наклона - (3.089482, 3.813851)

#7

#диаграмма разброса из 2го пункта

tableRegr <- data.frame(X = x, Y = (-6.790556 + 3.451667*x))

graphDrozh + geom_line(data = tableRegr, col = "red")

#8

ggplot(model, aes(x=fitted(model), y=residuals(model)))+

geom_point() + geom_hline(yintercept = 0, linetype = "dashed" )

#9

shapiro.test(residuals(model))

qqnorm(residuals(model))

qqline(residuals(model))

#p-value = 0.00998 => не можем отклонить нулевую гипотезу о нормальности распределения

#исходя из графика квантиль-квантиль можно сделать вывод, что условие о нрмальном распределении остатков нарушется незначительно

#10

car::durbinWatsonTest(model)

#p-value = 0 => нет автокорреляции => можно применять МНК