суббота, 30 мая 2020 г.

Временные ряды в R : модель временного ряда

Для проработки методов прогнозирования временных рядов в R необходимы примеры, на которых можно было наглядно представить, как эти методы работают. Конечно особых проблем для этого нет, в литературе по R много ссылок на различные датафреймы с данными по временным рядам. Но хотелось бы иметь временной ряд, близкий к задачам, которыми занимаешься и ,что очень важно для дальнейшей проработки, с понятной структурой. Поэтому для себя я решил сделать такой датафрейм, использую мультипликативную модель временного ряда.



В начале загрузим необходимые для работы библиотеки :

library(lubridate)
library(dplyr)
library(timeperiodsR)
library(TSstudio)

В качестве примера временного ряда сгенерируем данные, моделирующие дневное количество посетителей в магазине одежды с 1.01.2015 по 31.12.2016. Мультипликативная модель такого временного ряда можно представить формулой :

Посетители (день) = Тренд * СК месяц * СК день недели * СК праздник * Е

в качестве тренда возьмем линейную зависимость

Тренд = (360-0.05 * День)

где День = 1…(365*5+1). Месячные сезонные коэффициенты зададим вектором

sc_month <- c(1.15,0.68,0.89,0.86,0.89,0.88,0.91,0.99,1.02,1.19,1.33,1.21)

Дневные сезонные коэффициенты зададим матрицей, номер строки определяют сезон 1 - зима, 2 - весна, 3 - лето, 4 - осень. Деление по сезонам сделано потому, что от сезона зависит соотношение посетителей в рабочие и выходные дни.

sc_day <- matrix(c(0.67,0.68,0.70,0.73,0.83,1.70,1.69,
                   0.66,0.71,0.71,0.71,0.80,1.68,1.74,
                   0.79,0.84,0.84,0.85,0.86,1.40,1.42,
                   0.64,0.65,0.67,0.69,0.85,1.74,1.77),nrow=4,byrow = TRUE)

Сезонные коэффициенты праздников привяжем к датам. Для этого введем два вектора - вектор дат и вектор коэффициентов.

holiday_date <- as.Date(
  c('01-01-2015','02-01-2015','05-01-2015','06-01-2015','07-01-2015',
    '08-01-2015','09-01-2015','23-02-2015','09-03-2015','01-05-2015',
    '04-05-2015','11-05-2015','12-06-2015','04-11-2015','01-01-2016',
    '02-01-2016','03-01-2016','04-01-2016','05-01-2016','06-01-2016',
    '07-01-2016','08-01-2016','22-02-2016','23-02-2016','07-03-2016',
    '08-03-2016','02-05-2016','03-05-2016','09-05-2016','13-06-2016',
    '04-11-2016','01-01-2017','02-01-2017','03-01-2017','04-01-2017',
    '05-01-2017','06-01-2017','23-02-2017','24-02-2017','08-03-2017',
    '01-05-2017','08-05-2017','09-05-2017','12-06-2017','06-11-2017',
    '01-01-2018','02-01-2018','03-01-2018','04-01-2018','05-01-2018',
    '08-01-2018','23-02-2018','08-03-2018','09-03-2018','30-04-2018',
    '01-05-2018','02-05-2018','09-05-2018','11-06-2018','12-06-2018',
    '05-11-2018','01-01-2019','02-01-2019','03-01-2019','04-01-2019',
    '07-01-2019','08-01-2019','08-03-2019','01-05-2019','02-05-2019',
    '03-05-2019','09-05-2019','10-05-2019','12-06-2019','04-11-2019'),
  format = "%d-%m-%Y")



holiday_sc <- c(0.42,1.25,2.71,2.19,1.94,1.80,1.50,1.98,2.39,1.88,1.77,
                1.90,1.77,2.85,0.42,1.25,1.24,2.98,2.71,2.19,1.94,1.80,
                2.70,1.98,2.53,1.71,2.14,1.77,1.38,1.77,2.85,0.21,2.97,
                2.97,2.79,2.38,1.79,2.03,1.84,2.39,2.01,2.01,1.21,1.69,
                3.16,0.62,2.95,3.01,2.74,2.28,2.17,1.79,2.00,1.97,2.23,
                1.88,1.80,1.49,1.67,1.38,3.05,0.71,2.93,2.67,2.24,2.25,
                2.06,1.74,1.74,1.97,1.62,1.40,1.53,1.77,3.18)

Также определим две функции для заполнения датафрейма данных. Первая для дневных сезонных коэффициентов (по дням недели), вторая - для праздничных.

fsc_month <- function(x){
  sc_month[month(x)]
}


fsc_wday <- function(x){
  if((month(x) %in% c(12,1,2))[1]) {
    sc_day[1,wday(x)]
  } else if(month(x) %in% c(3,4,5)){
    sc_day[2,wday(x)]
  } else if(month(x) %in% c(6,7,8)) {
    sc_day[3,wday(x)]
  } else {
    sc_day[4,wday(x)]
  }
}

fsch_day <- function(x){
  if (is.na(which(holiday_date==x)[1])){
    1
  }else{
    holiday_sc[which(holiday_date==x)[1]]
  }
}


Далее сгенерируем последовательность дат и сделаем заготовку для нашего датафрейма

day_ind <- seq.Date(from = as.Date("2015-01-01"),
                        to = as.Date("2019-12-31"),
                        by = "day")

df_day <- data.frame(ds=day_ind)

И заполним его значениями, в качестве случайной составляющей возьмем случайную величину с нормальным законом распределения со средним значением 1 и стандартным отклонением 0.02.

sc_hday <- apply(df_day,1,fsch_day)

df_day <- mutate(df_day,year=year(ds),
              qr=quarters(ds),
              month=month(ds),
              wday=wday(ds),
              sc_month=fsc_month(ds),
              sc_wday=fsc_wday(ds),
              sc_hday=sc_hday,
              trend=1:nrow(df_day),
              visit=round((360-0.1*trend)*sc_month*sc_wday*sc_hday*rnorm(1,1,0.02)))

Посмотрим на начало и конец полученного датафрейма

rbind(head(df_day,10),tail(df_day,10))

##              ds year qr month wday sc_month sc_wday sc_hday trend visit
## 1    2015-01-01 2015 Q1     1    5     1.15    0.83    0.42     1   147
## 2    2015-01-02 2015 Q1     1    6     1.15    1.70    1.25     2   895
## 3    2015-01-03 2015 Q1     1    7     1.15    1.69    1.00     3   712
## 4    2015-01-04 2015 Q1     1    1     1.15    0.67    1.00     4   282
## 5    2015-01-05 2015 Q1     1    2     1.15    0.68    2.71     5   776
## 6    2015-01-06 2015 Q1     1    3     1.15    0.70    2.19     6   645
## 7    2015-01-07 2015 Q1     1    4     1.15    0.73    1.94     7   596
## 8    2015-01-08 2015 Q1     1    5     1.15    0.83    1.80     8   628
## 9    2015-01-09 2015 Q1     1    6     1.15    1.70    1.50     9  1072
## 10   2015-01-10 2015 Q1     1    7     1.15    1.69    1.00    10   710
## 1817 2019-12-22 2019 Q4    12    1     1.21    0.67    1.00  1817   147
## 1818 2019-12-23 2019 Q4    12    2     1.21    0.68    1.00  1818   149
## 1819 2019-12-24 2019 Q4    12    3     1.21    0.70    1.00  1819   154
## 1820 2019-12-25 2019 Q4    12    4     1.21    0.73    1.00  1820   160
## 1821 2019-12-26 2019 Q4    12    5     1.21    0.83    1.00  1821   182
## 1822 2019-12-27 2019 Q4    12    6     1.21    1.70    1.00  1822   372
## 1823 2019-12-28 2019 Q4    12    7     1.21    1.69    1.00  1823   370
## 1824 2019-12-29 2019 Q4    12    1     1.21    0.67    1.00  1824   147
## 1825 2019-12-30 2019 Q4    12    2     1.21    0.68    1.00  1825   149
## 1826 2019-12-31 2019 Q4    12    3     1.21    0.70    1.00  1826   153

Cоздадим квартальный датафрейм

df_qr <- df_day %>% group_by(year,qr) %>%
  summarize(visit=sum(visit))

head(df_qr)

## # A tibble: 6 x 3
## # Groups:   year [2]
##    year qr    visit
##   <dbl> <chr> <dbl>
## 1  2015 Q1    32218
## 2  2015 Q2    29381
## 3  2015 Q3    30624
## 4  2015 Q4    38688
## 5  2016 Q1    29875
## 6  2016 Q2    25752


И месячный датафрейм

df_month <- df_day %>% group_by(year,month) %>%
  summarize(visit=sum(visit))

head(df_month)
## # A tibble: 6 x 3
## # Groups:   year [1]
##    year month visit
##   <dbl> <dbl> <dbl>
## 1  2015     1 15262
## 2  2015     2  7055
## 3  2015     3  9901
## 4  2015     4  9046
## 5  2015     5 10894
## 6  2015     6  9441 

Комментариев нет:

Отправить комментарий