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 : あなたは誇りに思うでしょう
Due to below isseus from Deriv.com - Interday High Frequency Trading Models Comparison Blooper, here I review the researh by using same dataset.
7200
mins forecast in advanced despite Saturday
and Sunday
.data_m1
from 2015-01-05
to 2017-12-31
.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')
}
}
Review the Deriv.com - Interday High Frequency Trading Models Comparison Blooper.
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')
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:
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')
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
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')
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')
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'))}
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).
ts()
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
= weekly22 days * 1440 mins = 31680 mins
= monthly3 months * 22 days * 1440 mins = 95040 mins
= quarterly52 weeks * 5 days * 1440 mins = 374400 mins
= yearlytimeID <- 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)
}
}
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)
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
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)
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
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)
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
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)
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
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)
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
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)
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
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)
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
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)
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
ts()
& ets()
## 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')
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)
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
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)
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
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)
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
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)
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
## 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')
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)
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
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)
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
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)
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
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)
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
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'))
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)
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
## 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.
unique(x, fromLast = FALSE)
DatasetBelow 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
.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.
unique(x, fromLast = TRUE)
DatasetBelow 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
.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.
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)
.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
From initial stage models comparison, we know that ts_ets_MNN_7200_1440 and ts_ets_MNZ_7200_1440 is the βest model.
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')
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')
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)
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
From final stage models comparison, we know that ts_ets_MNN_7200_1440 and ts_ets_MNZ_7200_1440 is the βest model.
Next papers will compare tbats
, sarima
, midas
, sarimax
etc.
It’s useful to record some information about how your file was created.
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
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> |
Powered by - Copyright® Intellectual Property Rights of Sςιβrοκεrs Trαdιηg ®️ 経営企業