Для проработки методов прогнозирования временных рядов в R необходимы примеры, на которых можно было наглядно представить, как эти методы работают. Конечно особых проблем для этого нет, в литературе по R много ссылок на различные датафреймы с данными по временным рядам. Но хотелось бы иметь временной ряд, близкий к задачам, которыми занимаешься и ,что очень важно для дальнейшей проработки, с понятной структурой. Поэтому для себя я решил сделать такой датафрейм, использую мультипликативную модель временного ряда.
В начале загрузим необходимые для работы библиотеки :
library(lubridate)
library(dplyr)
library(timeperiodsR)
library(TSstudio)
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)))
head(df_qr)
В начале загрузим необходимые для работы библиотеки :
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)
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)
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]]
}
}
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)
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
## 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))
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
## # 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)
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 ## # 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
Комментариев нет:
Отправить комментарий