Theme Song



FRA : Elle me dit

CHN : 她对我说

ENG : She told me

JPN : 彼女は私に言う


FRA : écris une chanson contente

CHN : 写一首欢快的歌

ENG : Write a happy song

JPN : 幸せな歌を書く


FRA : Pas une chanson déprimante

CHN : 而不是悲伤的歌

ENG : Not a depressing song

JPN : 気のめいるような歌ではない


FRA : Une chanson que tout le monde aime

CHN : 一首让所有人都喜欢的歌

ENG : A song that everyone loves

JPN : みんなが大好きな曲


FRA : Elle me dit

CHN : 她对我说

ENG : She told me

JPN : 彼女は私に言う


FRA : Tu deviendras milliardaire

CHN : 你将成为亿万富翁

ENG : You will become a millionaire

JPN : あなたは億万長者になります


FRA : Tu auras de quoi être fier

CHN : 你将为此感到骄傲

ENG : You will be proud

JPN : あなたは誇りに思うでしょう



1 Abstract

Due to below isseus from Deriv.com - Interday High Frequency Trading Models Comparison Blooper, here I review the researh by using same dataset.

  • Weekly dataset 7200 mins forecast in advanced despite Saturday and Sunday.
  • Use the dataset data_m1 from 2015-01-05 to 2017-12-31.
  • Use Close Price to ease the workload and some errors (ex: OHLC abnor, NA price).

Load Packages

if(!suppressPackageStartupMessages(require('BBmisc'))) {
  install.packages('BBmisc', dependencies = TRUE, INSTALL_opts = '--no-lock')
}
suppressPackageStartupMessages(require('BBmisc'))
# suppressPackageStartupMessages(require('rmsfuns'))

pkgs <- c('devtools', 'knitr', 'kableExtra', 'tint', 'furrr', 'tidyr', 
          'devtools','readr', 'lubridate', 'data.table', 'reprex', 
          'feather', 'purrr', 'quantmod', 'tidyquant', 'tibbletime', 
          'timetk', 'plyr', 'dplyr', 'stringr', 'magrittr', 'tdplyr', 
          'tidyverse', 'memoise', 'htmltools', 'formattable', 'dtplyr', 
          'zoo', 'forecast', 'seasonal', 'seasonalview', 'rjson', 
          'rugarch', 'rmgarch', 'mfGARCH', 'sparklyr', 'jcolors', 
          'microbenchmark', 'dendextend', 'lhmetools', 'ggthemr', 
          'stringr', 'pacman', 'profmem', 'ggthemes', 'flyingfox', 
          'htmltools', 'echarts4r', 'viridis', 'hrbrthemes', 
          'fable', 'fabletools', 'Rfast', 'Metrics', 'MLmetrics')

## https://www.jianshu.com/p/4beb3d34ced2
#unlink('C:/Program Files/R/R-4.0.3/library/withr', recursive = TRUE)
#install.packages('withr', dependencies = TRUE, INSTALL_opts = '--no-lock')

suppressAll(lib(pkgs))
# load_pkg(pkgs)

.dtr <- 'C:/Users/User/Documents/GitHub/binary.com-interview-question-data/'

## Set the timezone but not change the datetime
Sys.setenv(TZ = 'Asia/Tokyo')
## options(knitr.table.format = 'html') will set all kableExtra tables to be 'html', otherwise need to set the parameter on every single table.
options(warn = -1, knitr.table.format = 'html')#, digits.secs = 6)

## https://stackoverflow.com/questions/39417003/long-vectors-not-supported-yet-abnor-in-rmd-but-not-in-r-script
knitr::opts_chunk$set(cache = TRUE, warning = FALSE, 
                      message = FALSE, cache.lazy = FALSE)

rm(pkgs)

Progress Function

task_progress <- function(mbase, timeID0 = NULL, scs = 60, .pattern = '^ts_|^ts_ets', .loops = TRUE) {
  ## ------------- 定时查询进度 ----------------------
  ## 每分钟自动查询与更新以上模拟预测汇价进度(储存文件量)。
  require('magrittr')
  require('tibble')
  
  if(!is.data.frame(class(mbase))) { 
    mbase %<>% data.frame
  }
  
  if (.loops == TRUE) {
    while(1) {
      cat('Current Tokyo Time :', as.character(now('Asia/Tokyo')), '\n\n')
      
      y = as_date(mbase$index) %>% 
            unique
      y <- y[weekdays(y) != 'Saturday'] #filter and omit the weekly last price which is 12:00am on saturday
        datee = y
        
        if(is.null(timeID0)) { 
            timeID0 = y[1]
        } else if (is.Date(timeID0)) { 
            timeID0 = as_date(timeID0)
        } else {
            timeID0 = as_date(mbase$index) %>% 
            unique
        }
      
        y = y[y >= timeID0]
      
      x = list.files(paste0(.dtr, 'data/fx/USDJPY/'), pattern = .pattern) %>% 
          str_replace_all('.rds', '') %>% 
          str_replace_all('.201', '_201') %>% 
          str_split_fixed('_', '2') %>% 
          as_tibble %>% 
          dplyr::rename('Model' = 'V1', 'Date' = 'V2') %>% 
          dplyr::mutate(Model = factor(Model), Date = as_date(Date))
        
      x = join(tibble(Date = datee), x) %>% 
          as_tibble   
      x %<>% na.omit
      
      x %<>% dplyr::mutate(binary = if_else(is.na(Model), 0, 1)) %>% 
          spread(Model, binary)
      
      z <- ldply(x[,-1], function(zz) {
          na.omit(zz) %>% length }) %>% 
          dplyr::rename(x = V1) %>% 
          dplyr::mutate(n = length(y), progress = percent(x/n))
      
      print(z)
      
      prg = sum(z$x)/sum(z$n)
      cat('\n================', as.character(percent(prg)), '================\n\n')
      
      if (prg == 1) break #倘若进度达到100%就停止更新。
      
      Sys.sleep(scs) #以上ldply()耗时3~5秒,而休息时间60秒。
    }
  } else {
    
    cat('Current Tokyo Time :', as.character(now('Asia/Tokyo')), '\n\n')
      
    
      y = as_date(mbase$index) %>% 
            unique
      datee = y
        
      if(is.null(timeID0)) { 
          timeID0 = y[1]
      } else if (is.Date(timeID0)) { 
          timeID0 = as_date(timeID0)
      } else {
          timeID0 = as_date(mbase$index) %>% 
          unique
      }
    
      y = y[y >= timeID0]
    
      x = list.files(paste0(.dtr, 'data/fx/USDJPY/'), pattern = .pattern) %>% 
          str_replace_all('.rds', '') %>% 
          str_replace_all('.201', '_201') %>% 
          str_split_fixed('_', '2') %>% 
          as_tibble %>% 
          dplyr::rename('Model' = 'V1', 'Date' = 'V2') %>% 
          dplyr::mutate(Model = factor(Model), Date = as_date(Date))
        
      x = join(tibble(Date = datee), x) %>% 
          as_tibble
      x %<>% na.omit
      
      x %<>% dplyr::mutate(binary = if_else(is.na(Model), 0, 1)) %>% 
          spread(Model, binary)
        
      z <- ldply(x[,-1], function(zz) {
          na.omit(zz) %>% length }) %>% 
          dplyr::rename(x = V1) %>% 
          dplyr::mutate(n = length(y), progress = percent(x/n))
                
    print(z)
    
    prg = sum(z$x)/sum(z$n)
    cat('\n================', as.character(percent(prg)), '================\n\n')
    }
  }

3 Data

3.1 Read Data

3.1.1 Raw Data

data_m1 <- read_rds('C:/Users/User/Documents/GitHub/real-time-fxcm/data/USDJPY/data_m1.rds') %>% 
  data.table
data_m1 %<>% .[order(index)]

## plot sample data
data_m1[c(1:3, (nrow(data_m1)-3):nrow(data_m1)),] %>% 
  kbl(caption = '1 min Raw Dataset', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(5, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(6, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(7, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(8, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(9, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(10, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(11, background = 'Gainsboro', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
1 min Raw Dataset
index year week BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow AskClose
2015-01-05 00:01:00 2015 1 120.502 120.570 120.484 120.538 120.608 120.671 120.566 120.610
2015-01-05 00:02:00 2015 1 120.538 120.588 120.533 120.568 120.610 120.678 120.588 120.612
2015-01-05 00:03:00 2015 1 120.568 120.606 120.508 120.539 120.612 120.708 120.566 120.668
2018-07-06 23:57:00 2018 27 110.452 110.452 110.448 110.450 110.462 110.477 110.462 110.477
2018-07-06 23:58:00 2018 27 110.450 110.454 110.446 110.449 110.477 110.499 110.477 110.499
2018-07-06 23:59:00 2018 27 110.450 110.454 110.446 110.449 110.477 110.499 110.477 110.499
2018-07-07 00:00:00 2018 27 110.450 110.454 110.446 110.449 110.477 110.499 110.477 110.499

source : 1324800 x 11

As we can know there has few errors from Deriv.com - Interday High Frequency Trading Models Comparison Blooper:

  • open price higher than highest price
  • open price lower than lowest price
  • close price higher than highest price
  • close price lower than lowest price

3.1.2 OHLC Data

Convert to OHLC data as we know from Deriv.com - Interday High Frequency Trading Models Comparison Blooper.

if(names(data_m1) %>% str_detect('Bid|Ask') %>% any()) {
  dsmp <- data_m1[,{
    open = (BidOpen + AskOpen)/2 
    high = (BidHigh + AskHigh)/2 
    low = (BidLow + AskLow)/2 
    close = (BidClose + AskClose)/2
    .SD[,.(index = index, year = year, week = week, 
           open = open, high = high, low = low, close = close), ]}, ]
}

## plot sample data
dsmp[c(1:3, (nrow(dsmp)-3):nrow(dsmp)),] %>% 
  kbl(caption = '1 min OHLC Dataset', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(5, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(6, background = 'LightGray', color = 'goldenrod') %>% 
  column_spec(7, background = 'Gainsboro', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
1 min OHLC Dataset
index year week open high low close
2015-01-05 00:01:00 2015 1 120.5550 120.6205 120.5250 120.5740
2015-01-05 00:02:00 2015 1 120.5740 120.6330 120.5605 120.5900
2015-01-05 00:03:00 2015 1 120.5900 120.6570 120.5370 120.6035
2018-07-06 23:57:00 2018 27 110.4570 110.4645 110.4550 110.4635
2018-07-06 23:58:00 2018 27 110.4635 110.4765 110.4615 110.4740
2018-07-06 23:59:00 2018 27 110.4635 110.4765 110.4615 110.4740
2018-07-07 00:00:00 2018 27 110.4635 110.4765 110.4615 110.4740

source : 1324800 x 7

3.2 Data Cleaning

dsmp <- dsmp[,{
  quarter = quarter(index)
  month = month(index)
  wkdays = weekdays(index)
  wk_1m = 1:7200
  dy_1m = 1:1440
  hr_1m = 1:60
  date = as_date(index)
  .SD[,.(index = index, year = year, quarter = quarter, 
         month = month, week = week, wkdays = wkdays, 
         wk_1m = wk_1m, dy_1m = dy_1m, hr_1m = hr_1m, 
         sq = 1:.N, date = date, close = close), ]}, ]
## plot sample data
dsmp[c(1:3, (nrow(dsmp)-3):nrow(dsmp)),] %>% 
  kbl(caption = '1 min Close Price Dataset', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  ## https://public.tableau.com/en-us/gallery/100-color-palettes?gallery=votd
  row_spec(0, background = 'DimGrey', color = 'gold', bold = TRUE) %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'Gray') %>% 
  column_spec(3, background = 'DarkGrey') %>% 
  column_spec(4, background = 'Gray') %>% 
  column_spec(5, background = 'DarkGrey') %>% 
  column_spec(6, background = '#4897D8') %>% 
  column_spec(7, background = '#556DAC') %>% 
  column_spec(8, background = '#92AAC7') %>% 
  column_spec(9, background = '#556DAC') %>% 
  column_spec(10, background = '#375E97') %>% 
  column_spec(11, background = 'CornflowerBlue') %>% 
  column_spec(12, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
1 min Close Price Dataset
index year quarter month week wkdays wk_1m dy_1m hr_1m sq date close
2015-01-05 00:01:00 2015 1 1 1 Monday 1 1 1 1 2015-01-05 120.5740
2015-01-05 00:02:00 2015 1 1 1 Monday 2 2 2 2 2015-01-05 120.5900
2015-01-05 00:03:00 2015 1 1 1 Monday 3 3 3 3 2015-01-05 120.6035
2018-07-06 23:57:00 2018 3 7 27 Friday 7197 1437 57 1324797 2018-07-06 110.4635
2018-07-06 23:58:00 2018 3 7 27 Friday 7198 1438 58 1324798 2018-07-06 110.4740
2018-07-06 23:59:00 2018 3 7 27 Friday 7199 1439 59 1324799 2018-07-06 110.4740
2018-07-07 00:00:00 2018 3 7 27 Saturday 7200 1440 60 1324800 2018-07-07 110.4740

source : 1324800 x 12

## Below codes list out all Tuesday to Sunday data details.
# data_abn <- dsmp[wkdays %chin% 'Saturday' & !str_detect(index, '00:00:00') | wkdays %chin% 'Sunday']$date
# date_abn2 <- date_abn[1:length(date_abn) %% 2 == 0]
## --------------------------------------------
date_abn <- dsmp[wkdays %chin% 'Sunday']$date %>% 
  unique
date_abn_seq <- llply(date_abn, function(dte) 
  as.character(seq(dte - days(6), dte, by = 'day'))) %>% 
  unlist %>% 
  as_date

rm(date_abn, date_abn2)
data_abn <- dsmp[date %in% date_abn_seq]

## plot sample data
data_abn[c(1:3, (nrow(data_abn)-3):nrow(data_abn)),] %>% 
  kbl(caption = '1 min Close Price Dataset (Abnormal : Tuesday - Sunday)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  ## https://public.tableau.com/en-us/gallery/100-color-palettes?gallery=votd
  row_spec(0, background = 'DimGrey', color = 'gold', bold = TRUE) %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'Gray') %>% 
  column_spec(3, background = 'DarkGrey') %>% 
  column_spec(4, background = 'Gray') %>% 
  column_spec(5, background = 'DarkGrey') %>% 
  column_spec(6, background = '#4897D8') %>% 
  column_spec(7, background = '#556DAC') %>% 
  column_spec(8, background = '#92AAC7') %>% 
  column_spec(9, background = '#556DAC') %>% 
  column_spec(10, background = '#375E97') %>% 
  column_spec(11, background = 'CornflowerBlue') %>% 
  column_spec(12, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
1 min Close Price Dataset (Abnormal : Tuesday - Sunday)
index year quarter month week wkdays wk_1m dy_1m hr_1m sq date close
2016-12-27 00:01:00 2016 4 12 52 Tuesday 1 1 1 741601 2016-12-27 117.1965
2016-12-27 00:02:00 2016 4 12 52 Tuesday 2 2 2 741602 2016-12-27 117.1965
2016-12-27 00:03:00 2016 4 12 52 Tuesday 3 3 3 741603 2016-12-27 117.1965
2018-01-06 23:59:00 2017 1 1 53 Saturday 7197 1437 57 1137597 2018-01-06 NA
2018-01-06 23:59:00 2018 1 1 1 Saturday 7198 1438 58 1137598 2018-01-06 113.0580
2018-01-07 00:00:00 2017 1 1 53 Sunday 7199 1439 59 1137599 2018-01-07 NA
2018-01-07 00:00:00 2018 1 1 1 Sunday 7200 1440 60 1137600 2018-01-07 113.0580

source : 36000 x 12

There has transactions in from Tuesday (12:01AM) to Sunday (12:00AM) as we can know from above and below.

## -------------------- eval = FALSE --------------------
matrix(weekdays(unique(as_date(dsmp$index))), ncol = 6, byrow = TRUE)
[104,] "Tuesday" "Wednesday" "Thursday"  "Friday"   "Saturday" "Sunday"  
[105,] "Tuesday" "Wednesday" "Thursday"  "Friday"   "Saturday" "Sunday"
...
[156,] "Tuesday" "Wednesday" "Thursday"  "Friday"   "Saturday" "Sunday" 
[157,] "Tuesday" "Wednesday" "Thursday"  "Friday"   "Saturday" "Sunday"

There has 2 weeks abnormal data (2016-12-26 to 2017-01-08 and 2017-12-25 to 2018-01-07).

There might probably because of Christmas to postpone 1 day, here I forecast 7200 trading datetime in advanced despite the date and weekdays. Every forecast price will base on the out of sample date. There will no any effects .

## check if data path set
if(!exists('.dtr')) {
  .dtr <- 'C:/Users/User/Documents/GitHub/binary.com-interview-question-data/'}

## save files if not exists
if(!file.exists(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds')) & exists('dsmp')) {
  saveRDS(dsmp, paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))}

## read files if not exists
if(!exists('dsmp')) {
  dsmp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))}

4 Modelling

Due to I have annually length dataset, here I start my 1st forecast date from 1st trading datetime of 2016 (2016-01-04 which is 2nd year in dataset).

4.1 Seasonal ts()

4.1.1 Daily Seasonal Data

4.1.1.1 Seasonal Data Modeling

I set the length of data as weekly (7200 minutes which is 5 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

Chapter 7 Multivariate TS Analysis in Introduction to Time Series Analysis and Forecasting in R, but I use univariate due to some errors as mentioned in beginning.

I tried to use weeks(1), months(3), years(1) but there is not constant observations, we can refer to The seasonal period.

Here I filter up the data as below :

  • 5 days * 1440 mins = 7200 mins = weekly
  • 22 days * 1440 mins = 31680 mins = monthly
  • 3 months * 22 days * 1440 mins = 95040 mins = quarterly
  • 52 weeks * 5 days * 1440 mins = 374400 mins = yearly
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 7200 #last 7200  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440

for (i in c(1, 6:8, length(timeID) - 1, length(timeID))) { #Here I print 8 elements as examples
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast::forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    if(!file.exists(fl_pth)) saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else  {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    
    print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast::forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    if(!file.exists(fl_pth)) saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
    
  }
}

4.1.1.2 Wk >> Dy

I set the length of data as weekly (5 days * 1440 mins = 7200 mins minutes which is 5 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 7200 #last 7200  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440

for (i in 1:length(timeID)) {

  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else  {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    
    print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_7200_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (7200 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (7200 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.1867
2 2016-01-04 00:02:00 120.2200 120.1709
3 2016-01-04 00:03:00 120.2200 120.1714
1438 2016-01-04 23:58:00 119.4535 120.2109
1439 2016-01-04 23:59:00 119.4450 120.2114
1440 2016-01-05 00:00:00 119.4530 120.2079

source : 1440 x 3

4.1.1.3 Mn >> Dy

I set the length of data as monthly (22 days * 1440 mins = 31680 mins minutes which is 22 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 22 * 1440 #last 31680  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)

  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else  {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_31680_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (31680 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (31680 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2156
2 2016-01-04 00:02:00 120.2200 120.2031
3 2016-01-04 00:03:00 120.2200 120.2042
1438 2016-01-04 23:58:00 119.4535 120.2093
1439 2016-01-04 23:59:00 119.4450 120.2096
1440 2016-01-05 00:00:00 119.4530 120.2079

source : 1440 x 3

4.1.1.4 Qt >> Dy

I set the length of data as quarterly (3 months * 22 days * 1440 mins = 95040 mins minutes which is 66 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 3 * 22 * 1440 #last 95040  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else  {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_95040_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (95040 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (95040 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2157
2 2016-01-04 00:02:00 120.2200 120.2032
3 2016-01-04 00:03:00 120.2200 120.2042
1438 2016-01-04 23:58:00 119.4535 120.2093
1439 2016-01-04 23:59:00 119.4450 120.2096
1440 2016-01-05 00:00:00 119.4530 120.2079

source : 1440 x 3

4.1.1.5 Yr >> Dy

I set the length of data as yearly (52 weeks * 5 days * 1440 mins = 374400 mins minutes which is 260 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 52 * 5 * 1440 #last 374400  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else  {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_374400_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (374400 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (374400 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2160
2 2016-01-04 00:02:00 120.2200 120.2035
3 2016-01-04 00:03:00 120.2200 120.2045
1438 2016-01-04 23:58:00 119.4535 120.2093
1439 2016-01-04 23:59:00 119.4450 120.2096
1440 2016-01-05 00:00:00 119.4530 120.2080

source : 1440 x 3

4.1.2 Weekly Seasonal Data

4.1.2.1 Wk >> Wk

I set the length of data as weekly (5 days * 1440 mins = 7200 mins minutes which is 22 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 7200 #last 7200  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
    
  } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    ## filter the length of forecasted data to fit with train_test data 
    ##   when the length of forecasted data more then length of test data.
    #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
    lst_date <- timeID[timeID >= timeID[i]]
    lst_date_sq <- grep(
      timeID[i], timeID[(length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    
    print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl
    
    sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
      dplyr::mutate(index = train_test[
        (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
        mk.price = train_test[
          (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    
    cat('\n')
    cat('===========================================\n')
    cat('train[', i, ']\n')
    
    print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('train_test[', i, ']\n')
    
    print(train_test <- dsmp[sq %in% ctr])
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    cat('\n')
    cat('-------------------------------------------\n')
    cat('forecast[', i, ']\n')
    
    print(sets %>% as.data.table)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat('\n')
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    cat('\n\n')
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_7200_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (7200 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (7200 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
7198 2016-01-08 23:58:00 117.2535 120.208
7199 2016-01-08 23:59:00 117.2420 120.208
7200 2016-01-09 00:00:00 117.2420 120.208

source : 7200 x 3

4.1.2.2 Mn >> Wk

I set the length of data as monthly (22 days * 1440 mins = 31680 mins minutes which is 22 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 22 * 1440 #last 31680  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    ## filter the length of forecasted data to fit with train_test data 
    ##   when the length of forecasted data more then length of test data.
    #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
    lst_date <- timeID[timeID >= timeID[i]]
    lst_date_sq <- grep(
      timeID[i], timeID[(length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl
    
    sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
      dplyr::mutate(index = train_test[
        (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
        mk.price = train_test[
          (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_31680_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (31680 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (31680 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2583
2 2016-01-04 00:02:00 120.2200 120.2225
3 2016-01-04 00:03:00 120.2200 120.2224
7198 2016-01-08 23:58:00 117.2535 120.2133
7199 2016-01-08 23:59:00 117.2420 120.2079
7200 2016-01-09 00:00:00 117.2420 120.2080

source : 7200 x 3

4.1.2.3 Qt >> Wk

I set the length of data as quarterly (3 months * 22 days * 1440 mins = 95040 mins minutes which is 66 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 3 * 22 * 1440 #last 95040  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    ## filter the length of forecasted data to fit with train_test data 
    ##   when the length of forecasted data more then length of test data.
    #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
    lst_date <- timeID[timeID >= timeID[i]]
    lst_date_sq <- grep(
      timeID[i], timeID[(length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl
    
    sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
      dplyr::mutate(index = train_test[
        (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
        mk.price = train_test[
          (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_95040_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (95040 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (95040 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2675
2 2016-01-04 00:02:00 120.2200 120.2539
3 2016-01-04 00:03:00 120.2200 120.2553
7198 2016-01-08 23:58:00 117.2535 120.2102
7199 2016-01-08 23:59:00 117.2420 120.2080
7200 2016-01-09 00:00:00 117.2420 120.2080

source : 7200 x 3

4.1.2.4 Yr >> Wk

I set the length of data as yearly (52 weeks * 5 days * 1440 mins = 374400 mins minutes which is 260 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 52 * 5 * 1440 #last 374400  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

for (i in 1:length(timeID)) {
  
  if(i == 1) {
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
        dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                      mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    ## filter the length of forecasted data to fit with train_test data 
    ##   when the length of forecasted data more then length of test data.
    #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
    lst_date <- timeID[timeID >= timeID[i]]
    lst_date_sq <- grep(
      timeID[i], timeID[(length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
    
    cat('\n')
    cat('===========================================\n')
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl
    
    sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
      dplyr::mutate(index = train_test[
        (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
        mk.price = train_test[
          (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
    
    
  } else if(i == length(timeID)) {
    
    
  } else {
    
    lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
    train <- dsmp[(lst_sq - data_len + 1):lst_sq]
    ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
    train_test <- dsmp[sq %in% ctr]
    
    sets <- train[, .(index, close)] %>% 
      tk_ts(frequency = hrz1) %>% 
      forecast(h = hrz1) %>% 
      tk_tbl %>% 
      dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                    mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
      dplyr::rename(fc.price = `Point Forecast`) %>% 
      dplyr::select(index, mk.price, fc.price)
    
    fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
    
    saveRDS(sets, fl_pth)
    
    cat(i, '=', paste0('~/data/fx/USDJPY/ts_', data_len, '_', hrz1, '.', 
                       as_date(sets$index[1]), '.rds saved!\n'))
    rm(sets)
    
  }
}
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_374400_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (374400 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (374400 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.2678
2 2016-01-04 00:02:00 120.2200 120.2542
3 2016-01-04 00:03:00 120.2200 120.2556
7198 2016-01-08 23:58:00 117.2535 120.2102
7199 2016-01-08 23:59:00 117.2420 120.2080
7200 2016-01-09 00:00:00 117.2420 120.2080

source : 7200 x 3

4.2 Exponential ts() & ets()

4.2.1 Daily Seasonal Data

4.2.1.1 Modelling

## set all models provided by ets function.
ets.m <- c('AAN', 'AAZ', 'ANN', 'ANZ', 'AZN', 'AZZ', 'MAN', 'MAZ', 'MMN', 
            'MMZ', 'MNN', 'MNZ', 'MZN', 'MZZ', 'ZAN', 'ZAZ', 'ZMN', 'ZMZ', 
            'ZNN', 'ZNZ', 'ZZN', 'ZZZ')


tseas <- function(timeID, data = dsmp, data_len, 
                  hrz1 = c(1440, 7200), hrz2 = 1440, .model) {
    
    if(hrz1 == 1440) {
      
      tmp <- llply(1:length(timeID), function(i) {
        if(i == 1) {
          
          cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
        
        
      } else if(i == length(timeID)) {
        
        
      } else  {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
          
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
      }
    })
    } else if(hrz1 == 7200) {
      
      tmp <- llply(1:length(timeID), function(i) {
        
        if(i == 1) {
          
          cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        ## filter the length of forecasted data to fit with train_test data 
        ##   when the length of forecasted data more then length of test data.
        #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
        lst_date <- timeID[timeID >= timeID[i]]
        lst_date_sq <- grep(
          timeID[i], timeID[
            (length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl
        
        sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
          dplyr::mutate(index = train_test[
            (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
            mk.price = train_test[
              (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
        
        
      } else if(i == length(timeID)) {
        
        
      } else {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
      }
      })
      
    } else {
       
      
    }
  return(tmp)
}

Refer to above function or load below r function.

## set all models provided by ets function.
ets.m <- c('AAN', 'AAZ', 'ANN', 'ANZ', 'AZN', 'AZZ', 'MAN', 'MAZ', 'MMN', 
            'MMZ', 'MNN', 'MNZ', 'MZN', 'MZZ', 'ZAN', 'ZAZ', 'ZMN', 'ZMZ', 
            'ZNN', 'ZNZ', 'ZZN', 'ZZZ')

source('function/tseas.R')

4.2.1.2 Wk >> Dy

I set the length of data as weekly (5 days * 1440 mins = 7200 mins minutes which is 5 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 7200 #last 7200  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440
hrz2 <- 1440

llply(ets.m, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_7200_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 7200 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 7200 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
1438 2016-01-04 23:58:00 119.4535 120.208
1439 2016-01-04 23:59:00 119.4450 120.208
1440 2016-01-05 00:00:00 119.4530 120.208

source : 1440 x 3

4.2.1.3 Mn >> Dy

I set the length of data as monthly (22 days * 1440 mins = 31680 mins minutes which is 22 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 22 * 1440 #last 31680  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_31680_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 31680 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 31680 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
1438 2016-01-04 23:58:00 119.4535 120.208
1439 2016-01-04 23:59:00 119.4450 120.208
1440 2016-01-05 00:00:00 119.4530 120.208

source : 1440 x 3

4.2.1.4 Qt >> Dy

I set the length of data as quarterly (3 months * 22 days * 1440 mins = 95040 mins minutes which is 66 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 3 * 22 * 1440 #last 95040  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_95040_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 95040 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 95040 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
1438 2016-01-04 23:58:00 119.4535 120.208
1439 2016-01-04 23:59:00 119.4450 120.208
1440 2016-01-05 00:00:00 119.4530 120.208

source : 1440 x 3

4.2.1.5 Yr >> Dy

I set the length of data as yearly (52 weeks * 5 days * 1440 mins = 374400 mins minutes which is 260 trading days) to forecast 1440 minutes (1440 minutes is a trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 52 * 5 * 1440 #last 374400  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 1440
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_374400_1440.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 374400 forecast 1440)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 374400 forecast 1440)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
1438 2016-01-04 23:58:00 119.4535 120.208
1439 2016-01-04 23:59:00 119.4450 120.208
1440 2016-01-05 00:00:00 119.4530 120.208

source : 1440 x 3

4.2.2 Weekly Seasonal Data

4.2.2.1 Modelling

## set all models provided by ets function.
ets.m <- c('AAN', 'AAZ', 'ANN', 'ANZ', 'AZN', 'AZZ', 'MAN', 'MAZ', 'MMN', 
            'MMZ', 'MNN', 'MNZ', 'MZN', 'MZZ', 'ZAN', 'ZAZ', 'ZMN', 'ZMZ', 
            'ZNN', 'ZNZ', 'ZZN', 'ZZZ')


tseas <- function(timeID, data = dsmp, data_len, 
                  hrz1 = c(1440, 7200), hrz2 = 1440, .model) {
    
    if(hrz1 == 1440) {
      
      tmp <- llply(1:length(timeID), function(i) {
        if(i == 1) {
          
          cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
        
        
      } else if(i == length(timeID)) {
        
        
      } else  {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
          
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
      }
    })
    } else if(hrz1 == 7200) {
      
      tmp <- llply(1:length(timeID), function(i) {
        
        if(i == 1) {
          
          cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        print(train <- dsmp[date < timeID[i]][(.N - (data_len - 1)):.N])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i > (length(timeID) - hrz1/hrz2) & i != length(timeID)) {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        ## filter the length of forecasted data to fit with train_test data 
        ##   when the length of forecasted data more then length of test data.
        #lst_date <- timeID[(length(timeID) - (hrz1/hrz2)):length(timeID)]
        lst_date <- timeID[timeID >= timeID[i]]
        lst_date_sq <- grep(
          timeID[i], timeID[
            (length(timeID) - (hrz1/hrz2 - 1)):length(timeID)])
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl
        
        sets <- sets[1:(hrz1 - (hrz2 * lst_date_sq)),] %>% 
          dplyr::mutate(index = train_test[
            (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$index, 
            mk.price = train_test[
              (.N - (hrz1 - (hrz2 * lst_date_sq)) + 1):.N, ]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
        
      } else if(i %in% seq(1, length(timeID), by = 6)[-1]) {
        
        
      } else if(i == length(timeID)) {
        
        
      } else {
        
        lst_sq <- dsmp[date < timeID[i],][.N]$sq + 1
        
        cat('\n')
        cat('===========================================\n')
        cat('train[', i, ']\n')
        
        print(train <- dsmp[(lst_sq - data_len + 1):lst_sq])
        ctr <- train$sq[1]:(range(train$sq)[2] + hrz1)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('train_test[', i, ']\n')
        
        print(train_test <- dsmp[sq %in% ctr])
        
        sets <- train[, .(index, close)] %>% 
          tk_ts(frequency = hrz1) %>% 
          ets(model = .model) %>% 
          forecast(h = hrz1) %>% 
          tk_tbl %>% 
          dplyr::mutate(index = train_test[(.N - hrz1 + 1):.N,]$index, 
                        mk.price = train_test[(.N - hrz1 + 1):.N,]$close) %>% 
          dplyr::rename(fc.price = `Point Forecast`) %>% 
          dplyr::select(index, mk.price, fc.price)
        
        cat('\n')
        cat('-------------------------------------------\n')
        cat('forecast[', i, ']\n')
        
        print(sets %>% as.data.table)
        
        fl_pth <- paste0(.dtr, 'data/fx/USDJPY/ts_ets_', data_len, 
                     '_', hrz1, '.', as_date(sets$index[1]), '.rds')
        
        saveRDS(sets, fl_pth)
        
        cat('\n')
        cat(i, '=', paste0('~/data/fx/USDJPY/ts_ets_', .model, '_', 
                           data_len, '_', hrz1, '.', 
                           as_date(sets$index[1]), '.rds saved!\n'))
        cat('\n\n')
        rm(sets)
      }
      })
      
    } else {
       
      
    }
  return(tmp)
}

Refer to above function or load below r function.

## set all models provided by ets function.
if(!exists('ets.m')) {
  ets.m <- c('AAN', 'AAZ', 'ANN', 'ANZ', 'AZN', 'AZZ', 'MAN', 'MAZ', 'MMN', 
            'MMZ', 'MNN', 'MNZ', 'MZN', 'MZZ', 'ZAN', 'ZAZ', 'ZMN', 'ZMZ', 
            'ZNN', 'ZNZ', 'ZZN', 'ZZZ') }
if(!exists('tseas')) source('function/tseas.R')

4.2.2.2 Wk >> Wk

I set the length of data as weekly (5 days * 1440 mins = 7200 mins minutes which is 22 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 7200 #last 7200  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

llply(ets.m, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_7200_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 7200 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 7200 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
7198 2016-01-08 23:58:00 117.2535 120.208
7199 2016-01-08 23:59:00 117.2420 120.208
7200 2016-01-09 00:00:00 117.2420 120.208

source : 7200 x 3

4.2.2.3 Mn >> Wk

I set the length of data as monthly (22 days * 1440 mins = 31680 mins minutes which is 22 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 22 * 1440 #last 31680  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_31680_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 31680 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 31680 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
7198 2016-01-08 23:58:00 117.2535 120.208
7199 2016-01-08 23:59:00 117.2420 120.208
7200 2016-01-09 00:00:00 117.2420 120.208

source : 7200 x 3

4.2.2.4 Qt >> Wk

I set the length of data as quarterly (3 months * 22 days * 1440 mins = 95040 mins minutes which is 66 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 3 * 22 * 1440 #last 95040  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_95040_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 95040 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 95040 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
7198 2016-01-08 23:58:00 117.2535 120.208
7199 2016-01-08 23:59:00 117.2420 120.208
7200 2016-01-09 00:00:00 117.2420 120.208

source : 7200 x 3

4.2.2.5 Yr >> Wk

I set the length of data as yearly (52 weeks * 5 days * 1440 mins = 374400 mins minutes which is 260 trading days) to forecast 7200 minutes (7200 minutes is 5 trading day).

# --------- eval=FALSE ---------
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
data_len <- 52 * 5 * 1440 #last 374400  observations dsmp[(.N - (data_len - 1)):.N]
hrz1 <- 7200
hrz2 <- 1440

## based on the report, here I retrieved back and use the best model with different data size.
bmd <- ets.m[ets.m %in% c('MNN', 'MNZ')]

llply(bmd, function(md) {
  tseas(timeID = timeID, dsmp, 
        data_len = data_len, hrz1 = hrz1, 
        hrz2 = hrz2, .model = md)
  })
smp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/ts_ets_MNN_374400_7200.2016-01-04.rds'))

data.frame(smp)[
  c(1:3, (nrow(smp)-2):nrow(smp)),] %>% 
  kbl(caption = 'Data Sample (ETS MNN 374400 forecast 7200)', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  #column_spec(3, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro', color = 'goldenrod') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample (ETS MNN 374400 forecast 7200)
index mk.price fc.price
1 2016-01-04 00:01:00 120.2200 120.208
2 2016-01-04 00:02:00 120.2200 120.208
3 2016-01-04 00:03:00 120.2200 120.208
7198 2016-01-08 23:58:00 117.2535 120.208
7199 2016-01-08 23:59:00 117.2420 120.208
7200 2016-01-09 00:00:00 117.2420 120.208

source : 7200 x 3

5 Comparison

5.1 Read Models

5.1.1 Grouped Models

Here I read the saved models.

## Get all files.
fls <- paste0(.dtr, 'data/fx/USDJPY/') %>% 
  list.files(., pattern = '^ts_')

fls_pth <- paste0(.dtr, 'data/fx/USDJPY/', fls)

mds <- ldply(1:length(fls), function(i) {
    
    nms <- fls[i] %>% 
        str_replace_all('.rds', '') %>% 
        str_split('_|\\.') %>% 
        .[[1]]
    
    if(any(str_detect(nms, 'ets'))) {
      nms <- nms
    } else {
      nms <- c(nms[1], rep(NA, 2), nms[2:length(nms)]) }
    
    names(nms) <- c('t_series', 'model', 'sub_model', 
                    'data_min', 'fc_min', 'date')
    
    datset2 <- t(nms) %>% 
      data.frame %>% 
      mutate(model =factor(model), sub_model = factor(sub_model), 
             data_min = as.numeric(data_min), 
             fc_min = as.numeric(fc_min), date = as_date(date))
    
    datset <- read_rds(fls_pth[i])
    
    res <- tibble(datset2, datset) %>% 
      dplyr::select(index, t_series, model, sub_model, data_min, 
                    fc_min, date, mk.price, fc.price)
    res <- res[!is.na('mk.price'),]
    cat(nms, '\n')
    
    return(res)
    
}) %>% 
  as_tibble

## https://tysonbarrett.com/jekyll/update/2019/10/06/datatable_memory/
## http://brooksandrew.github.io/simpleblog/articles/advanced-data-table/
## https://atrebas.github.io/post/2019-03-03-datatable-dplyr/

## Due to files size more than 1GB and over 0.1 billion observation, here I save into 4 files.
saveRDS(mds_ts, paste0(.dtr, 'data/fx/USDJPY/mds_ts.rds'))

saveRDS(mds_ets_AAN_MAZ, 
         paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ.rds'))

saveRDS(mds_ets_MMN_ZAN, 
         paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN.rds'))

saveRDS(mds_ets_ZAZ_ZZZ, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ.rds'))
mds_ts <- read_rds(
  paste0(.dtr, 'data/fx/USDJPY/mds_ts.rds'))

mds_ets_AAN_MAZ <- read_rds(
  paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ.rds'))

mds_ets_MMN_ZAN <- read_rds(
  paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN.rds'))

mds_ets_ZAZ_ZZZ <- read_rds(
  paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ.rds'))

5.1.2 Long Format

rm(list = ls())

if(!exists('mds_ts')) {
  mds_ts <- read_rds(paste0(.dtr, 'data/fx/USDJPY/mds_ts.rds')) }

mds_ts_cmp <- mds_ts %>% 
    tidyr::unite(model, c(t_series, data_min, fc_min)) %>% 
    as.data.table %>% 
    .[, .(index, model, mk.price, fc.price)]

mds_ts_cmp <- unique(mds_ts_cmp[, .(index, model, mk.price, fc.price)])

## save dataset in data.table format
saveRDS(mds_ts_cmp, paste0(.dtr, 'data/fx/USDJPY/mds_ts_cmp.rds'))

## convert to long format for plot chart
prc <- unique(mds_ts_cmp[, .(index, model, mk.price)])
prc <- prc[, model := 'actual'][]
setnames(prc, old = 'mk.price', new = 'price')
prc <- unique(prc)

mds_ts_grph <- unique(mds_ts_cmp[, .(index, model, fc.price)])
setnames(mds_ts_grph, old = 'fc.price', new = 'price')

mds_ts_grph <- rbind(mds_ts_grph, prc)
mds_ts_grph <- data.table(mds_ts_grph)[order(index)]
rm(prc)

## save dataset in data.table format
saveRDS(mds_ts_grph, paste0(.dtr, 'data/fx/USDJPY/mds_ts_grph.rds'))
rm(list = ls())

if(!exists('mds_ets_AAN_MAZ')) {
  mds_ets_AAN_MAZ <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ.rds')) }

mds_ets_AAN_MAZ_cmp <- mds_ets_AAN_MAZ %>% 
    tidyr::unite(model, t_series:fc_min) %>% #different with mds_ts_cmp
    as.data.table %>% 
    .[, .(index, model, mk.price, fc.price)]

mds_ets_AAN_MAZ_cmp <- unique(
  mds_ets_AAN_MAZ_cmp[, .(index, model, mk.price, fc.price)])

## save dataset in data.table format
saveRDS(mds_ets_AAN_MAZ_cmp, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_cmp.rds'))

## convert to long format for plot chart
prc <- unique(mds_ets_AAN_MAZ_cmp[, .(index, model, mk.price)])
prc <- prc[, model := 'actual'][]
setnames(prc, old = 'mk.price', new = 'price')
prc <- unique(prc)

mds_ets_AAN_MAZ_grph <- unique(
  mds_ets_AAN_MAZ_cmp[, .(index, model, fc.price)])
setnames(mds_ets_AAN_MAZ_grph, old = 'fc.price', new = 'price')

mds_ets_AAN_MAZ_grph <- rbind(mds_ets_AAN_MAZ_grph, prc)
mds_ets_AAN_MAZ_grph <- data.table(mds_ets_AAN_MAZ_grph)[order(index)]
rm(prc)

## save dataset in data.table format
saveRDS(mds_ets_AAN_MAZ_grph, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_grph.rds'))
rm(list = ls())

if(!exists('mds_ets_MMN_ZAN')) {
  mds_ets_MMN_ZAN <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN.rds')) }

mds_ets_MMN_ZAN_cmp <- mds_ets_MMN_ZAN %>% 
    tidyr::unite(model, t_series:fc_min) %>%  #different with mds_ts_cmp
    as.data.table %>% 
    .[, .(index, model, mk.price, fc.price)]

mds_ets_MMN_ZAN_cmp <- unique(
  mds_ets_MMN_ZAN_cmp[, .(index, model, mk.price, fc.price)])

## save dataset in data.table format
saveRDS(mds_ets_MMN_ZAN_cmp, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_cmp.rds'))

## convert to long format for plot chart
prc <- unique(mds_ets_MMN_ZAN_cmp[, .(index, model, mk.price)])
prc <- prc[, model := 'actual'][]
setnames(prc, old = 'mk.price', new = 'price')
prc <- unique(prc)

mds_ets_MMN_ZAN_grph <- unique(
  mds_ets_MMN_ZAN_cmp[, .(index, model, fc.price)])
setnames(mds_ets_MMN_ZAN_grph, old = 'fc.price', new = 'price')

mds_ets_MMN_ZAN_grph <- rbind(mds_ets_MMN_ZAN_grph, prc)
mds_ets_MMN_ZAN_grph <- data.table(mds_ets_MMN_ZAN_grph)[order(index)]
rm(prc)

## save dataset in data.table format
saveRDS(mds_ets_MMN_ZAN_grph, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_grph.rds'))
rm(list = ls())

if(!exists('mds_ets_ZAZ_ZZZ')) {
  mds_ets_ZAZ_ZZZ <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ.rds')) }

mds_ets_ZAZ_ZZZ_cmp <- mds_ets_ZAZ_ZZZ %>% 
    tidyr::unite(model, t_series:fc_min) %>%  #different with mds_ts_cmp
    as.data.table %>% 
    .[, .(index, model, mk.price, fc.price)]

mds_ets_ZAZ_ZZZ_cmp <- unique(
  mds_ets_ZAZ_ZZZ_cmp[, .(index, model, mk.price, fc.price)])

## save dataset in data.table format
saveRDS(mds_ets_ZAZ_ZZZ_cmp, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_cmp.rds'))

## convert to long format for plot chart
prc <- unique(mds_ets_ZAZ_ZZZ_cmp[, .(index, model, mk.price)])
prc <- prc[, model := 'actual'][]
setnames(prc, old = 'mk.price', new = 'price')
prc <- unique(prc)

mds_ets_ZAZ_ZZZ_grph <- unique(
  mds_ets_ZAZ_ZZZ_cmp[, .(index, model, fc.price)])
setnames(mds_ets_ZAZ_ZZZ_grph, old = 'fc.price', new = 'price')

mds_ets_ZAZ_ZZZ_grph <- rbind(mds_ets_ZAZ_ZZZ_grph, prc)
mds_ets_ZAZ_ZZZ_grph <- data.table(mds_ets_ZAZ_ZZZ_grph)[order(index)]
rm(prc)

## save dataset in data.table format
saveRDS(mds_ets_ZAZ_ZZZ_grph, 
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_grph.rds'))
if(!exists('mds_ts_grph')) {
  mds_ts_grph <- readRDS(
    paste0(.dtr, 'data/fx/USDJPY/mds_ts_grph.rds')) }

if(!exists('mds_ets_AAN_MAZ_grph')) {
  mds_ets_AAN_MAZ_grph <- readRDS(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_grph.rds')) }

if(!exists('mds_ets_MMN_ZAN_grph')) {
  mds_ets_MMN_ZAN_grph <- readRDS(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_grph.rds')) }

if(!exists('mds_ets_ZAZ_ZZZ_grph')) {
  mds_ets_ZAZ_ZZZ_grph <- readRDS(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_grph.rds')) }
data.frame(mds_ts_grph)[
  c(1:5, (nrow(mds_ts_grph)-5):nrow(mds_ts_grph)),] %>% 
  kbl(caption = 'Data Sample', escape = FALSE) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'grey') %>% 
  column_spec(3, background = '#556DAC') %>% 
  column_spec(4, background = 'LightGray', color = 'goldenrod') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Data Sample
index model price
1 2016-01-04 00:01:00 ts_31680_1440 120.2156
2 2016-01-04 00:01:00 ts_31680_7200 120.2583
3 2016-01-04 00:01:00 ts_374400_1440 120.2160
4 2016-01-04 00:01:00 ts_374400_7200 120.2678
5 2016-01-04 00:01:00 ts_7200_1440 120.1867
23411514 2018-07-07 00:00:00 ts_95040_7200 110.6870
23411515 2018-07-07 00:00:00 ts_95040_7200 110.7713
23411516 2018-07-07 00:00:00 ts_95040_7200 110.5842
23411517 2018-07-07 00:00:00 ts_95040_7200 110.4306
23411518 2018-07-07 00:00:00 ts_95040_7200 110.6256
23411519 2018-07-07 00:00:00 actual 110.4740

source : 23411519 x 3

5.2 Line Chart

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
plt <- mds_ts_grph %>% 
  ggplot(aes(x = index, y = price, group = model, color = model)) + 
  geom_line() + 

  labs(title = '1 min Open Price Forecasting', 
       subtitle = paste('From', range(unique(mds_ts_grph$index))[1L], 'to', range(unique(mds_ts_grph$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  theme(legend.position = 'right')

#ggplotly(plt)
plt

Due to the high volume of data, here I skip the line chart.

5.3 Table

5.3.1 unique(x, fromLast = FALSE) Dataset

Below table compares the models.

if(!exists('mds_ts_cmp')) {
  mds_ts_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ts_cmp.rds')) }

if(!exists('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_cmp.rds')) }

if(!exists('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_cmp.rds')) }

if(!exists('mds_ets_ZAZ_ZZZ_cmp')) {
    mds_ets_ZAZ_ZZZ_cmp <- read_rds(
      paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_cmp.rds')) }
rm(list = ls())

## report for mds_ts_cmp
if(!exists('mds_ts_cmp')) {
  mds_ts_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ts_cmp.rds')) }

if(!is.data.table('mds_ts_cmp')) mds_ts_cmp %<>% as.data.table

mds_ts_cmp <- unique(
  mds_ts_cmp, fromLast = FALSE, by = c('index', 'model'))

rp1 <- mds_ts_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ts_cmp)

## report for mds_ets_AAN_MAZ_cmp
if(!exists('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_cmp.rds')) }

if(!is.data.table('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp %<>% as.data.table }

mds_ets_AAN_MAZ_cmp <- unique(
  mds_ets_AAN_MAZ_cmp, fromLast = FALSE, by = c('index', 'model'))

rp2 <- mds_ets_AAN_MAZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_AAN_MAZ_cmp)

## report for mds_ets_MMN_ZAN_cmp
if(!exists('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_cmp.rds')) }

if(!is.data.table('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp %<>% as.data.table }

mds_ets_MMN_ZAN_cmp <- unique(
  mds_ets_MMN_ZAN_cmp, fromLast = FALSE, by = c('index', 'model'))

rp3 <- mds_ets_MMN_ZAN_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_MMN_ZAN_cmp)

## report for mds_ets_ZAZ_ZZZ_cmp
if(!exists('mds_ets_ZAZ_ZZZ_cmp')) {
    mds_ets_ZAZ_ZZZ_cmp <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_cmp.rds')) }

if(!is.data.table('mds_ets_ZAZ_ZZZ_cmp')) {
  mds_ets_ZAZ_ZZZ_cmp %<>% as.data.table }

mds_ets_ZAZ_ZZZ_cmp <- unique(
  mds_ets_ZAZ_ZZZ_cmp, fromLast = FALSE, by = c('index', 'model'))

rp4 <- mds_ets_ZAZ_ZZZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_ZAZ_ZZZ_cmp)

## report
rp_fLF <- rbindlist(list(rp1, rp2, rp3, rp4), idcol = TRUE)

rm(rp1, rp2, rp3, rp4)
saveRDS(rp_fLF, paste0(.dtr, 'data/fx/USDJPY/rp_fLF.rds'))
rp_fLF <- readRDS(paste0(.dtr, 'data/fx/USDJPY/rp_fLF.rds'))

rp_tbl <- rp_fLF %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (Forecasted Up to Max 7200 mins)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'Gainsboro') %>% 
  column_spec(5, background = 'LightGray') %>% 
  column_spec(6, background = 'Gainsboro') %>% 
  column_spec(7, background = 'LightGray') %>% 
  column_spec(8, background = 'Gainsboro') %>%  
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')

rp_tbl
Accurcy Report (Forecasted Up to Max 7200 mins)
.id model N mae mape rmse smape mse
1 ts_31680_1440 939600 0.3336882 (rank: 14) 0.003041 (rank: 14) 0.5028729 (rank: 15) 0.0030394 (rank: 14) 0.2528812 (rank: 15)
1 ts_31680_7200 943200 1.1483249 (rank: 35) 0.0104733 (rank: 35) 1.4967977 (rank: 31) 0.0104602 (rank: 35) 2.2404033 (rank: 31)
1 ts_374400_1440 936720 0.3337486 (rank: 15) 0.0030412 (rank: 15) 0.5016744 (rank: 14) 0.0030396 (rank: 15) 0.2516772 (rank: 14)
1 ts_374400_7200 943200 1.1400725 (rank: 33) 0.0103982 (rank: 33) 1.4841219 (rank: 29) 0.010385 (rank: 33) 2.2026179 (rank: 29)
1 ts_7200_1440 939600 0.3479153 (rank: 22) 0.0031706 (rank: 22) 0.5176921 (rank: 22) 0.003169 (rank: 22) 0.2680051 (rank: 22)
1 ts_7200_7200 943200 1.1691409 (rank: 40) 0.0106677 (rank: 40) 1.5947345 (rank: 36) 0.0106643 (rank: 40) 2.5431782 (rank: 36)
1 ts_95040_1440 939600 0.332894 (rank: 13) 0.0030334 (rank: 13) 0.5008463 (rank: 13) 0.0030318 (rank: 13) 0.250847 (rank: 13)
1 ts_95040_7200 943200 1.1403128 (rank: 34) 0.0104004 (rank: 34) 1.4846362 (rank: 30) 0.0103871 (rank: 34) 2.2041445 (rank: 30)
2 ts_ets_AAN_7200_1440 939600 0.3390357 (rank: 18) 0.0030911 (rank: 18) 0.5119972 (rank: 18) 0.0030893 (rank: 18) 0.2621411 (rank: 18)
2 ts_ets_AAN_7200_7200 943200 1.4008041 (rank: 46) 0.0127827 (rank: 46) 1.8521873 (rank: 42) 0.012783 (rank: 46) 3.4305979 (rank: 42)
2 ts_ets_AAZ_7200_1440 939600 0.3390357 (rank: 18) 0.0030911 (rank: 18) 0.5119972 (rank: 18) 0.0030893 (rank: 18) 0.2621411 (rank: 18)
2 ts_ets_AAZ_7200_7200 943200 1.4008041 (rank: 46) 0.0127827 (rank: 46) 1.8521873 (rank: 42) 0.012783 (rank: 46) 3.4305979 (rank: 42)
2 ts_ets_ANN_7200_1440 939600 0.3240889 (rank: 4) 0.0029543 (rank: 4) 0.4914095 (rank: 4) 0.0029522 (rank: 4) 0.2414833 (rank: 4)
2 ts_ets_ANN_7200_7200 943200 1.1299164 (rank: 30) 0.0103074 (rank: 30) 1.4733316 (rank: 28) 0.0102933 (rank: 30) 2.170706 (rank: 28)
2 ts_ets_ANZ_7200_1440 939600 0.3240889 (rank: 4) 0.0029543 (rank: 4) 0.4914095 (rank: 4) 0.0029522 (rank: 4) 0.2414833 (rank: 4)
2 ts_ets_ANZ_7200_7200 943200 1.1299164 (rank: 30) 0.0103074 (rank: 30) 1.4733316 (rank: 28) 0.0102933 (rank: 30) 2.170706 (rank: 28)
2 ts_ets_AZN_7200_1440 939600 0.3276108 (rank: 10) 0.0029866 (rank: 10) 0.4989948 (rank: 8) 0.0029849 (rank: 10) 0.2489958 (rank: 8)
2 ts_ets_AZN_7200_7200 943200 1.1625322 (rank: 36) 0.0106062 (rank: 36) 1.5735051 (rank: 32) 0.0106055 (rank: 36) 2.4759185 (rank: 32)
2 ts_ets_AZZ_7200_1440 939600 0.3276108 (rank: 10) 0.0029866 (rank: 10) 0.4989948 (rank: 8) 0.0029849 (rank: 10) 0.2489958 (rank: 8)
2 ts_ets_AZZ_7200_7200 943200 1.1625322 (rank: 36) 0.0106062 (rank: 36) 1.5735051 (rank: 32) 0.0106055 (rank: 36) 2.4759185 (rank: 32)
2 ts_ets_MAN_7200_1440 939600 0.3379382 (rank: 16) 0.0030801 (rank: 16) 0.509094 (rank: 16) 0.0030784 (rank: 16) 0.2591767 (rank: 16)
2 ts_ets_MAN_7200_7200 943200 1.3851958 (rank: 44) 0.01264 (rank: 44) 1.8312269 (rank: 40) 0.012639 (rank: 44) 3.3533921 (rank: 40)
2 ts_ets_MAZ_7200_1440 939600 0.3379382 (rank: 16) 0.0030801 (rank: 16) 0.509094 (rank: 16) 0.0030784 (rank: 16) 0.2591767 (rank: 16)
2 ts_ets_MAZ_7200_7200 943200 1.3851958 (rank: 44) 0.01264 (rank: 44) 1.8312269 (rank: 40) 0.012639 (rank: 44) 3.3533921 (rank: 40)
3 ts_ets_MMN_7200_1440 939600 0.6843001 (rank: 24) 0.0061446 (rank: 24) 6.2792276 (rank: 46) 0.0092064 (rank: 24) 39.4286992 (rank: 46)
3 ts_ets_MMN_7200_7200 943200 2.3410647 (rank: 50) 0.0211614 (rank: 50) 10.4545134 (rank: 50) 0.0295405 (rank: 50) 109.2968513 (rank: 50)
3 ts_ets_MMZ_7200_1440 939600 0.6843001 (rank: 24) 0.0061446 (rank: 24) 6.2792276 (rank: 46) 0.0092064 (rank: 24) 39.4286992 (rank: 46)
3 ts_ets_MMZ_7200_7200 943200 2.3410647 (rank: 50) 0.0211614 (rank: 50) 10.4545134 (rank: 50) 0.0295405 (rank: 50) 109.2968513 (rank: 50)
3 ts_ets_MNN_7200_1440 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNN_7200_7200 943200 1.1299161 (rank: 28) 0.0103074 (rank: 28) 1.4733315 (rank: 24) 0.0102933 (rank: 28) 2.1707056 (rank: 24)
3 ts_ets_MNZ_7200_1440 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNZ_7200_7200 943200 1.1299161 (rank: 28) 0.0103074 (rank: 28) 1.4733315 (rank: 24) 0.0102933 (rank: 28) 2.1707056 (rank: 24)
3 ts_ets_MZN_7200_1440 939600 0.327249 (rank: 8) 0.0029836 (rank: 8) 0.4990904 (rank: 10) 0.0029818 (rank: 8) 0.2490913 (rank: 10)
3 ts_ets_MZN_7200_7200 943200 1.1701255 (rank: 42) 0.0106762 (rank: 42) 1.5966929 (rank: 38) 0.0106734 (rank: 42) 2.5494281 (rank: 38)
3 ts_ets_MZZ_7200_1440 939600 0.327249 (rank: 8) 0.0029836 (rank: 8) 0.4990904 (rank: 10) 0.0029818 (rank: 8) 0.2490913 (rank: 10)
3 ts_ets_MZZ_7200_7200 943200 1.1701255 (rank: 42) 0.0106762 (rank: 42) 1.5966929 (rank: 38) 0.0106734 (rank: 42) 2.5494281 (rank: 38)
3 ts_ets_ZAN_7200_1440 939600 0.3404513 (rank: 20) 0.0031039 (rank: 20) 0.5134091 (rank: 20) 0.0031021 (rank: 20) 0.2635889 (rank: 20)
3 ts_ets_ZAN_7200_7200 943200 1.4043051 (rank: 48) 0.0128149 (rank: 48) 1.8526167 (rank: 44) 0.0128123 (rank: 48) 3.4321888 (rank: 44)
4 ts_ets_ZAZ_7200_1440 939600 0.3404513 (rank: 20) 0.0031039 (rank: 20) 0.5134091 (rank: 20) 0.0031021 (rank: 20) 0.2635889 (rank: 20)
4 ts_ets_ZAZ_7200_7200 943200 1.4043051 (rank: 48) 0.0128149 (rank: 48) 1.8526167 (rank: 44) 0.0128123 (rank: 48) 3.4321888 (rank: 44)
4 ts_ets_ZMN_7200_1440 939600 0.6843001 (rank: 24) 0.0061446 (rank: 24) 6.2792276 (rank: 46) 0.0092064 (rank: 24) 39.4286992 (rank: 46)
4 ts_ets_ZMN_7200_7200 943200 2.3410647 (rank: 50) 0.0211614 (rank: 50) 10.4545134 (rank: 50) 0.0295405 (rank: 50) 109.2968513 (rank: 50)
4 ts_ets_ZMZ_7200_1440 939600 0.6843001 (rank: 24) 0.0061446 (rank: 24) 6.2792276 (rank: 46) 0.0092064 (rank: 24) 39.4286992 (rank: 46)
4 ts_ets_ZMZ_7200_7200 943200 2.3410647 (rank: 50) 0.0211614 (rank: 50) 10.4545134 (rank: 50) 0.0295405 (rank: 50) 109.2968513 (rank: 50)
4 ts_ets_ZNN_7200_1440 939600 0.324089 (rank: 6) 0.0029543 (rank: 6) 0.4914098 (rank: 6) 0.0029522 (rank: 6) 0.2414836 (rank: 6)
4 ts_ets_ZNN_7200_7200 943200 1.1299164 (rank: 32) 0.0103074 (rank: 32) 1.4733316 (rank: 26) 0.0102933 (rank: 32) 2.170706 (rank: 26)
4 ts_ets_ZNZ_7200_1440 939600 0.324089 (rank: 6) 0.0029543 (rank: 6) 0.4914098 (rank: 6) 0.0029522 (rank: 6) 0.2414836 (rank: 6)
4 ts_ets_ZNZ_7200_7200 943200 1.1299164 (rank: 32) 0.0103074 (rank: 32) 1.4733316 (rank: 26) 0.0102933 (rank: 32) 2.170706 (rank: 26)
4 ts_ets_ZZN_7200_1440 939600 0.3279704 (rank: 12) 0.0029899 (rank: 12) 0.5000001 (rank: 12) 0.0029881 (rank: 12) 0.2500001 (rank: 12)
4 ts_ets_ZZN_7200_7200 943200 1.1688756 (rank: 38) 0.0106653 (rank: 38) 1.5947008 (rank: 34) 0.0106619 (rank: 38) 2.5430706 (rank: 34)
4 ts_ets_ZZZ_7200_1440 939600 0.3279704 (rank: 12) 0.0029899 (rank: 12) 0.5000001 (rank: 12) 0.0029881 (rank: 12) 0.2500001 (rank: 12)
4 ts_ets_ZZZ_7200_7200 943200 1.1688756 (rank: 38) 0.0106653 (rank: 38) 1.5947008 (rank: 34) 0.0106619 (rank: 38) 2.5430706 (rank: 34)

source :

from above models we know the βest model.

5.3.2 unique(x, fromLast = TRUE) Dataset

Below table compares the models.

if(!exists('mds_ts_cmp')) {
  mds_ts_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ts_cmp.rds')) }

if(!exists('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_cmp.rds')) }

if(!exists('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_cmp.rds')) }

if(!exists('mds_ets_ZAZ_ZZZ_cmp')) {
    mds_ets_ZAZ_ZZZ_cmp <- read_rds(
      paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_cmp.rds')) }
rm(list = ls())

## report for mds_ts_cmp
if(!exists('mds_ts_cmp')) {
  mds_ts_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ts_cmp.rds')) }

if(!is.data.table('mds_ts_cmp')) mds_ts_cmp %<>% as.data.table

mds_ts_cmp <- unique(
  mds_ts_cmp, fromLast = TRUE, by = c('index', 'model'))

rp1 <- mds_ts_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ts_cmp)

## report for mds_ets_AAN_MAZ_cmp
if(!exists('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_AAN_MAZ_cmp.rds')) }

if(!is.data.table('mds_ets_AAN_MAZ_cmp')) {
  mds_ets_AAN_MAZ_cmp %<>% as.data.table }

mds_ets_AAN_MAZ_cmp <- unique(
  mds_ets_AAN_MAZ_cmp, fromLast = TRUE, by = c('index', 'model'))

rp2 <- mds_ets_AAN_MAZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_AAN_MAZ_cmp)

## report for mds_ets_MMN_ZAN_cmp
if(!exists('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/mds_ets_MMN_ZAN_cmp.rds')) }

if(!is.data.table('mds_ets_MMN_ZAN_cmp')) {
  mds_ets_MMN_ZAN_cmp %<>% as.data.table }

mds_ets_MMN_ZAN_cmp <- unique(
  mds_ets_MMN_ZAN_cmp, fromLast = TRUE, by = c('index', 'model'))

rp3 <- mds_ets_MMN_ZAN_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_MMN_ZAN_cmp)

## report for mds_ets_ZAZ_ZZZ_cmp
if(!exists('mds_ets_ZAZ_ZZZ_cmp')) {
    mds_ets_ZAZ_ZZZ_cmp <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/mds_ets_ZAZ_ZZZ_cmp.rds')) }

if(!is.data.table('mds_ets_ZAZ_ZZZ_cmp')) {
  mds_ets_ZAZ_ZZZ_cmp %<>% as.data.table }

mds_ets_ZAZ_ZZZ_cmp <- unique(
  mds_ets_ZAZ_ZZZ_cmp, fromLast = TRUE, by = c('index', 'model'))

rp4 <- mds_ets_ZAZ_ZZZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(mds_ets_ZAZ_ZZZ_cmp)

## report
rp_fLT <- rbindlist(list(rp1, rp2, rp3, rp4), idcol = TRUE)

rm(rp1, rp2, rp3, rp4)
saveRDS(rp_fLT, paste0(.dtr, 'data/fx/USDJPY/rp_fLT.rds'))
rp_fLT <- readRDS(paste0(.dtr, 'data/fx/USDJPY/rp_fLT.rds'))

rp_tbl <- rp_fLT %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (Forecasted 1440 mins)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'Gainsboro') %>% 
  column_spec(5, background = 'LightGray') %>% 
  column_spec(6, background = 'Gainsboro') %>% 
  column_spec(7, background = 'LightGray') %>% 
  column_spec(8, background = 'Gainsboro') %>%  
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')

rp_tbl
Accurcy Report (Forecasted 1440 mins)
.id model N mae mape rmse smape mse
1 ts_31680_1440 939600 0.3336882 (rank: 27) 0.003041 (rank: 27) 0.5028729 (rank: 28) 0.0030394 (rank: 27) 0.2528812 (rank: 28)
1 ts_31680_7200 943200 0.3891261 (rank: 44) 0.0035455 (rank: 44) 0.5578474 (rank: 44) 0.0035441 (rank: 44) 0.3111937 (rank: 44)
1 ts_374400_1440 936720 0.3337486 (rank: 28) 0.0030412 (rank: 28) 0.5016744 (rank: 27) 0.0030396 (rank: 28) 0.2516772 (rank: 27)
1 ts_374400_7200 943200 0.3508013 (rank: 42) 0.0031978 (rank: 42) 0.5158048 (rank: 41) 0.0031963 (rank: 42) 0.2660545 (rank: 41)
1 ts_7200_1440 939600 0.3479153 (rank: 41) 0.0031706 (rank: 41) 0.5176921 (rank: 43) 0.003169 (rank: 41) 0.2680051 (rank: 43)
1 ts_7200_7200 943200 0.3290184 (rank: 25) 0.0029989 (rank: 25) 0.5005928 (rank: 25) 0.0029972 (rank: 25) 0.2505932 (rank: 25)
1 ts_95040_1440 939600 0.332894 (rank: 26) 0.0030334 (rank: 26) 0.5008463 (rank: 26) 0.0030318 (rank: 26) 0.250847 (rank: 26)
1 ts_95040_7200 943200 0.3511466 (rank: 43) 0.0032007 (rank: 43) 0.5163419 (rank: 42) 0.0031991 (rank: 43) 0.266609 (rank: 42)
2 ts_ets_AAN_7200_1440 939600 0.3390357 (rank: 34) 0.0030911 (rank: 34) 0.5119972 (rank: 34) 0.0030893 (rank: 34) 0.2621411 (rank: 34)
2 ts_ets_AAN_7200_7200 943200 0.3396273 (rank: 36) 0.003096 (rank: 36) 0.5123186 (rank: 36) 0.0030943 (rank: 36) 0.2624704 (rank: 36)
2 ts_ets_AAZ_7200_1440 939600 0.3390357 (rank: 34) 0.0030911 (rank: 34) 0.5119972 (rank: 34) 0.0030893 (rank: 34) 0.2621411 (rank: 34)
2 ts_ets_AAZ_7200_7200 943200 0.3396273 (rank: 36) 0.003096 (rank: 36) 0.5123186 (rank: 36) 0.0030943 (rank: 36) 0.2624704 (rank: 36)
2 ts_ets_ANN_7200_1440 939600 0.3240889 (rank: 4) 0.0029543 (rank: 4) 0.4914095 (rank: 4) 0.0029522 (rank: 4) 0.2414833 (rank: 4)
2 ts_ets_ANN_7200_7200 943200 0.324858 (rank: 10) 0.0029608 (rank: 10) 0.4919174 (rank: 10) 0.0029588 (rank: 10) 0.2419827 (rank: 10)
2 ts_ets_ANZ_7200_1440 939600 0.3240889 (rank: 4) 0.0029543 (rank: 4) 0.4914095 (rank: 4) 0.0029522 (rank: 4) 0.2414833 (rank: 4)
2 ts_ets_ANZ_7200_7200 943200 0.324858 (rank: 10) 0.0029608 (rank: 10) 0.4919174 (rank: 10) 0.0029588 (rank: 10) 0.2419827 (rank: 10)
2 ts_ets_AZN_7200_1440 939600 0.3276108 (rank: 16) 0.0029866 (rank: 16) 0.4989948 (rank: 14) 0.0029849 (rank: 16) 0.2489958 (rank: 14)
2 ts_ets_AZN_7200_7200 943200 0.3283665 (rank: 22) 0.002993 (rank: 22) 0.4994662 (rank: 18) 0.0029913 (rank: 22) 0.2494665 (rank: 18)
2 ts_ets_AZZ_7200_1440 939600 0.3276108 (rank: 16) 0.0029866 (rank: 16) 0.4989948 (rank: 14) 0.0029849 (rank: 16) 0.2489958 (rank: 14)
2 ts_ets_AZZ_7200_7200 943200 0.3283665 (rank: 22) 0.002993 (rank: 22) 0.4994662 (rank: 18) 0.0029913 (rank: 22) 0.2494665 (rank: 18)
2 ts_ets_MAN_7200_1440 939600 0.3379382 (rank: 30) 0.0030801 (rank: 30) 0.509094 (rank: 30) 0.0030784 (rank: 30) 0.2591767 (rank: 30)
2 ts_ets_MAN_7200_7200 943200 0.3385145 (rank: 32) 0.0030849 (rank: 32) 0.5094176 (rank: 32) 0.0030833 (rank: 32) 0.2595063 (rank: 32)
2 ts_ets_MAZ_7200_1440 939600 0.3379382 (rank: 30) 0.0030801 (rank: 30) 0.509094 (rank: 30) 0.0030784 (rank: 30) 0.2591767 (rank: 30)
2 ts_ets_MAZ_7200_7200 943200 0.3385145 (rank: 32) 0.0030849 (rank: 32) 0.5094176 (rank: 32) 0.0030833 (rank: 32) 0.2595063 (rank: 32)
3 ts_ets_MMN_7200_1440 939600 0.6843001 (rank: 46) 0.0061446 (rank: 46) 6.2792276 (rank: 46) 0.0092064 (rank: 46) 39.4286992 (rank: 46)
3 ts_ets_MMN_7200_7200 943200 0.8552402 (rank: 50) 0.0076554 (rank: 50) 7.6704732 (rank: 50) 0.0122341 (rank: 50) 58.8361596 (rank: 50)
3 ts_ets_MMZ_7200_1440 939600 0.6843001 (rank: 46) 0.0061446 (rank: 46) 6.2792276 (rank: 46) 0.0092064 (rank: 46) 39.4286992 (rank: 46)
3 ts_ets_MMZ_7200_7200 943200 0.8552402 (rank: 50) 0.0076554 (rank: 50) 7.6704732 (rank: 50) 0.0122341 (rank: 50) 58.8361596 (rank: 50)
3 ts_ets_MNN_7200_1440 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNN_7200_7200 943200 0.3248577 (rank: 8) 0.0029608 (rank: 8) 0.4919172 (rank: 8) 0.0029588 (rank: 8) 0.2419825 (rank: 8)
3 ts_ets_MNZ_7200_1440 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNZ_7200_7200 943200 0.3248577 (rank: 8) 0.0029608 (rank: 8) 0.4919172 (rank: 8) 0.0029588 (rank: 8) 0.2419825 (rank: 8)
3 ts_ets_MZN_7200_1440 939600 0.327249 (rank: 14) 0.0029836 (rank: 14) 0.4990904 (rank: 16) 0.0029818 (rank: 14) 0.2490913 (rank: 16)
3 ts_ets_MZN_7200_7200 943200 0.328006 (rank: 20) 0.00299 (rank: 20) 0.4995615 (rank: 20) 0.0029883 (rank: 20) 0.2495616 (rank: 20)
3 ts_ets_MZZ_7200_1440 939600 0.327249 (rank: 14) 0.0029836 (rank: 14) 0.4990904 (rank: 16) 0.0029818 (rank: 14) 0.2490913 (rank: 16)
3 ts_ets_MZZ_7200_7200 943200 0.328006 (rank: 20) 0.00299 (rank: 20) 0.4995615 (rank: 20) 0.0029883 (rank: 20) 0.2495616 (rank: 20)
3 ts_ets_ZAN_7200_1440 939600 0.3404513 (rank: 38) 0.0031039 (rank: 38) 0.5134091 (rank: 38) 0.0031021 (rank: 38) 0.2635889 (rank: 38)
3 ts_ets_ZAN_7200_7200 943200 0.3410375 (rank: 40) 0.0031088 (rank: 40) 0.5137242 (rank: 40) 0.003107 (rank: 40) 0.2639126 (rank: 40)
4 ts_ets_ZAZ_7200_1440 939600 0.3404513 (rank: 38) 0.0031039 (rank: 38) 0.5134091 (rank: 38) 0.0031021 (rank: 38) 0.2635889 (rank: 38)
4 ts_ets_ZAZ_7200_7200 943200 0.3410375 (rank: 40) 0.0031088 (rank: 40) 0.5137242 (rank: 40) 0.003107 (rank: 40) 0.2639126 (rank: 40)
4 ts_ets_ZMN_7200_1440 939600 0.6843001 (rank: 46) 0.0061446 (rank: 46) 6.2792276 (rank: 46) 0.0092064 (rank: 46) 39.4286992 (rank: 46)
4 ts_ets_ZMN_7200_7200 943200 0.8552402 (rank: 50) 0.0076554 (rank: 50) 7.6704732 (rank: 50) 0.0122341 (rank: 50) 58.8361596 (rank: 50)
4 ts_ets_ZMZ_7200_1440 939600 0.6843001 (rank: 46) 0.0061446 (rank: 46) 6.2792276 (rank: 46) 0.0092064 (rank: 46) 39.4286992 (rank: 46)
4 ts_ets_ZMZ_7200_7200 943200 0.8552402 (rank: 50) 0.0076554 (rank: 50) 7.6704732 (rank: 50) 0.0122341 (rank: 50) 58.8361596 (rank: 50)
4 ts_ets_ZNN_7200_1440 939600 0.324089 (rank: 6) 0.0029543 (rank: 6) 0.4914098 (rank: 6) 0.0029522 (rank: 6) 0.2414836 (rank: 6)
4 ts_ets_ZNN_7200_7200 943200 0.3248581 (rank: 12) 0.0029608 (rank: 12) 0.4919177 (rank: 12) 0.0029588 (rank: 12) 0.241983 (rank: 12)
4 ts_ets_ZNZ_7200_1440 939600 0.324089 (rank: 6) 0.0029543 (rank: 6) 0.4914098 (rank: 6) 0.0029522 (rank: 6) 0.2414836 (rank: 6)
4 ts_ets_ZNZ_7200_7200 943200 0.3248581 (rank: 12) 0.0029608 (rank: 12) 0.4919177 (rank: 12) 0.0029588 (rank: 12) 0.241983 (rank: 12)
4 ts_ets_ZZN_7200_1440 939600 0.3279704 (rank: 18) 0.0029899 (rank: 18) 0.5000001 (rank: 22) 0.0029881 (rank: 18) 0.2500001 (rank: 22)
4 ts_ets_ZZN_7200_7200 943200 0.3287247 (rank: 24) 0.0029962 (rank: 24) 0.5004668 (rank: 24) 0.0029945 (rank: 24) 0.250467 (rank: 24)
4 ts_ets_ZZZ_7200_1440 939600 0.3279704 (rank: 18) 0.0029899 (rank: 18) 0.5000001 (rank: 22) 0.0029881 (rank: 18) 0.2500001 (rank: 22)
4 ts_ets_ZZZ_7200_7200 943200 0.3287247 (rank: 24) 0.0029962 (rank: 24) 0.5004668 (rank: 24) 0.0029945 (rank: 24) 0.250467 (rank: 24)

source :

from above models we know the βest model.

5.3.3 Summary

rp_fLF <- rp_fLF[, arrange := 'from_first'][]
rp_fLT <- rp_fLT[, arrange := 'from_last'][]

rp <- rbindlist(list(rp_fLF, rp_fLT))
rp <- rp[, .(.id, model, arrange, N, mae, mape, rmse, smape, mse)]
rp %<>% unique

sum <- rp[mae == min(mae) | mape == min(mape) | rmse == min(rmse) | smape == min(smape) | mse == min(mse)]

sum %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (Initial Stage Comparison)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'grey') %>% 
  column_spec(4, background = 'LightSlateGrey') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  column_spec(7, background = 'Gainsboro') %>% 
  column_spec(8, background = 'LightGray') %>% 
  column_spec(9, background = 'Gainsboro') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Accurcy Report (Initial Stage Comparison)
.id model arrange N mae mape rmse smape mse
3 ts_ets_MNN_7200_1440 from_first 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNZ_7200_1440 from_first 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNN_7200_1440 from_last 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)
3 ts_ets_MNZ_7200_1440 from_last 939600 0.3240886 (rank: 2) 0.0029543 (rank: 2) 0.4914093 (rank: 2) 0.0029522 (rank: 2) 0.2414831 (rank: 2)

source : 4 x 9

6 Conclusion

6.1 Initial Summary

From initial stage models comparison, we know that ts_ets_MNN_7200_1440 and ts_ets_MNZ_7200_1440 is the βest model.

6.2 Small Adjustment

rp_ts <- rp[, {
    .SD[, .(model = model, 
            ts = str_detect(model, '^ts_[0-9]'), 
            arrange = arrange, 
            mae = mae, 
            mape = mape, 
            rmse = rmse, 
            smape = smape, 
            mse = mse), ]}][ts == TRUE, !('ts')]
rp_ts %<>% unique

rp_ts %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (time series)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  column_spec(7, background = 'Gainsboro') %>%  
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
Accurcy Report (time series)
model arrange mae mape rmse smape mse
ts_31680_1440 from_first 0.3336882 (rank: 4) 0.003041 (rank: 4) 0.5028729 (rank: 6) 0.0030394 (rank: 4) 0.2528812 (rank: 6)
ts_31680_7200 from_first 1.1483249 (rank: 15) 0.0104733 (rank: 15) 1.4967977 (rank: 15) 0.0104602 (rank: 15) 2.2404033 (rank: 15)
ts_374400_1440 from_first 0.3337486 (rank: 6) 0.0030412 (rank: 6) 0.5016744 (rank: 4) 0.0030396 (rank: 6) 0.2516772 (rank: 4)
ts_374400_7200 from_first 1.1400725 (rank: 13) 0.0103982 (rank: 13) 1.4841219 (rank: 13) 0.010385 (rank: 13) 2.2026179 (rank: 13)
ts_7200_1440 from_first 0.3479153 (rank: 8) 0.0031706 (rank: 8) 0.5176921 (rank: 10) 0.003169 (rank: 8) 0.2680051 (rank: 10)
ts_7200_7200 from_first 1.1691409 (rank: 16) 0.0106677 (rank: 16) 1.5947345 (rank: 16) 0.0106643 (rank: 16) 2.5431782 (rank: 16)
ts_95040_1440 from_first 0.332894 (rank: 2) 0.0030334 (rank: 2) 0.5008463 (rank: 2) 0.0030318 (rank: 2) 0.250847 (rank: 2)
ts_95040_7200 from_first 1.1403128 (rank: 14) 0.0104004 (rank: 14) 1.4846362 (rank: 14) 0.0103871 (rank: 14) 2.2041445 (rank: 14)
ts_31680_1440 from_last 0.3336882 (rank: 4) 0.003041 (rank: 4) 0.5028729 (rank: 6) 0.0030394 (rank: 4) 0.2528812 (rank: 6)
ts_31680_7200 from_last 0.3891261 (rank: 12) 0.0035455 (rank: 12) 0.5578474 (rank: 12) 0.0035441 (rank: 12) 0.3111937 (rank: 12)
ts_374400_1440 from_last 0.3337486 (rank: 6) 0.0030412 (rank: 6) 0.5016744 (rank: 4) 0.0030396 (rank: 6) 0.2516772 (rank: 4)
ts_374400_7200 from_last 0.3508013 (rank: 10) 0.0031978 (rank: 10) 0.5158048 (rank: 8) 0.0031963 (rank: 10) 0.2660545 (rank: 8)
ts_7200_1440 from_last 0.3479153 (rank: 8) 0.0031706 (rank: 8) 0.5176921 (rank: 10) 0.003169 (rank: 8) 0.2680051 (rank: 10)
ts_7200_7200 from_last 0.3290184 (rank: 1) 0.0029989 (rank: 1) 0.5005928 (rank: 1) 0.0029972 (rank: 1) 0.2505932 (rank: 1)
ts_95040_1440 from_last 0.332894 (rank: 2) 0.0030334 (rank: 2) 0.5008463 (rank: 2) 0.0030318 (rank: 2) 0.250847 (rank: 2)
ts_95040_7200 from_last 0.3511466 (rank: 11) 0.0032007 (rank: 11) 0.5163419 (rank: 9) 0.0031991 (rank: 11) 0.266609 (rank: 9)

source : 16 x 7

As we can know from ts Here I use the βest model but adjust the data size to compare.

## Get all MNN & MNZ files.
MNN_MNZ <- list.files(paste0(.dtr, 'data/fx/USDJPY'), pattern = '^ts_ets_MNN|^ts_ets_MNZ')
fls_pth <- paste0(.dtr, 'data/fx/USDJPY/', MNN_MNZ)

## read files
ex_mds_ets_MNN_MNZ <- ldply(1:length(MNN_MNZ), function(i) {
    
    nms <- MNN_MNZ[i] %>% 
        str_replace_all('^ex_|.rds$', '') %>% 
        str_split('_|\\.') %>% 
        .[[1]]
    
    if(any(str_detect(nms, 'ets'))) {
      nms <- nms
    } else {
      nms <- c(nms[1], rep(NA, 2), nms[2:length(nms)]) }
    
    names(nms) <- c('t_series', 'model', 'sub_model', 
                    'data_min', 'fc_min', 'date')
    
    datset2 <- t(nms) %>% 
      data.frame %>% 
      mutate(model =factor(model), sub_model = factor(sub_model), 
             data_min = as.numeric(data_min), 
             fc_min = as.numeric(fc_min), date = as_date(date))
    
    datset <- read_rds(fls_pth[i])
    
    res <- tibble(datset2, datset) %>% 
      dplyr::select(index, t_series, model, sub_model, data_min, 
                    fc_min, date, mk.price, fc.price)
    res <- res[!is.na('mk.price'),]
    cat(nms, '\n')
    
    return(res)
    
}) %>% 
  as_tibble

saveRDS(ex_mds_ets_MNN_MNZ, 
         paste0(.dtr, 'data/fx/USDJPY/ex_mds_ets_MNN_MNZ.rds'))

rm(list = ls())

## MNN & MNZ ets models
if(!exists('ex_mds_ets_MNN_MNZ')) {
  ex_mds_ets_MNN_MNZ <- read_rds(
    paste0(.dtr, 'data/fx/USDJPY/ex_mds_ets_MNN_MNZ.rds')) }

ex_mds_ets_MNN_MNZ_cmp <- ex_mds_ets_MNN_MNZ %>% 
    tidyr::unite(model, t_series:fc_min) %>%  #different with mds_ts_cmp
    as.data.table %>% 
    .[, .(index, model, mk.price, fc.price)]

ex_mds_ets_MNN_MNZ_cmp <- unique(
  ex_mds_ets_MNN_MNZ_cmp[, .(index, model, mk.price, fc.price)])

## save dataset in data.table format
saveRDS(ex_mds_ets_MNN_MNZ_cmp, 
        paste0(.dtr, 'data/fx/USDJPY/ex_mds_ets_MNN_MNZ_cmp.rds'))

MNN_MNZ_rp_fLF

rm(list = ls())

## report for ex_mds_ets_MNN_MNZ_cmp
if(!exists('ex_mds_ets_MNN_MNZ_cmp')) {
    ex_mds_ets_MNN_MNZ_cmp <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/ex_mds_ets_MNN_MNZ_cmp.rds')) }

if(!is.data.table('ex_mds_ets_MNN_MNZ_cmp')) {
  ex_mds_ets_MNN_MNZ_cmp %<>% as.data.table }

ex_mds_ets_MNN_MNZ_cmp <- unique(
  ex_mds_ets_MNN_MNZ_cmp, fromLast = FALSE, by = c('index', 'model')) %>% 
  na.omit

MNN_MNZ_rp_fLF <- ex_mds_ets_MNN_MNZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(ex_mds_ets_MNN_MNZ_cmp)

## report
saveRDS(MNN_MNZ_rp_fLF, paste0(.dtr, 'data/fx/USDJPY/MNN_MNZ_rp_fLF.rds'))

MNN_MNZ_rp_fLT

rm(list = ls())

## report for ex_mds_ets_MNN_MNZ_cmp
if(!exists('ex_mds_ets_MNN_MNZ_cmp')) {
    ex_mds_ets_MNN_MNZ_cmp <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/ex_mds_ets_MNN_MNZ_cmp.rds')) }

if(!is.data.table('ex_mds_ets_MNN_MNZ_cmp')) {
  ex_mds_ets_MNN_MNZ_cmp %<>% as.data.table }

ex_mds_ets_MNN_MNZ_cmp <- unique(
  ex_mds_ets_MNN_MNZ_cmp, fromLast = TRUE, by = c('index', 'model')) %>% 
  na.omit

MNN_MNZ_rp_fLT <- ex_mds_ets_MNN_MNZ_cmp[, {
  mk.price = mk.price
  fc.price = fc.price
  .SD[, .(.N, 
          mae = MLmetrics::MAE(y_true = mk.price, y_pred = fc.price), 
          mape = MLmetrics::MAPE(y_true = mk.price, y_pred = fc.price), 
          rmse = MLmetrics::RMSE(y_true = mk.price, y_pred = fc.price), 
          smape = Metrics::smape(actual = mk.price, predicted = fc.price), 
          mse = MLmetrics::MSE(y_true = mk.price, y_pred = fc.price)), 
      by=.(model)]}][order(model), ]

rm(ex_mds_ets_MNN_MNZ_cmp)

## report
saveRDS(MNN_MNZ_rp_fLT, paste0(.dtr, 'data/fx/USDJPY/MNN_MNZ_rp_fLT.rds'))
## report for MNN_MNZ_rp_fLF
if(!exists('MNN_MNZ_rp_fLF')) {
    MNN_MNZ_rp_fLF <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/MNN_MNZ_rp_fLF.rds')) }

## report for MNN_MNZ_rp_fLT
if(!exists('MNN_MNZ_rp_fLT')) {
    MNN_MNZ_rp_fLT <- read_rds(
        paste0(.dtr, 'data/fx/USDJPY/MNN_MNZ_rp_fLT.rds')) }

MNN_MNZ_rp_fLF <- MNN_MNZ_rp_fLF[, arrange := 'from_first'][]
MNN_MNZ_rp_fLT <- MNN_MNZ_rp_fLT[, arrange := 'from_last'][]

rp <- rbindlist(list(MNN_MNZ_rp_fLF, MNN_MNZ_rp_fLT))
rp <- rp[, .(model, arrange, N, mae, mape, rmse, smape, mse)]
rp %<>% unique

rm(MNN_MNZ_rp_fLF, MNN_MNZ_rp_fLT)
rp %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (MNN & MNZ ETS Models)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  column_spec(7, background = 'Gainsboro') %>% 
  column_spec(8, background = 'LightGray') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
Accurcy Report (MNN & MNZ ETS Models)
model arrange N mae mape rmse smape mse
ts_ets_MNN_31680_1440 from_first 936004 0.3294458 (rank: 12) 0.0030029 (rank: 12) 0.5025803 (rank: 12) 0.0030004 (rank: 12) 0.2525869 (rank: 12)
ts_ets_MNN_31680_7200 from_first 936000 1.1409152 (rank: 28) 0.0104082 (rank: 28) 1.482384 (rank: 22) 0.0103934 (rank: 28) 2.1974622 (rank: 22)
ts_ets_MNN_374400_1440 from_first 936004 1.0628858 (rank: 24) 0.0098133 (rank: 24) 2.0189029 (rank: 30) 0.0096477 (rank: 24) 4.0759689 (rank: 30)
ts_ets_MNN_374400_7200 from_first 936000 1.7773071 (rank: 32) 0.0163224 (rank: 32) 2.4217823 (rank: 32) 0.0161459 (rank: 32) 5.8650295 (rank: 32)
ts_ets_MNN_7200_1440 from_first 936004 0.3237977 (rank: 2) 0.002952 (rank: 2) 0.4913689 (rank: 2) 0.0029499 (rank: 2) 0.2414434 (rank: 2)
ts_ets_MNN_7200_7200 from_first 936000 1.135109 (rank: 26) 0.0103557 (rank: 26) 1.4782236 (rank: 20) 0.0103415 (rank: 26) 2.1851449 (rank: 20)
ts_ets_MNN_95040_1440 from_first 936004 0.4273767 (rank: 18) 0.0039 (rank: 18) 0.791214 (rank: 18) 0.0038819 (rank: 18) 0.6260196 (rank: 18)
ts_ets_MNN_95040_7200 from_first 936000 1.2349975 (rank: 30) 0.0112766 (rank: 30) 1.6485177 (rank: 24) 0.0112396 (rank: 30) 2.7176106 (rank: 24)
ts_ets_MNZ_31680_1440 from_first 936004 0.3294458 (rank: 12) 0.0030029 (rank: 12) 0.5025803 (rank: 12) 0.0030004 (rank: 12) 0.2525869 (rank: 12)
ts_ets_MNZ_31680_7200 from_first 936000 1.1409152 (rank: 28) 0.0104082 (rank: 28) 1.482384 (rank: 22) 0.0103934 (rank: 28) 2.1974622 (rank: 22)
ts_ets_MNZ_374400_1440 from_first 936004 1.0628858 (rank: 24) 0.0098133 (rank: 24) 2.0189029 (rank: 30) 0.0096477 (rank: 24) 4.0759689 (rank: 30)
ts_ets_MNZ_374400_7200 from_first 936000 1.7773071 (rank: 32) 0.0163224 (rank: 32) 2.4217823 (rank: 32) 0.0161459 (rank: 32) 5.8650295 (rank: 32)
ts_ets_MNZ_7200_1440 from_first 936004 0.3237977 (rank: 2) 0.002952 (rank: 2) 0.4913689 (rank: 2) 0.0029499 (rank: 2) 0.2414434 (rank: 2)
ts_ets_MNZ_7200_7200 from_first 936000 1.135109 (rank: 26) 0.0103557 (rank: 26) 1.4782236 (rank: 20) 0.0103415 (rank: 26) 2.1851449 (rank: 20)
ts_ets_MNZ_95040_1440 from_first 936004 0.4273767 (rank: 18) 0.0039 (rank: 18) 0.791214 (rank: 18) 0.0038819 (rank: 18) 0.6260196 (rank: 18)
ts_ets_MNZ_95040_7200 from_first 936000 1.2349975 (rank: 30) 0.0112766 (rank: 30) 1.6485177 (rank: 24) 0.0112396 (rank: 30) 2.7176106 (rank: 24)
ts_ets_MNN_31680_1440 from_last 939600 0.3290608 (rank: 8) 0.0029992 (rank: 8) 0.5019129 (rank: 10) 0.0029967 (rank: 8) 0.2519165 (rank: 10)
ts_ets_MNN_31680_7200 from_last 943200 0.3291581 (rank: 10) 0.0029998 (rank: 10) 0.5015245 (rank: 8) 0.0029972 (rank: 10) 0.2515268 (rank: 8)
ts_ets_MNN_374400_1440 from_last 939600 1.0596938 (rank: 22) 0.0097835 (rank: 22) 2.0151094 (rank: 28) 0.0096186 (rank: 22) 4.0606658 (rank: 28)
ts_ets_MNN_374400_7200 from_last 943200 1.0570025 (rank: 20) 0.0097581 (rank: 20) 2.0114022 (rank: 26) 0.0095939 (rank: 20) 4.0457389 (rank: 26)
ts_ets_MNN_7200_1440 from_last 939600 0.3240886 (rank: 4) 0.0029543 (rank: 4) 0.4914093 (rank: 4) 0.0029522 (rank: 4) 0.2414831 (rank: 4)
ts_ets_MNN_7200_7200 from_last 943200 0.3248577 (rank: 6) 0.0029608 (rank: 6) 0.4919172 (rank: 6) 0.0029588 (rank: 6) 0.2419825 (rank: 6)
ts_ets_MNN_95040_1440 from_last 939600 0.4266169 (rank: 16) 0.0038928 (rank: 16) 0.7898861 (rank: 16) 0.0038748 (rank: 16) 0.62392 (rank: 16)
ts_ets_MNN_95040_7200 from_last 943200 0.4263419 (rank: 14) 0.00389 (rank: 14) 0.7887398 (rank: 14) 0.003872 (rank: 14) 0.6221105 (rank: 14)
ts_ets_MNZ_31680_1440 from_last 939600 0.3290608 (rank: 8) 0.0029992 (rank: 8) 0.5019129 (rank: 10) 0.0029967 (rank: 8) 0.2519165 (rank: 10)
ts_ets_MNZ_31680_7200 from_last 943200 0.3291581 (rank: 10) 0.0029998 (rank: 10) 0.5015245 (rank: 8) 0.0029972 (rank: 10) 0.2515268 (rank: 8)
ts_ets_MNZ_374400_1440 from_last 939600 1.0596938 (rank: 22) 0.0097835 (rank: 22) 2.0151094 (rank: 28) 0.0096186 (rank: 22) 4.0606658 (rank: 28)
ts_ets_MNZ_374400_7200 from_last 943200 1.0570025 (rank: 20) 0.0097581 (rank: 20) 2.0114022 (rank: 26) 0.0095939 (rank: 20) 4.0457389 (rank: 26)
ts_ets_MNZ_7200_1440 from_last 939600 0.3240886 (rank: 4) 0.0029543 (rank: 4) 0.4914093 (rank: 4) 0.0029522 (rank: 4) 0.2414831 (rank: 4)
ts_ets_MNZ_7200_7200 from_last 943200 0.3248577 (rank: 6) 0.0029608 (rank: 6) 0.4919172 (rank: 6) 0.0029588 (rank: 6) 0.2419825 (rank: 6)
ts_ets_MNZ_95040_1440 from_last 939600 0.4266169 (rank: 16) 0.0038928 (rank: 16) 0.7898861 (rank: 16) 0.0038748 (rank: 16) 0.62392 (rank: 16)
ts_ets_MNZ_95040_7200 from_last 943200 0.4263419 (rank: 14) 0.00389 (rank: 14) 0.7887398 (rank: 14) 0.003872 (rank: 14) 0.6221105 (rank: 14)

source : 32 x 8

from above models we know the βest model.

sum <- rp[mae == min(mae) | mape == min(mape) | rmse == min(rmse) | smape == min(smape) | mse == min(mse)]

sum %>% 
  dplyr::mutate(
    mae = ifelse(
      rank(mae) <= 3, 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mae, 7), ' (rank: ', sprintf('%1.f', rank(mae)), ')'), 
        color = 'grey', italic = TRUE)), 
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        color = 'grey', italic = TRUE))) %>% 
  kbl(caption = 'Accurcy Report (Final Stage Comparison)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = '#556DAC') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  column_spec(7, background = 'Gainsboro') %>% 
  column_spec(8, background = 'LightGray') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% 
  scroll_box(width = '100%', fixed_thead = TRUE)
Accurcy Report (Final Stage Comparison)
model arrange N mae mape rmse smape mse
ts_ets_MNN_7200_1440 from_first 936004 0.3237977 (rank: 2) 0.002952 (rank: 2) 0.4913689 (rank: 2) 0.0029499 (rank: 2) 0.2414434 (rank: 2)
ts_ets_MNZ_7200_1440 from_first 936004 0.3237977 (rank: 2) 0.002952 (rank: 2) 0.4913689 (rank: 2) 0.0029499 (rank: 2) 0.2414434 (rank: 2)

source : 2 x 8

6.3 Final Conclude

From final stage models comparison, we know that ts_ets_MNN_7200_1440 and ts_ets_MNZ_7200_1440 is the βest model.

6.4 Future Studies

Next papers will compare tbats, sarima, midas, sarimax etc.

7 Appendix

7.1 Blooper

7.2 Documenting File Creation

It’s useful to record some information about how your file was created.

  • File creation date: 2021-01-31
  • File latest updated date: 2021-02-03
  • R version 4.0.3 (2020-10-10)
  • R version (short form): 4.0.3
  • rmarkdown package version: 2.6
  • File version: 1.0.0
  • Author Profile: ®γσ, Eng Lian Hu
  • GitHub: Source Code
  • Additional session information:
suppressMessages(require('dplyr', quietly = TRUE))
suppressMessages(require('magrittr', quietly = TRUE))
suppressMessages(require('formattable', quietly = TRUE))
suppressMessages(require('knitr', quietly = TRUE))
suppressMessages(require('kableExtra', quietly = TRUE))

sys1 <- devtools::session_info()$platform %>% 
  unlist %>% data.frame(Category = names(.), session_info = .)
rownames(sys1) <- NULL

sys2 <- data.frame(Sys.info()) %>% 
  dplyr::mutate(Category = rownames(.)) %>% .[2:1]
names(sys2)[2] <- c('Sys.info')
rownames(sys2) <- NULL

if (nrow(sys1) == 9 & nrow(sys2) == 8) {
  sys2 %<>% rbind(., data.frame(
  Category = 'Current time', 
  Sys.info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
} else {
  sys1 %<>% rbind(., data.frame(
  Category = 'Current time', 
  session_info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
}

sys <- cbind(sys1, sys2) %>% 
  kbl(caption = 'Additional session information:') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue', color = 'red') %>% 
  column_spec(2, background = 'grey', color = 'black') %>% 
  column_spec(3, background = 'CornflowerBlue', color = 'blue') %>% 
  column_spec(4, background = 'grey', color = 'white') %>% 
  row_spec(9, bold = T, color = 'yellow', background = '#D7261E')

rm(sys1, sys2)
sys
Additional session information:
Category session_info Category Sys.info
version R version 4.0.3 (2020-10-10) sysname Windows
os Windows 10 x64 release 10 x64
system x86_64, mingw32 version build 19042
ui RTerm nodename SCIBROKES-TRADI
language en machine x86-64
collate English_World.1252 login Owner
ctype English_World.1252 user Owner
tz Asia/Tokyo effective_user Owner
date 2021-02-03 Current time 2021-02-03 00:26:46 JST<U+0001F5FE>