Прогноз динамики роста ключевых отраслей обрабатывающей промышленности в R

Постановка задачи

Построить прогноз динамики выпуска по основным видам продукции обрабатывающих производств до конца 2023 года

• ОБРАБАТЫВАЮЩИЕ ПРОИЗВОДСТВА
• Производство пищевых продуктов
• Производство напитков
• Производство табачных изделий
• Производство текстильных изделий
• Производство одежды
• Производство мыла и моющих, чистящих и полирующих средств; парфюмерных и косметических средств
• Производство лекарственных средств и материалов, применяемых в медицинских целях
• Производство мебели

Исходные данные

В качестве исходных данных будем использовать индексы производства к предыдущему периоду по нескольким видам продукции обрабатывающих производств:

Источник: ЕМИСС [¹]

Инструментарий построения прогноза

Программное обеспечение

R — язык программирования для статистической обработки данных и работы с графикой, а также свободная программная среда вычислений с открытым исходным https://www.r-project.org/

RStudio — свободная среда разработки программного обеспечения с открытым исходным кодом для языка программирования R, который предназначен для статистической обработки данных и работы с графикой. https://www.rstudio.com/products/rstudio/features/

fedstatAPIr — пакет для R, представляющий собой неофициальное API для загрузки данных с fedstat.ru (система ЕМИСС Росстата) с заданными фильтрами. https://github.com/DenchPokepon/fedstatAPIr/

Модель ARIMA

ARIMA - модель Авторегрессионного интегрированного скользящего среднего (AutoRegressive Integrated Moving Average).²

Модель ETS

ETS - Реализация модели экспоненциального сглаживания ³ в пакете функций для R для прогнозирования forecast, разработанная Робом Хайндманом ⁴. Также существует реализация в Excel 2016-2020 ⁵ с ограниченными возможностями настройки параметров в виде функции ПРЕДСКАЗ.ETS ⁶

Расчёт параметров прогноза

Подключение пакетов

# Установим пакеты функций для чтения файлов Excel и для прогнозирования (если они ещё не установлены)
# install.packages("readxl")
# install.packages("openxlsx")
# install.packages("forecast", dependencies = T)
# install.packages("knitr")
# install.packages("DT")
# install.packages("kableExtra")
# install.packages("formattable", dependencies = T)
# install.packages("lubridate")
# install.packages("anytime")
# install.packages("magrittr", dependencies = T)

#Подключим нужные пакеты
library(readxl, quietly = T)
library(openxlsx)
library(forecast, quietly = T)
library(knitr, quietly = T)
library(DT, quietly = T)
library(kableExtra, quietly = T)
library(formattable)
library(lubridate)
library(anytime)
library(tibble)
library(dplyr)
library(magrittr)

base_growth <- function(v) {
  # Приводит к базовому темп роста ряда динамики "MoM" рост К предыдущему периоду (к прошлому месяцу)
  for (i in 2:length(v)) v[i] <- v[i - 1] * v[i] / 100
  return(v)
}

annual_growth <- function(v, rates = TRUE) {
  # Обрабатывается ряд динамики, предварительно приведённый к базовому росту
  # Возвращает годовые темпы роста
  # сумма по году
  s_y <- numeric(0)
  s_y <- split(v, ceiling(seq_along(v)/12)) %>% sapply(sum) %>% unname()
  if (rates) {
    r <- as.data.frame(TTR::ROC(s_y))
    r[is.na(r)] <- 0
    return(r)
  } else{
    return(s_y)
  }
}

# Функция для соединения фактических и прогнозных данных
df_forecast <- function(df, prognoz, i) {
  require(lubridate)
  require(anytime)
  
  prognoz_df <- prognoz %>%
    as.data.frame() %>%
    tibble::rownames_to_column(var = "Date")  %>%
    select(1:2) %>%
    mutate(Date = paste("01", Date, sep = " ") %>% anydate())
 
    actual_df <- df[c(1, i)] %>% as.data.frame()
    names(actual_df)[1] <- "Date"
    names(prognoz_df) <- names(actual_df)

  output_df <- rbind(actual_df, prognoz_df) %>% na.omit()
  return(output_df)
}

save_excel <- function(df, file, i) {
  require(openxlsx)
  sheet <- as.character(i)
  if (!file.exists(file)) wb <- openxlsx::createWorkbook() else wb <- openxlsx::loadWorkbook(file = file)
  if ("Sheet 1" %in% names(wb)) {openxlsx::removeWorksheet(wb, 'Sheet 1')}
  if (sheet %in% names(wb)) {openxlsx::removeWorksheet(wb, sheet)}
  wsh <- addWorksheet(wb, sheet)
  showGridLines(wb, sheet, showGridLines = F)
  freezePane(wb, sheet, firstRow = T)
  setColWidths(wb, sheet, cols = c(1, 2), widths = c(9.43, 9))
  setRowHeights(wb, sheet = sheet, rows = 1, heights = 80)
  writeDataTable(wb,sheet,df,
          startCol = 1,startRow = 1,
          tableStyle = "TableStyleLight9",
          tableName = paste0('tbl_', as.character(i)))
  addStyle(wb, sheet, createStyle(numFmt = "DATE"),
           rows = 2:(nrow(df) + 1),cols = 1)
  addStyle(wb,sheet, createStyle(numFmt = "NUMBER"),
           rows = 2:(nrow(df) + 1), cols = 2)
  addStyle(wb,sheet,createStyle(numFmt = "GENERAL", halign = "center", valign = "top", wrapText = TRUE),
           rows = 1, cols = 1:ncol(df))
  openxlsx::saveWorkbook(wb, file, overwrite = TRUE)
}

Загрузка данных

getwd()

## [1] "D:/Dropbox/Data/R/work"

# setwd("D:/Dropbox/Data/")
year_crnt <- 2023
sh <- "MoM" # рост К предыдущему периоду (к прошлому месяцу)
# sh <- "YoY" #К соответствующему периоду предыдущего года  (период с начала года)
# sh <- "MoY" #Отчетный месяц к соответствующему месяцу предыдущего года
products <- read_excel("D:/Dropbox/Data/products.xlsx", sheet = sh)
rc <- nrow(products) # Количество строк в таблице
horizont = 13 #горизонт прогнозирования для всех моделей
prods_ts<-ts(products[1:rc,1:ncol(products)], start = c(2015,1), frequency = 12)

Выведем результаты в виде таблицы

# kable(products, caption = "") %>% kable_styling() %>% scroll_box(width = "100%", height = "200px")

library(DT)
datatable(products, editable = T, filter = 'top')

  # %>%  formatStyle(colnames(products),
  # background = styleColorBar(range(products), 'lightblue'),
  # backgroundSize = '98% 88%',
  # backgroundRepeat = 'no-repeat',
  # backgroundPosition = 'center')

Наверх↑

Обрабатывающие отрасли

# Преобразуем во временной ряд один из столбцов загруженных данных
prods <- prods_ts[,"manufacturing"]

# Построим график временного ряда, коррелограмму и частичную кореллограмму
ggtsdisplay(prods)

# Рассчитаем параметры модели ARIMA автоматически и занесём их в переменную **fit**
fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста обрабатывающих производств \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
# Оценим параметры модели. Малое значение информационного критерия Акаике (AIC) говорит о хорошем качестве модели

summary(prognoz)

## 
## Forecast method: ARIMA(0,0,1)(0,1,1)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,1)(0,1,1)[12] 
## 
## Coefficients:
##           ma1     sma1
##       -0.4022  -0.6595
## s.e.   0.1162   0.1430
## 
## sigma^2 = 9.428:  log likelihood = -213.37
## AIC=432.74   AICc=433.04   BIC=439.99
## 
## Error measures:
##                     ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 0.1680751 2.835176 2.058506 0.09811225 2.039535 0.7206075
##                    ACF1
## Training set 0.03472318
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022      114.01998 110.08208 117.95787 107.99748 120.04247
## Jan 2023       69.24294  65.00008  73.48581  62.75405  75.73184
## Feb 2023      104.25635 100.01349 108.49921  97.76745 110.74525
## Mar 2023      113.18987 108.94701 117.43274 106.70098 119.67877
## Apr 2023       94.70602  90.46316  98.94889  88.21712 101.19492
## May 2023       98.25840  94.01554 102.50127  91.76951 104.74730
## Jun 2023      106.51089 102.26803 110.75375 100.02199 112.99979
## Jul 2023      101.01107  96.76821 105.25394  94.52218 107.49997
## Aug 2023      102.26297  98.02011 106.50584  95.77408 108.75187
## Sep 2023      101.78059  97.53773 106.02346  95.29170 108.26949
## Oct 2023      104.28525 100.04238 108.52811  97.79635 110.77415
## Nov 2023      100.69143  96.44856 104.93429  94.20253 107.18033
## Dec 2023      114.58866 110.13786 119.03945 107.78175 121.39556

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	114.01998	110.08208	117.95787	107.99748	120.04247
Jan 2023	69.24294	65.00008	73.48581	62.75405	75.73184
Feb 2023	104.25635	100.01349	108.49921	97.76745	110.74525
Mar 2023	113.18987	108.94701	117.43274	106.70098	119.67877
Apr 2023	94.70602	90.46316	98.94889	88.21712	101.19492
May 2023	98.25840	94.01554	102.50127	91.76950	104.74730
Jun 2023	106.51089	102.26803	110.75375	100.02199	112.99979
Jul 2023	101.01107	96.76821	105.25394	94.52218	107.49997
Aug 2023	102.26297	98.02011	106.50584	95.77408	108.75187
Sep 2023	101.78059	97.53773	106.02346	95.29170	108.26949
Oct 2023	104.28525	100.04238	108.52811	97.79635	110.77415
Nov 2023	100.69143	96.44856	104.93429	94.20253	107.18033
Dec 2023	114.58866	110.13786	119.03945	107.78175	121.39556

v<-df_forecast(products, prognoz,2)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз обрабатывающих отраслей", align=c("c")) %>% kable_styling() 

Прогноз обрабатывающих отраслей

Год	Рост
2016	0.94%
2017	5.40%
2018	3.24%
2019	3.48%
2020	1.30%
2021	7.04%
2022	-1.41%
2023	1.94%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз обрабатывающих отраслей", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз обрабатывающих отраслей

Год	Рост
2016	0.94%
2017	5.40%
2018	3.24%
2019	3.48%
2020	1.30%
2021	7.04%
2022	-1.41%
2023	1.94%

# Объединим результаты в таблицу
products_forecast<-df_forecast(products, prognoz,2)

Автоматический перебор моделей

FALSE Загрузка требуемого пакета: forecastHybrid

FALSE Загрузка требуемого пакета: thief

Оценим качество моделей

forecast::tsdisplay(quickModel$residuals, main = "Остатки модели")

hist(quickModel$residuals, main = "Гистограмма остатков модели", xlab = "Остатки", ylab = "Частота")

accuracy(quickModel, individual = TRUE) 

## $auto.arima
##                     ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 0.1680751 2.835176 2.058506 0.09811225 2.039535 0.7206075
##                    ACF1
## Training set 0.03472318
## 
## $ets
##                      ME     RMSE      MAE         MPE     MAPE      MASE
## Training set 0.01721615 2.741188 2.044359 -0.06481852 2.070859 0.7156551
##                    ACF1
## Training set -0.3031162
## 
## $thetam
##                      ME     RMSE      MAE       MPE    MAPE     MASE       ACF1
## Training set -0.1153304 10.73027 6.757774 -1.551784 7.56717 2.365649 -0.3365918
## 
## $nnetar
##                       ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 0.003466848 3.166565 2.450754 -0.1093029 2.451957 0.8579189
##                    ACF1
## Training set -0.1538833
## 
## $stlm
##                      ME     RMSE     MAE         MPE     MAPE      MASE
## Training set 0.01318818 2.564137 1.95293 -0.08180094 1.982935 0.6836492
##                   ACF1
## Training set -0.306072
## 
## $tbats
##                     ME    RMSE      MAE      MPE   MAPE      MASE       ACF1
## Training set 0.3082179 2.85653 2.157952 0.218856 2.1355 0.1826303 0.01171698

AIC(quickModel$auto.arima)

## [1] 432.7364

AIC(quickModel$ets)

## [1] 654.2127

AIC(quickModel$thetam)

## [1] 635.8737

# AIC(quickModel$nnetar$model)
quickModel$stlm$model$aic

## [1] 617.5265

quickModel$tbats$AIC

## [1] 672.0437

По результатам перебора выберем модель ARIMA, т.к информационный критерий Акаике (AIC)⁷ у неё оказался наименьший.

Мы также можем назначить определённым моделям веса. Так например, присутствие модели nnetar, предназначенной для больших временных рядов, здесь вообще не уместно

# Вывести веса моделей
quickModel$weights

## auto.arima        ets     thetam     nnetar       stlm      tbats 
##  0.1666667  0.1666667  0.1666667  0.1666667  0.1666667  0.1666667

# Присвоить новые веса моделям
newWeights <- c(0.3, 0.3, 0.0, 0.2, 0.1, 0.1)
names(newWeights) <- c("auto.arima", "ets", "nnetar", "thetam", "stlm", "tbats")
quickModel$weights <- newWeights
quickModel[["weights"]][["auto.arima"]] <- 0.3
quickModel[["weights"]][["ets"]] <- 0.3
quickModel[["weights"]][["nnetar"]] <- 0.0
quickModel[["weights"]][["thetam"]] <- 0.2
quickModel[["weights"]][["stlm"]] <- 0.1
quickModel[["weights"]][["tbats"]] <- 0.1
quickModel$weights

## auto.arima        ets     nnetar     thetam       stlm      tbats 
##        0.3        0.3        0.0        0.2        0.1        0.1

# Построить новый прогноз с учётом разных весов
quickModel_prognoz_weighted = forecast(quickModel, h = horizont)

summary(quickModel_prognoz_weighted)

## 
## Forecast method: auto.arima with weight 0.3 
## Forecast method: ets with weight 0.3 
## Forecast method: thetam with weight 0 
## Forecast method: nnetar with weight 0.2 
## Forecast method: stlm with weight 0.1 
## Forecast method: tbats with weight 0.1
## 
## Model Information:
## NULL
## 
## Error measures:
##                     ME    RMSE      MAE        MPE     MAPE      MASE
## Training set 0.1223353 2.79266 2.189713 0.02938656 2.189896 0.7665383
##                    ACF1
## Training set -0.1219739
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022      112.52111 106.27174 117.95787 104.33384 120.04247
## Jan 2023       69.88374  64.34970  75.77889  61.59662  77.99314
## Feb 2023      103.94115  98.33783 108.49921  96.05910 110.74525
## Mar 2023      113.55725 108.06744 120.23375 105.78394 122.65843
## Apr 2023       94.87326  88.55576  99.96386  86.00872 102.60134
## May 2023       98.90500  93.62749 106.32406  91.29953 108.93015
## Jun 2023      106.33647  99.48362 110.75375  96.82168 112.99979
## Jul 2023      101.03564  95.88965 107.23395  93.95326 109.94287
## Aug 2023      101.88284  94.80959 106.50584  92.06505 108.75187
## Sep 2023      102.00025  97.17570 109.18996  94.88263 111.96010
## Oct 2023      104.01002  96.12524 108.75775  93.33194 111.58410
## Nov 2023      100.86337  96.44856 108.13348  94.20253 110.94331
## Dec 2023      112.03965 103.32126 119.03945 100.49710 121.39556

kable(quickModel_prognoz_weighted, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	112.52111	106.27174	117.95787	104.33384	120.04247
Jan 2023	69.88374	64.34970	75.77889	61.59662	77.99314
Feb 2023	103.94115	98.33783	108.49921	96.05910	110.74525
Mar 2023	113.55725	108.06744	120.23375	105.78394	122.65843
Apr 2023	94.87326	88.55576	99.96386	86.00872	102.60134
May 2023	98.90500	93.62749	106.32406	91.29953	108.93015
Jun 2023	106.33647	99.48362	110.75375	96.82168	112.99979
Jul 2023	101.03564	95.88965	107.23395	93.95326	109.94287
Aug 2023	101.88284	94.80959	106.50584	92.06505	108.75187
Sep 2023	102.00025	97.17570	109.18996	94.88263	111.96010
Oct 2023	104.01002	96.12524	108.75775	93.33194	111.58410
Nov 2023	100.86337	96.44856	108.13348	94.20253	110.94331
Dec 2023	112.03965	103.32126	119.03945	100.49710	121.39556

plot((quickModel_prognoz_weighted), main = "Прогноз от нескольких моделей: auto.arima, ets, thetam, nnetar, stlm, tbats с новыми весами")

Наверх↑

Пищевые продукты

prods <- prods_ts[,"food"]
ggtsdisplay(prods)

fit <- auto.arima(prods)

prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста пищевых продуктов \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(0,0,1)(0,1,1)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,1)(0,1,1)[12] 
## 
## Coefficients:
##           ma1     sma1
##       -0.5262  -0.7632
## s.e.   0.1023   0.1604
## 
## sigma^2 = 3.664:  log likelihood = -175.95
## AIC=357.9   AICc=358.2   BIC=365.15
## 
## Error measures:
##                      ME     RMSE      MAE        MPE    MAPE      MASE
## Training set 0.07410143 1.767459 1.334592 0.06181515 1.33102 0.6171095
##                     ACF1
## Training set -0.01224067
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022       97.52152  95.05798  99.98506  93.75386 101.28919
## Jan 2023       85.22640  82.44675  88.00605  80.97530  89.47751
## Feb 2023      103.43594 100.65630 106.21559  99.18484 107.68705
## Mar 2023      111.39613 108.61648 114.17577 107.14502 115.64723
## Apr 2023       96.02180  93.24216  98.80145  91.77070 100.27291
## May 2023       96.75113  93.97148  99.53078  92.50003 101.00224
## Jun 2023      100.94567  98.16602 103.72531  96.69456 105.19677
## Jul 2023      104.48208 101.70243 107.26173 100.23098 108.73319
## Aug 2023      103.78715 101.00750 106.56680  99.53604 108.03825
## Sep 2023      102.94102 100.16137 105.72067  98.68992 107.19213
## Oct 2023      105.27733 102.49769 108.05698 101.02623 109.52844
## Nov 2023       96.76270  93.98306  99.54235  92.51160 101.01381
## Dec 2023       98.47151  95.62866 101.31436  94.12374 102.81927

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	97.52152	95.05798	99.98506	93.75386	101.2892
Jan 2023	85.22640	82.44675	88.00605	80.97530	89.4775
Feb 2023	103.43595	100.65630	106.21559	99.18484	107.6870
Mar 2023	111.39613	108.61648	114.17577	107.14502	115.6472
Apr 2023	96.02180	93.24216	98.80145	91.77070	100.2729
May 2023	96.75113	93.97148	99.53078	92.50003	101.0022
Jun 2023	100.94567	98.16602	103.72531	96.69456	105.1968
Jul 2023	104.48208	101.70243	107.26173	100.23098	108.7332
Aug 2023	103.78715	101.00750	106.56679	99.53604	108.0383
Sep 2023	102.94102	100.16137	105.72067	98.68992	107.1921
Oct 2023	105.27733	102.49769	108.05698	101.02623	109.5284
Nov 2023	96.76270	93.98306	99.54235	92.51160	101.0138
Dec 2023	98.47151	95.62866	101.31436	94.12374	102.8193

v<-df_forecast(products, prognoz,3)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз пищевых продуктов", align=c("c")) %>% kable_styling() 

Прогноз пищевых продуктов

Год	Рост
2016	3.61%
2017	4.56%
2018	3.50%
2019	4.02%
2020	3.05%
2021	4.16%
2022	0.27%
2023	3.40%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз пищевых продуктов", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")), 
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x>0, "thumbs-up", "thumbs-down"), x))
  ))

Прогноз пищевых продуктов

Год	Рост
2016	3.61%
2017	4.56%
2018	3.50%
2019	4.02%
2020	3.05%
2021	4.16%
2022	0.27%
2023	3.40%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,3))

Наверх↑

Напитки

prods <- prods_ts[,"drinks"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства напитков \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(1,0,1)(0,1,2)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(1,0,1)(0,1,2)[12] 
## 
## Coefficients:
##          ar1      ma1     sma1     sma2
##       0.5260  -0.8266  -0.2861  -0.2528
## s.e.  0.1639   0.1060   0.1292   0.1376
## 
## sigma^2 = 31.66:  log likelihood = -261.04
## AIC=532.09   AICc=532.86   BIC=544.18
## 
## Error measures:
##                      ME     RMSE      MAE        MPE     MAPE     MASE
## Training set -0.7325509 5.131248 4.014751 -0.7053783 4.041847 0.802177
##                      ACF1
## Training set -0.003104599
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022      101.23995  94.02475 108.45515  90.20526 112.27464
## Jan 2023       71.77502  64.24310  79.30695  60.25594  83.29411
## Feb 2023      114.03672 106.41901 121.65442 102.38644 125.68699
## Mar 2023      121.92827 114.28700 129.56954 110.24196 133.61459
## Apr 2023      104.47929  96.83151 112.12707  92.78302 116.17556
## May 2023      105.02595  97.37637 112.67553  93.32693 116.72497
## Jun 2023      109.06465 101.41457 116.71472  97.36486 120.76443
## Jul 2023       99.97773  92.32752 107.62795  88.27774 111.67773
## Aug 2023       92.79168  85.14143 100.44194  81.09163 104.49174
## Sep 2023       92.51779  84.86753 100.16805  80.81773 104.21786
## Oct 2023       95.45912  87.80886 103.10937  83.75906 107.15917
## Nov 2023      103.66417  96.01394 111.31440  91.96415 115.36419
## Dec 2023      102.56711  93.34258 111.79165  88.45941 116.67482

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	101.23995	94.02475	108.45515	90.20526	112.27464
Jan 2023	71.77502	64.24310	79.30695	60.25594	83.29411
Feb 2023	114.03672	106.41901	121.65442	102.38644	125.68699
Mar 2023	121.92827	114.28700	129.56954	110.24196	133.61459
Apr 2023	104.47929	96.83151	112.12707	92.78302	116.17556
May 2023	105.02595	97.37637	112.67553	93.32693	116.72497
Jun 2023	109.06465	101.41457	116.71472	97.36486	120.76443
Jul 2023	99.97773	92.32752	107.62795	88.27774	111.67773
Aug 2023	92.79168	85.14143	100.44194	81.09163	104.49174
Sep 2023	92.51779	84.86753	100.16805	80.81773	104.21786
Oct 2023	95.45912	87.80886	103.10937	83.75906	107.15917
Nov 2023	103.66417	96.01394	111.31440	91.96415	115.36419
Dec 2023	102.56711	93.34258	111.79165	88.45941	116.67482

v<-df_forecast(products, prognoz,4)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства напитков", align=c("c")) %>% kable_styling() 

Прогноз производства напитков

Год	Рост
2016	3.58%
2017	0.37%
2018	1.64%
2019	4.71%
2020	1.46%
2021	9.13%
2022	3.01%
2023	3.08%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства напитков", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз производства напитков

Год	Рост
2016	3.58%
2017	0.37%
2018	1.64%
2019	4.71%
2020	1.46%
2021	9.13%
2022	3.01%
2023	3.08%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,4))

Наверх↑

Табачные изделия

prods <- prods_ts[,"tabaco"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста табачных изделий \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
# Большие значения информационного критерия Акаике и Байесовского информационного критерия Шварца (AIC, BIC) говорят о среднем качестве модели

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	88.71411	67.20450	110.2237	55.81799	121.6102
Jan 2023	94.39371	70.53124	118.2562	57.89921	130.8882
Feb 2023	116.26890	92.10596	140.4318	79.31487	153.2229
Mar 2023	98.43335	74.23008	122.6366	61.41764	135.4491
Apr 2023	95.90192	71.69321	120.1106	58.87788	132.9260
May 2023	97.28101	73.07156	121.4905	60.25584	134.3062
Jun 2023	92.19633	67.98678	116.4059	55.17101	129.2216
Jul 2023	124.31431	100.10474	148.5239	87.28897	161.3396
Aug 2023	107.34586	83.13629	131.5554	70.32052	144.3712
Sep 2023	100.08144	75.87187	124.2910	63.05610	137.1068
Oct 2023	97.30876	73.09919	121.5183	60.28341	134.3341
Nov 2023	102.46668	78.25711	126.6762	65.44133	139.4920
Dec 2023	94.65465	67.66563	121.6437	53.37851	135.9308

v<-df_forecast(products, prognoz,5)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства табака", align=c("c")) %>% kable_styling() 

Прогноз производства табака

Год	Рост
2016	-2.74%
2017	-26.14%
2018	3.91%
2019	-10.98%
2020	2.30%
2021	1.93%
2022	-8.65%
2023	8.77%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства табака", align=c("c"), list(
  `Год` =  formatter("span", style = ~ style(color = "gray")),
  `Рост` = formatter("span", style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "thumbs-up", "thumbs-down"), x))
  ))

Прогноз производства табака

Год	Рост
2016	-2.74%
2017	-26.14%
2018	3.91%
2019	-10.98%
2020	2.30%
2021	1.93%
2022	-8.65%
2023	8.77%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,5))

Наверх↑

Текстиль

prods <- prods_ts[,"textile"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(1,0,2)(0,1,1)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(1,0,2)(0,1,1)[12] 
## 
## Coefficients:
##           ar1     ma1      ma2     sma1
##       -0.4937  0.3460  -0.3613  -0.7701
## s.e.   0.2533  0.2438   0.1053   0.1663
## 
## sigma^2 = 20.43:  log likelihood = -246.42
## AIC=502.84   AICc=503.62   BIC=514.93
## 
## Error measures:
##                       ME     RMSE      MAE        MPE     MAPE      MASE
## Training set -0.08540641 4.121438 3.109355 -0.1884597 3.104676 0.7111504
##                     ACF1
## Training set -0.01441665
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022      101.76645  95.94444 107.58845  92.86246 110.67043
## Jan 2023       82.43252  76.55774  88.30729  73.44782  91.41721
## Feb 2023      111.12058 105.01250 117.22865 101.77908 120.46207
## Mar 2023      109.58757 103.42396 115.75119 100.16114 119.01401
## Apr 2023       96.15093  89.97386 102.32801  86.70391 105.59796
## May 2023       90.63095  84.45060  96.81131  81.17891 100.08299
## Jun 2023      106.49316 100.31201 112.67431  97.03990 115.94642
## Jul 2023      101.34038  95.15903 107.52173  91.88683 110.79393
## Aug 2023      104.06962  97.88823 110.25100  94.61600 113.52323
## Sep 2023      102.03598  95.85461 108.21734  92.58240 111.48955
## Oct 2023      102.77077  96.58955 108.95200  93.31741 112.22414
## Nov 2023       98.47311  92.29247 104.65375  89.02063 107.92558
## Dec 2023      102.70907  96.37580 109.04234  93.02317 112.39498

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	101.76645	95.94444	107.58845	92.86246	110.67043
Jan 2023	82.43252	76.55774	88.30729	73.44782	91.41721
Feb 2023	111.12058	105.01250	117.22865	101.77908	120.46207
Mar 2023	109.58757	103.42396	115.75119	100.16114	119.01401
Apr 2023	96.15093	89.97386	102.32801	86.70391	105.59796
May 2023	90.63095	84.45060	96.81131	81.17891	100.08299
Jun 2023	106.49316	100.31201	112.67431	97.03990	115.94642
Jul 2023	101.34038	95.15903	107.52173	91.88683	110.79393
Aug 2023	104.06962	97.88823	110.25100	94.61600	113.52323
Sep 2023	102.03598	95.85461	108.21734	92.58240	111.48955
Oct 2023	102.77077	96.58955	108.95200	93.31741	112.22414
Nov 2023	98.47311	92.29247	104.65375	89.02063	107.92558
Dec 2023	102.70907	96.37580	109.04234	93.02317	112.39498

v<-df_forecast(products, prognoz,6)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства текстиля", align=c("c")) %>% kable_styling() 

Прогноз производства текстиля

Год	Рост
2016	13.90%
2017	6.83%
2018	2.52%
2019	1.84%
2020	9.17%
2021	12.35%
2022	-10.34%
2023	2.33%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства текстиля", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x)) 
  ))

Прогноз производства текстиля

Год	Рост
2016	13.90%
2017	6.83%
2018	2.52%
2019	1.84%
2020	9.17%
2021	12.35%
2022	-10.34%
2023	2.33%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,6))

Наверх↑

Одежда

ggtsdisplay(prods)

prods <- prods_ts[,"clothing"]

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства одежды \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(0,0,2)(0,0,2)[12] with non-zero mean
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,2)(0,0,2)[12] with non-zero mean 
## 
## Coefficients:
##           ma1      ma2    sma1    sma2      mean
##       -0.6429  -0.2624  0.3460  0.2604  100.8877
## s.e.   0.0915   0.0932  0.1088  0.1248    0.1226
## 
## sigma^2 = 54.77:  log likelihood = -324.31
## AIC=660.62   AICc=661.57   BIC=675.94
## 
## Error measures:
##                     ME     RMSE      MAE        MPE     MAPE      MASE
## Training set -0.026117 7.203023 5.124396 -0.5880698 5.304916 0.7702369
##                    ACF1
## Training set 0.05337279
## 
## Forecasts:
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Dec 2022       95.09338 85.60936 104.5774 80.58882 109.5979
## Jan 2023       93.26086 81.98621 104.5355 76.01777 110.5040
## Feb 2023      105.26287 93.71683 116.8089 87.60472 122.9210
## Mar 2023      107.25256 95.70651 118.7986 89.59441 124.9107
## Apr 2023      104.77797 93.23193 116.3240 87.11982 122.4361
## May 2023       90.48249 78.93644 102.0285 72.82433 108.1406
## Jun 2023      104.60336 93.05731 116.1494 86.94520 122.2615
## Jul 2023       97.76053 86.21449 109.3066 80.10238 115.4187
## Aug 2023      103.75737 92.21132 115.3034 86.09922 121.4155
## Sep 2023      101.37110 89.82506 112.9171 83.71295 119.0293
## Oct 2023      102.49987 90.95383 114.0459 84.84172 120.1580
## Nov 2023      100.97788 89.43184 112.5239 83.31973 118.6360
## Dec 2023       97.70960 85.70626 109.7129 79.35207 116.0671

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	95.09338	85.60936	104.5774	80.58882	109.5979
Jan 2023	93.26086	81.98621	104.5355	76.01777	110.5040
Feb 2023	105.26287	93.71683	116.8089	87.60472	122.9210
Mar 2023	107.25256	95.70651	118.7986	89.59441	124.9107
Apr 2023	104.77797	93.23193	116.3240	87.11982	122.4361
May 2023	90.48248	78.93644	102.0285	72.82433	108.1406
Jun 2023	104.60336	93.05731	116.1494	86.94520	122.2615
Jul 2023	97.76053	86.21449	109.3066	80.10238	115.4187
Aug 2023	103.75737	92.21132	115.3034	86.09922	121.4155
Sep 2023	101.37110	89.82506	112.9171	83.71295	119.0293
Oct 2023	102.49987	90.95383	114.0459	84.84172	120.1580
Nov 2023	100.97788	89.43184	112.5239	83.31973	118.6360
Dec 2023	97.70960	85.70626	109.7129	79.35207	116.0671

v<-df_forecast(products, prognoz,7)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства одежды", align=c("c")) %>% kable_styling()

Прогноз производства одежды

Год	Рост
2016	5.21%
2017	12.33%
2018	6.44%
2019	3.41%
2020	0.31%
2021	7.22%
2022	1.64%
2023	9.81%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства одежды", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),  
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз производства одежды

Год	Рост
2016	5.21%
2017	12.33%
2018	6.44%
2019	3.41%
2020	0.31%
2021	7.22%
2022	1.64%
2023	9.81%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,7))

Наверх↑

Моющие средства

prods <- prods_ts[,"soap"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(0,0,0)(2,1,0)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,0)(2,1,0)[12] 
## 
## Coefficients:
##          sar1     sar2
##       -0.5586  -0.3064
## s.e.   0.1237   0.1251
## 
## sigma^2 = 42.13:  log likelihood = -274.39
## AIC=554.78   AICc=555.09   BIC=562.04
## 
## Error measures:
##                        ME     RMSE      MAE        MPE     MAPE      MASE
## Training set -0.005802609 5.993282 4.309938 -0.2698602 4.310354 0.7836252
##                    ACF1
## Training set -0.0164974
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022       97.99945  89.68143 106.31747  85.27813 110.72077
## Jan 2023       81.02255  72.70453  89.34057  68.30123  93.74387
## Feb 2023      118.28437 109.96635 126.60240 105.56306 131.00569
## Mar 2023      107.72325  99.40523 116.04128  95.00193 120.44457
## Apr 2023       95.27374  86.95572 103.59176  82.55242 107.99506
## May 2023       85.78999  77.47196  94.10801  73.06867  98.51130
## Jun 2023      104.52481  96.20678 112.84283  91.80349 117.24613
## Jul 2023      109.83898 101.52095 118.15700  97.11766 122.56030
## Aug 2023      107.70995  99.39193 116.02798  94.98864 120.43127
## Sep 2023      102.51228  94.19425 110.83030  89.79096 115.23360
## Oct 2023      104.46475  96.14672 112.78277  91.74343 117.18607
## Nov 2023       96.95045  88.63243 105.26847  84.22913 109.67177
## Dec 2023       98.20718  89.11501 107.29934  84.30191 112.11244

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	97.99945	89.68143	106.31747	85.27813	110.72077
Jan 2023	81.02255	72.70453	89.34057	68.30123	93.74387
Feb 2023	118.28437	109.96635	126.60240	105.56306	131.00569
Mar 2023	107.72325	99.40523	116.04128	95.00193	120.44457
Apr 2023	95.27374	86.95572	103.59176	82.55242	107.99506
May 2023	85.78999	77.47196	94.10801	73.06867	98.51130
Jun 2023	104.52481	96.20678	112.84283	91.80349	117.24613
Jul 2023	109.83898	101.52095	118.15700	97.11766	122.56030
Aug 2023	107.70995	99.39193	116.02798	94.98864	120.43127
Sep 2023	102.51228	94.19425	110.83030	89.79096	115.23360
Oct 2023	104.46475	96.14672	112.78277	91.74343	117.18607
Nov 2023	96.95045	88.63243	105.26847	84.22913	109.67177
Dec 2023	98.20718	89.11501	107.29934	84.30191	112.11244

v<-df_forecast(products, prognoz,8)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства моющих средств", align=c("c")) %>% kable_styling()

Прогноз производства моющих средств

Год	Рост
2016	3.68%
2017	6.85%
2018	0.59%
2019	-1.21%
2020	10.48%
2021	3.07%
2022	-10.28%
2023	8.64%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства моющих средств", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),  
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз производства моющих средств

Год	Рост
2016	3.68%
2017	6.85%
2018	0.59%
2019	-1.21%
2020	10.48%
2021	3.07%
2022	-10.28%
2023	8.64%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,8))

Наверх↑

Лекарственные средства

prods <- prods_ts[,"pharmaceutical"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(0,0,2)(0,0,2)[12] with non-zero mean
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,2)(0,0,2)[12] with non-zero mean 
## 
## Coefficients:
##           ma1      ma2    sma1    sma2      mean
##       -0.5814  -0.2630  0.5361  0.2065  102.8535
## s.e.   0.0956   0.1058  0.1178  0.1142    0.4041
## 
## sigma^2 = 217.9:  log likelihood = -390.26
## AIC=792.53   AICc=793.48   BIC=807.85
## 
## Error measures:
##                       ME     RMSE      MAE       MPE     MAPE     MASE
## Training set -0.03255211 14.36915 11.48007 -2.166133 11.89626 0.819159
##                    ACF1
## Training set 0.03079969
## 
## Forecasts:
##          Point Forecast     Lo 80    Hi 80     Lo 95    Hi 95
## Dec 2022      134.29248 115.37306 153.2119 105.35772 163.2272
## Jan 2023       92.88918  71.00405 114.7743  59.41876 126.3596
## Feb 2023      113.11447  90.67090 135.5580  78.78999 147.4390
## Mar 2023      106.70572  84.26214 129.1493  72.38123 141.0302
## Apr 2023       95.70845  73.26488 118.1520  61.38397 130.0329
## May 2023       92.40252  69.95894 114.8461  58.07803 126.7270
## Jun 2023      102.21905  79.77548 124.6626  67.89457 136.5435
## Jul 2023       98.83556  76.39198 121.2791  64.51107 133.1600
## Aug 2023      104.34553  81.90196 126.7891  70.02105 138.6700
## Sep 2023      103.62343  81.17986 126.0670  69.29895 137.9479
## Oct 2023       99.64764  77.20406 122.0912  65.32315 133.9721
## Nov 2023       96.42256  73.97898 118.8661  62.09807 130.7470
## Dec 2023      113.93888  89.31009 138.5677  76.27240 151.6054

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	134.29248	115.37306	153.2119	105.35772	163.2272
Jan 2023	92.88918	71.00405	114.7743	59.41876	126.3596
Feb 2023	113.11447	90.67090	135.5580	78.78999	147.4390
Mar 2023	106.70572	84.26214	129.1493	72.38123	141.0302
Apr 2023	95.70845	73.26488	118.1520	61.38397	130.0329
May 2023	92.40252	69.95894	114.8461	58.07803	126.7270
Jun 2023	102.21905	79.77548	124.6626	67.89457	136.5435
Jul 2023	98.83556	76.39198	121.2791	64.51107	133.1600
Aug 2023	104.34553	81.90196	126.7891	70.02105	138.6700
Sep 2023	103.62343	81.17986	126.0670	69.29895	137.9479
Oct 2023	99.64764	77.20406	122.0912	65.32315	133.9721
Nov 2023	96.42256	73.97898	118.8661	62.09807	130.7470
Dec 2023	113.93888	89.31009	138.5677	76.27240	151.6054

v<-df_forecast(products, prognoz,9)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства лекарств", align=c("c")) %>% kable_styling() 

Прогноз производства лекарств

Год	Рост
2016	13.93%
2017	9.26%
2018	0.96%
2019	24.23%
2020	18.24%
2021	13.06%
2022	9.89%
2023	21.38%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства лекарств", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),  
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз производства лекарств

Год	Рост
2016	13.93%
2017	9.26%
2018	0.96%
2019	24.23%
2020	18.24%
2021	13.06%
2022	9.89%
2023	21.38%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,9))

Наверх↑

Мебель

prods <- prods_ts[,"furniture"]
ggtsdisplay(prods)

fit <- auto.arima(prods)
prognoz = forecast(fit, h = horizont)
autoplot(prognoz, main = paste0('Прогноз динамики роста производства мебели \n до конца ', year_crnt, 'г.'))

# Выведем параметры прогноза на экран
summary(prognoz)

## 
## Forecast method: ARIMA(0,0,0)(2,1,0)[12]
## 
## Model Information:
## Series: prods 
## ARIMA(0,0,0)(2,1,0)[12] 
## 
## Coefficients:
##          sar1     sar2
##       -0.6309  -0.4664
## s.e.   0.1072   0.1139
## 
## sigma^2 = 89.62:  log likelihood = -307.5
## AIC=621   AICc=621.3   BIC=628.26
## 
## Error measures:
##                     ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 0.4776005 8.741682 6.285005 -0.2049174 6.513079 0.7579998
##                    ACF1
## Training set -0.1099312
## 
## Forecasts:
##          Point Forecast     Lo 80     Hi 80     Lo 95     Hi 95
## Dec 2022      111.21937  99.08687 123.35187  92.66431 129.77443
## Jan 2023       69.15341  57.02091  81.28591  50.59835  87.70847
## Feb 2023      117.71497 105.58247 129.84747  99.15991 136.27003
## Mar 2023      102.38340  90.25090 114.51590  83.82834 120.93846
## Apr 2023       82.20127  70.06877  94.33377  63.64621 100.75633
## May 2023       95.56747  83.43496 107.69997  77.01241 114.12253
## Jun 2023      119.36669 107.23419 131.49919 100.81163 137.92175
## Jul 2023      110.36274  98.23023 122.49524  91.80767 128.91780
## Aug 2023      102.10972  89.97722 114.24223  83.55466 120.66478
## Sep 2023      108.99304  96.86054 121.12554  90.43798 127.54810
## Oct 2023      102.10808  89.97558 114.24058  83.55302 120.66314
## Nov 2023      102.39805  90.26555 114.53056  83.84299 120.95311
## Dec 2023      114.12931 101.19658 127.06203  94.35041 133.90821

kable(prognoz, caption = "Прогноз (Point Forecast)") %>% kable_styling() 

Прогноз (Point Forecast)

	Point Forecast	Lo 80	Hi 80	Lo 95	Hi 95
Dec 2022	111.21937	99.08687	123.35187	92.66431	129.77443
Jan 2023	69.15341	57.02091	81.28591	50.59835	87.70847
Feb 2023	117.71497	105.58247	129.84747	99.15991	136.27003
Mar 2023	102.38340	90.25090	114.51590	83.82834	120.93846
Apr 2023	82.20127	70.06877	94.33377	63.64621	100.75633
May 2023	95.56747	83.43496	107.69997	77.01241	114.12253
Jun 2023	119.36669	107.23419	131.49919	100.81163	137.92175
Jul 2023	110.36274	98.23023	122.49524	91.80767	128.91780
Aug 2023	102.10972	89.97722	114.24223	83.55466	120.66478
Sep 2023	108.99304	96.86054	121.12554	90.43798	127.54810
Oct 2023	102.10808	89.97558	114.24058	83.55302	120.66314
Nov 2023	102.39805	90.26555	114.53056	83.84299	120.95311
Dec 2023	114.12931	101.19658	127.06203	94.35041	133.90821

v<-df_forecast(products, prognoz,10)[,2] %>% base_growth() %>% annual_growth(T)
df_growth<-data.frame("Год" = 2016:2023,"Рост" = percent(v[2:nrow(v),1]))
# Форматированная таблица
kable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства мебели", align=c("c")) %>% kable_styling()

Прогноз производства мебели

Год	Рост
2016	-28.17%
2017	17.73%
2018	12.15%
2019	2.33%
2020	6.53%
2021	16.19%
2022	-0.70%
2023	3.56%

# Форматированная таблица
formattable(df_growth, format = "html", table.attr = "style='width:50%;'", caption = "Прогноз производства мебели", align=c("c"), list(
  `Год` = formatter("span", style = ~ style(color = "gray")),  
  `Рост` = formatter("span",style = x ~ style(color = ifelse(x > 0, "green", "red")), x ~ icontext(ifelse(x >0, "arrow-up", "arrow-down"), x))
  ))

Прогноз производства мебели

Год	Рост
2016	-28.17%
2017	17.73%
2018	12.15%
2019	2.33%
2020	6.53%
2021	16.19%
2022	-0.70%
2023	3.56%

# Объединим результаты в таблицу
products_forecast<-merge(x = products_forecast, y = df_forecast(products, prognoz,10))

# Сохраним результат в файл Excel
products_forecast_file<-"0.products_forecast.xlsx"
products_forecast_file <-paste0(products_forecast_file, "_", format(Sys.time(), '%Y-%m-%d_%H-%M'))
save_excel(df=products_forecast, file = products_forecast_file, i="all")

# openxlsx::openXL(products_forecast_file)

Наверх↑

Справка

ARIMA

Авторегрессионное интегрированное скользящее среднее (autoregressive integrated moving average, ARIMA) является обобщением модели авторегрессионного скользящего среднего. Эти модели используются при работе с временными рядами для более глубокого понимания данных или предсказания будущих точек ряда. Обычно модель упоминается, как ARIMA(p,d,q), где p,d и q — целые неотрицательные числа, характеризующие порядок для частей модели (соответственно авторегрессионной, интегрированной и скользящего среднего).

Используется большое количество вариаций модели ARIMA:

• Если исследуются несколько рядов, то их можно рассматирвать как векторы. Тогда используется модель векторной авторегресии VARIMA.
• Если в модели может иметься сезонный фактор, то лучше прибегнуть к модели сезонного авторегрессионного скользящего среднего SARIMA.
• Если имеется некоторая долгосрочная зависимость, параметр d может быть заменён нецелыми значениями, приводя к авторегрессионному дробноинтегрированному процессу скользящего среднего FARIMA или ARFIMA.

Экспоненциальное сглаживание

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

Исторически метод независимо был разработан Брауном и Холтом.

Многие модели экспоненциального сглаживания являются частными случаями моделей ARIMA. Однако, между ними есть и отличия:

1. Не все модели ETS имеют аналоги в моделях ARIMA. Например, нелинейные модели экспоненциального сглаживания (с мультипликативной ошибкой, трендом или сезонностью) не имеют аналогов среди моделей ARIMA.

2. Модели экспоненциального сглаживания строятся, исходя из конечных стартовых значений, а модели ARIMA предполагают, что временно́й ряд имеет бесконечное прошлое.

3. Все модели ARIMA стационарны, так как этого требует методология Бокса – Дженкинса, в то время как практически все модели экспоненциального сглаживания по сути своей нестационарны.

4. Эти два разных класса моделей основаны на совершенно разных подходах, которые дают соответственно разные результаты при прогнозировании.

Тем не менее модели связаны друг с другом, и выражение моделей экспоненциального сглаживания через модели ARIMA может быть полезным, так как позволяет по-другому взглянуть на эти модели.

Простейшая модель – модель Брауна, ETS(A,N,N), в Excel 2016 используется модель ETS(A,A,A)

Литература

Rob J. Hyndman (Роб Хайндман) - Forecasting: Principles and Practice https://otexts.org/fpp3/ Онлайн-книга

Мастицкий С. Э. - Анализ временных рядов с помощью R https://ranalytics.github.io/tsa-with-r/ Онлайн-книга

Мастицкий С. Э., Шитиков В. К. - Классификация, регрессия и другие алгоритмы Data Mining с использованием R. https://ranalytics.github.io/data-mining/ Онлайн-книга

Светуньков И.С. - Методы социально-экономического прогнозирования. Т.2. https://studme.org/40982/ekonomika/metody_sotsialno-ekonomicheskogo_prognozirovaniya_t2

---

1. ЕМИСС (Единая межведомственная информационно–статистическая система), Индекс производства (оперативные данные) (ОКВЭД2) https://fedstat.ru/indicator/57806↩︎

2. MachineLearning.Ru — Профессиональный информационно-аналитический ресурс, посвященный машинному обучению и интеллектуальному анализу данных http://www.machinelearning.ru/wiki/index.php?title=ARIMA↩︎

3. Экспоненциальное сглаживание является одним из наиболее распространенных приемов, используемых для сглаживания временных рядов, а также для прогнозирования. В основе процедуры сглаживания лежит расчёт экспоненциальных скользящих средних сглаживаемого ряда.↩︎

4. Forecasting: Principles and Practice by Rob J. Hyndman https://otexts.org/fpp2/ Онлайн-книга Роба Хайндмана по прогнозированию в R↩︎

5. Новые возможности Excel 2020 для Windows https://support.office.com/ru-ru/article/Новые-возможности-excel-2020-для-windows-5a201203-1155-4055-82a5-82bf0994631f↩︎

6. Функция ПРЕДСКАЗ.ETS для Excel 2016-2020 https://support.office.com/ru-ru/article/Функция-ПРЕДСКАЗ-ets-15389b8b-677e-4fbd-bd95-21d464333f41↩︎

7. Информационный критерий Хироцугу Акаикэ для оценки качества моделей. Меньше - лучше https://ru.wikipedia.org/wiki/Информационный_критерий_Акаике↩︎