Real Time Trading System (Trial)


By refer to Match Odds I created this app to test the real-time trading system for hedge fund... Once the buying/selling limit orders match the ask/bid offer by banker a transaction will be closed. Fct.High is the sell limit order while Fct.Low is the buy limit order. Kindly refer to Forex Bid Ask Spread for more information.

I will fit the real-time trading into Q1App2 in the Punter tab (Hedge Fund). Kindly refer to binary.com Interview Question for project details.


Real Time Data

Real Time bid/ask price and placed orders.

Current time (Asia/Tokyo):



Transaction List

Below shows the transactions done.



The transaction list will be settled once the opposite site bid/ask request met. Otherwise, the closed price will be the price for closed transaction.



The settlement list will be compounded and plot as a graph to the ROI (return of investment). Therefore investors can evaluate the performance of the hedge fund.



Powered by - Copyright® Intellectual Property Rights of scibrokes Scibrokes®

Real Time Trading System (Trial) Author: Ryo, Eng Lian Hu

show with app
## ================== Declaration ========================================
suppressWarnings(require('shiny'))
suppressWarnings(require('shinyjs'))
suppressWarnings(require('TFX'))
suppressWarnings(require('formattable'))
suppressWarnings(require('DT'))
suppressWarnings(require('cronR'))
suppressWarnings(require('xts'))
suppressWarnings(require('lubridate'))
suppressWarnings(require('plyr'))
suppressWarnings(require('dplyr'))
suppressWarnings(require('magrittr'))

## ===================== UI ===========================================
# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Application title
    titlePanel('Real Time Trading System (Testing Version)'),
    
    mainPanel(
        p('I created this app to test the real-time transaction matching... ', 
          'Once the bid/ask price match with forecasted price, a transaction ', 
          'will be done.'), 
        p('Kindly refer to ', 
          HTML("<a href='https://github.com/englianhu/binary.com-interview-question'>binary.com Interview Question</a>"), 
          'for project details.'), 
        tags$hr(),
        h4('Real Time Data'), 
        p('Real Time bid/ask price and placed orders.'), 
        #'@ actionButton('calculate', 'Start Calculate', 
        #'@              icon = icon('calculator'), class = 'btn-primary'), 
        formattableOutput('fxdata'), 
        tags$hr(), 
        h4('Closed Transaction'), 
        p('Transactions done.'), 
        actionButton('refresh', 'Refresh Data', 
                     icon = icon('refresh'), class = 'btn-primary'), 
        br(), 
        br(), 
        DT::dataTableOutput('transc')))

## ================== Server ===========================================
# Define server logic required to draw a histogram
server <- function(input, output, session) {
    
    fcstPunterData <- reactive({
        isolate({
            withProgress({
                setProgress(message = "Processing algorithmic forecast...")
                fxLo <- forecastData(price = 'Lo')
                fxHi <- forecastData(price = 'Hi')
                fxHL <- merge(fxHi, fxLo, by = c('.id', 'ForecastDate.GMT'))
                rm(fxHi, fxLo)
            })
        })
        
        if(!dir.exists('data')) dir.create('data')
        if(!file.exists(paste0('data/fcstPunterGMT', today('GMT'), '.rds'))){
            saveRDS(fxHL, paste0('data/fcstPunterGMT', today('GMT'), '.rds')) }
        
        return(fxHL)
    })
    
    fetchData <- reactive({
        #if(!input$pause)
            invalidateLater(750)
        qtf <- QueryTrueFX() ## http://webrates.truefx.com/rates/connect.html
        qtf$TimeStamp <- as.character(qtf$TimeStamp)
        names(qtf)[6] <- 'TimeStamp (GMT)'
        qtf <- qtf[, c(6, 1:3, 5:4)]
        return(qtf)
    })
    
    refresh <- reactive({
        line <- fetchData()
        
        if(file.exists(paste0('data/fcstPunterGMT', today('GMT'), '.rds'))) {
            fcPR <- ldply(dir('data', 
                      pattern = paste0('fcstPunterGMT', today('GMT'))), function(x){
                readRDS(paste0('data/', x)) })
            
            ## filter and only pick USDJPY
            fcPR %<>% filter(.id == 'USDJPY')
            
        } else {
            fcPR <- fcstPunterData()
            
            ## filter and only pick USDJPY
            fcPR %<>% filter(.id == 'USDJPY')
        }
        
        #'@ invalidateLater(1000, session)
        rx <- line %>% filter(Symbol == 'USD/JPY') %>% 
            mutate(
                Bid.Price = round(Bid.Price, 3), 
                Ask.Price = round(Ask.Price, 3), 
                fc.High = round(fcPR$Currency.Hi, 3), 
                fc.Low = round(fcPR$Currency.Lo, 3)) %>% 
            dplyr::select(`TimeStamp (GMT)`, Bid.Price, Ask.Price, 
                          fc.High, fc.Low)
        
        if(rx$fc.Low == rx$Bid.Price){
            tr.buy <- rx %>% mutate(Price = fc.Low, Transaction = 'Buy') %>% 
                dplyr::select(`TimeStamp (GMT)`, Price, Transaction)
            saveRDS(tr.buy, paste0('data/buy.', now('GMT'), '.rds'))
        }
        if(rx$fc.High == rx$Ask.Price){
            tr.sell <- rx %>% mutate(Price = fc.High, Transaction = 'Sell') %>% 
                dplyr::select(`TimeStamp (GMT)`, Price, Transaction)
            saveRDS(tr.sell, paste0('data/sell.', now('GMT'), '.rds'))
        }
        
        return(rx)
    })
    
    output$fxdata <- renderFormattable({
        
        rx <- refresh()
        
        rx %>% formattable(list(
            Bid.Price = formatter('span', 
                                  style = x ~ style(color = ifelse(x > (rx$fc.Low + rx$fc.High) / 2, 'red', 'green')), 
                                  x ~ icontext(ifelse(x > (rx$fc.Low + rx$fc.High) / 2, 'arrow-down', 'arrow-up'), x)), 
            Ask.Price = formatter('span', 
                                  style = x ~ style(color = ifelse(x < (rx$fc.Low + rx$fc.High) / 2, 'red', 'green')),
                                  x ~ icontext(ifelse(x < (rx$fc.Low + rx$fc.High) / 2, 'arrow-down', 'arrow-up'), x)), 
            fc.Low = formatter('span', 
                            style = x ~ style(color = ifelse(x > 0, 'red', 'green')), 
                            x ~ icontext(ifelse(x > 0, 'arrow-down', 'arrow-up'), x)), 
            fc.High = formatter('span',
                             style = x ~ style(color = ifelse(x < 0, 'red', 'green')),
                             x ~ icontext(ifelse(x < 0, 'arrow-down', 'arrow-up'), x))
        ))})
    
    output$transc <- DT::renderDataTable({
        
        input$refresh
        
        if(length(dir('data', pattern = 'sell|buy')) > 0) {
            trn <- ldply(dir('data', pattern = 'sell|buy'), function(x){
                readRDS(paste0('data/', x)) }) %>% 
                mutate(`TimeStamp (GMT)` = ymd_hms(`TimeStamp (GMT)`), 
                       Transaction = factor(Transaction)) %>% 
                dplyr::arrange(desc(`TimeStamp (GMT)`)) %>% 
                mutate(ID = rev(seq_len(nrow(.))), 
                       `TimeStamp (GMT)` = factor(`TimeStamp (GMT)`))
        } else {
            trn <- NULL
        }
        
        trn %>% DT::datatable(caption = "Transaction Table", 
                              escape = FALSE, filter = 'top', rownames = FALSE, 
                              extensions = list('ColReorder' = NULL, 'RowReorder' = NULL, 
                                                'Buttons' = NULL, 'Responsive' = NULL), 
                              options = list(dom = 'BRrltpi', scrollX = TRUE, #autoWidth = TRUE, 
                                             lengthMenu = list(c(10, 50, 100, -1), c('10', '50', '100', 'All')), 
                                             ColReorder = TRUE, rowReorder = TRUE, 
                                             buttons = list('copy', 'print', 
                                                            list(extend = 'collection', 
                                                                 buttons = c('csv', 'excel', 'pdf'), 
                                                                 text = 'Download'), I('colvis'))))
    })
    
    #'@ trnData <- reactive({
    #'@     ldply(dir('data', pattern = 'sell|buy'), function(x){
    #'@         readRDS(paste0('data/', x))}) %>% 
    #'@         mutate(`TimeStamp (GMT)` = ymd_hms(`TimeStamp (GMT)`), 
    #'@                Transaction = factor(Transaction)) %>% 
    #'@         dplyr::arrange(desc(`TimeStamp (GMT)`)) %>% 
    #'@         mutate(ID = rev(seq_len(nrow(.))), 
    #'@                `TimeStamp (GMT)` = factor(`TimeStamp (GMT)`))
    #'@ })
    }

# Run the application 
shinyApp(ui = ui, server = server)
#'@ runApp('testRealTimeTransc', display.mode = 'showcase')

## https://github.com/bnosac/cronR
## http://www.bnosac.be/index.php/blog/64-scheduling-r-scripts-and-processes-on-windows-and-unix-linux
## 

#'@ suppressWarnings(require('cronR'))
#'@ Sys.setenv(TZ = 'GMT')

#'@ f <- system.file('global.R')
#'@ cmd <- cron_rscript(f)

## Scheduled calculation every weekdays from Monday to Friday at 12AM.
#'@ cron_add(cmd, frequency = 'daily', id = 'job1', at = '00:00', 
#'@          description = 'Daily forecast', days_of_week = 1:5)

## Get all the jobs
#'@ cron_ls()

## Remove all scheduled jobs
#'@ cron_clear(ask = FALSE)
## ================== Declaration ========================================
options(warn = -1, 'getSymbols.yahoo.warning' = FALSE)
suppressPackageStartupMessages(suppressWarnings(require('BBmisc')))
suppressAll(require('shiny'))
suppressAll(require('cronR'))
suppressAll(require('xts'))
suppressAll(require('quantmod'))
suppressAll(require('TFX'))
suppressAll(require('lubridate'))
suppressAll(require('plyr'))
suppressAll(require('dplyr'))
suppressAll(require('data.table'))
suppressAll(require('tidyr'))
suppressAll(require('magrittr'))
suppressAll(require('memoise'))
suppressAll(require('stringr'))
suppressAll(require('RCurl'))
suppressAll(require('rugarch'))
suppressAll(require('rmgarch'))
suppressAll(require('forecast'))
suppressAll(require('formattable'))

prd = 1 #since count trading day.

#fx <- c('EURUSD=X', 'JPY=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'AUDUSD=X')
fx <- c('JPY=X')

#fxObj <- c('EURUSD', 'USDJPY', 'GBPUSD', 'USDCHF', 'USDCAD', 'AUDUSD')
fxObj <- c('USDJPY')

wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday')
wd %<>% factor(., levels = ., ordered = TRUE)

## ================== Function ========================================
# Function to get new observations
#'@ get_new_data <- function() readLines('http://webrates.truefx.com/rates/connect.html')

armaSearch <- function(data, .method = 'CSS-ML'){ 
  ## ARMA Modeling寻找AIC值最小的p,q
  ##
  ## I set .method = 'CSS-ML' as default method since the AIC value we got is 
  ##  smaller than using method 'ML' while using method 'CSS' facing error.
  ## 
  ## https://stats.stackexchange.com/questions/209730/fitting-methods-in-arima
  ## According to the documentation, this is how each method fits the model:
  ##  - CSS minimises the sum of squared residuals.
  ##  - ML maximises the log-likelihood function of the ARIMA model.
  ##  - CSS-ML mixes both methods: first, CSS is run, the starting parameters 
  ##    for the optimization algorithm are set to zeros or to the values given 
  ##    in the optional argument init; then, ML is applied passing the CSS 
  ##    parameter estimates as starting parameter values for the optimization algorithm.
  
  .methods = c('CSS-ML', 'ML', 'CSS')
  
  if(!.method %in% .methods) stop(paste('Kindly choose .method among ', 
                                        paste0(.methods, collapse = ', '), '!'))
  
  armacoef <- data.frame()
  for (p in 0:5){
    for (q in 0:5) {
      #data.arma = arima(diff(data), order = c(p, 0, q))
      #'@ data.arma = arima(data, order = c(p, 1, q), method = .method)
      if(.method == 'CSS-ML') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma, mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'ML')
          mth = 'ML'
          list(arma = arma, mth = mth)
        })
      } else if(.method == 'ML') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'ML')
          mth = 'ML'
          list(arma = arma, mth = mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma = arma, mth = mth)
        })
      } else if(.method == 'CSS') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'CSS')
          mth = 'CSS'
          list(arma = arma, mth = mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma = arma, mth = mth)
        })
      } else {
        stop(paste('Kindly choose .method among ', 
                   paste0(.methods, collapse = ', '), '!'))
      }
      names(data.arma) <- c('arma', 'mth')
      
      #cat('p =', p, ', q =', q, 'AIC =', data.arma$arma$aic, '\n')
      armacoef <- rbind(armacoef, c(p, q, data.arma$arma$aic))
    }
  }
  
  colnames(armacoef) <- c('p', 'q', 'AIC')
  pos <- which(armacoef$AIC == min(armacoef$AIC))
  cat(paste0('method = \'', data.arma$mth, '\', the min AIC = ', 
             armacoef$AIC[pos], ', p = ', armacoef$p[pos], 
             ', q = ', armacoef$q[pos], '\n'))
  return(armacoef)
}

filterFX <- function(mbase, currency = 'JPY=X', price = 'Cl') {
  
  if(currency == 'AUDUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`AUDUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('AUDUSD=X', 'AUD.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'EURUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`EURUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('EURUSD=X', 'EUR.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'GBPUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`GBPUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('GBPUSD=X', 'GBP.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CHF=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CHF=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CHF=X', 'USD.CHF')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CAD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CAD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CAD=X', 'USD.CAD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CNY=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CNY=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CNY=X', 'USD.CNY')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'JPY=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`JPY=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('JPY=X', 'USD.JPY')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else {
    stop('Kindly choose common currencies exchange.')
  }
  return(mbase)
}

#filterFX <- function(mbase, currency, price = 'Cl') {
#  if(currency == 'AUDUSD=X') {
#    if(price == 'Op') {
#      mbase <- `AUDUSD=X` %>% Op %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `AUDUSD=X` %>% Hi %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `AUDUSD=X` %>% Lo %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `AUDUSD=X` %>% Cl %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `AUDUSD=X` %>% Ad %>% na.omit; rm(`AUDUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('AUDUSD=X', 'AUD.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'EURUSD=X') {
#    if(price == 'Op') {
#      mbase <- `EURUSD=X` %>% Op %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `EURUSD=X` %>% Hi %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `EURUSD=X` %>% Lo %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `EURUSD=X` %>% Cl %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `EURUSD=X` %>% Ad %>% na.omit; rm(`EURUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('EURUSD=X', 'EUR.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'GBPUSD=X') {
#    if(price == 'Op') {
#      mbase <- `GBPUSD=X` %>% Op %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `GBPUSD=X` %>% Hi %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `GBPUSD=X` %>% Lo %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `GBPUSD=X` %>% Cl %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `GBPUSD=X` %>% Ad %>% na.omit; rm(`GBPUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('GBPUSD=X', 'GBP.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CHF=X') {
#    if(price == 'Op') {
#      mbase <- `CHF=X` %>% Op %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CHF=X` %>% Hi %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CHF=X` %>% Lo %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CHF=X` %>% Cl %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CHF=X` %>% Ad %>% na.omit; rm(`CHF=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CHF=X', 'USD.CHF')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CAD=X') {
#    if(price == 'Op') {
#      mbase <- `CAD=X` %>% Op %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CAD=X` %>% Hi %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CAD=X` %>% Lo %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CAD=X` %>% Cl %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CAD=X` %>% Ad %>% na.omit; rm(`CAD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CAD=X', 'USD.CAD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CNY=X') {
#    if(price == 'Op') {
#      mbase <- `CNY=X` %>% Op %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CNY=X` %>% Hi %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CNY=X` %>% Lo %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CNY=X` %>% Cl %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CNY=X` %>% Ad %>% na.omit; rm(`CNY=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CNY=X', 'USD.CNY')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'JPY=X') {
#    if(price == 'Op') {
#      mbase <- `JPY=X` %>% Op %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Hi') {
#      mbase <- `JPY=X` %>% Hi %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Lo') {
#      mbase <- `JPY=X` %>% Lo %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Cl') {
#      mbase <- `JPY=X` %>% Cl %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Ad') {
#      mbase <- `JPY=X` %>% Ad %>% na.omit; rm(`JPY=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('JPY=X', 'USD.JPY')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else {
#    stop('Kindly choose common currencies exchange.')
#  }
#  return(mbase)
#}

# Using "memoise" to automatically cache the results
calC <- memoise(function(mbase, currency = 'JPY=X', ahead = 1, price = 'Cl') {
  
  mbase = filterFX(mbase, currency = currency, price = price)
  
  armaOrder = armaSearch(mbase)
  armaOrder %<>% dplyr::filter(AIC == min(AIC)) %>% .[c('p', 'q')] %>% unlist
  
  spec = ugarchspec(
    variance.model = list(
      model = 'gjrGARCH', garchOrder = c(1, 1), 
      submodel = NULL, external.regressors = NULL, 
      variance.targeting = FALSE), 
    mean.model = list(
      armaOrder = armaOrder, 
      include.mean = TRUE, archm = FALSE, 
      archpow = 1, arfima = FALSE, 
      external.regressors = NULL, 
      archex = FALSE), 
    distribution.model = 'snorm')
  fit = ugarchfit(spec, mbase, solver = 'hybrid')
  fc = ugarchforecast(fit, n.ahead = ahead)
  res = tail(attributes(fc)$forecast$seriesFor, 1)
  colnames(res) = names(mbase)
  latestPrice = tail(mbase, 1)
  
  ## count the number of days to forecast.
  #dy = ifelse(weekdays(index(latestPrice)) %in% wd[1:4], 1, 2)
  #if(weekdays(index(latestPrice)) %in% wd[c(1:3, 7)]) {
  #  dy <- 1
  #} else if(weekdays(index(latestPrice)) %in% wd[6]) {
  #  dy <- 2
  #} else if(weekdays(index(latestPrice)) %in% wd[4:5]) {
  #  dy <- 3
  #} else {
  #  stop('Weekdays must be within Monday to Sunday.')
  #}
  
  #forDate = latestPrice %>% index + days(dy)
  
  ## straighly use today('GMT') since last date will be the last 
  ##   trading day we get from getSymbols(), therefore the next 
  ##   trading day will be today('GMT').
  #'@ forDate = as.Date(today('GMT'))
  
  #rownames(res) <- as.character(forDate)
  latestPrice <- xts(latestPrice)
  #res <- as.xts(res)
  
  tmp = list(latestPrice = latestPrice, forecastPrice = res)
  return(tmp)
})

forecastUSDJPY <- function(mbase, currency = 'JPY=X', ahead = 1, price = 'Cl') {
  forC.USDJPY <- calC(mbase, currency = currency, ahead = ahead, price = price)
  
  fxC <- data.frame(
    LatestDate.GMT = index(forC.USDJPY$latestPrice), 
    latestPrice = forC.USDJPY$latestPrice, 
    #ForecastDate.GMT = index(forC.USDJPY$forecastPrice), 
    ForecastDate.GMT = rownames(forC.USDJPY$forecastPrice), 
    Currency = forC.USDJPY$forecastPrice)
  
  rownames(fxC) <- NULL
  
  if(price == 'Op') fxC %<>% dplyr::rename(Lst.Open = USD.JPY, Fct.Open = USD.JPY.1)
  if(price == 'Hi') fxC %<>% dplyr::rename(Lst.High = USD.JPY, Fct.High = USD.JPY.1)
  if(price == 'Lo') fxC %<>% dplyr::rename(Lst.Low = USD.JPY, Fct.Low = USD.JPY.1)
  if(price == 'Cl') fxC %<>% dplyr::rename(Lst.Close = USD.JPY, Fct.Close = USD.JPY.1)
  
  return(fxC)
}

forecastUSDJPYHL <- function(mbase, .preCat = 'Op', .setPrice = 'Cl', 
                             currency = 'JPY=X', ahead = 1){
  fx1 <- forecastUSDJPY(mbase, currency = currency, ahead = ahead, price = .preCat)
  fx2 <- forecastUSDJPY(mbase, currency = currency, ahead = ahead, price = .setPrice)
  fxm <- merge(fx1, fx2, by = c('LatestDate.GMT', 'ForecastDate.GMT'))
  rm(fx1, fx2)
  
  fxm <- fxm[c(1, 3, 5, 2, 4, 6)]
  return(fxm)
}

simKelly <- function(mbase) {
  
  
  return(res)
}

kellyBet <- function(mbase, initialFundSize = 10000){
  
  mbase %<>% data.frame
  names(mbase) <- str_replace_all(names(mbase), 'JPY.X', 'USDJPY')
  ## https://github.com/englianhu/binary.com-interview-question/blob/master/function/simStakesGarch.R
  ## 
  # pred.data %>% mutate(ProbB = pnorm(Fct.High, mean = mean(Fct.Low), 
  #                                    sd = sd(Fct.Low)), 
  #                      ProbS = 1 - ProbB, 
  #                      Fct.High = round(Fct.High, 3), 
  #                      Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB      ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.8280676 0.17193237
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.8845984 0.11540162
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.8323185 0.16768149
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.9170950 0.08290501
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.9331140 0.06688596
  #---                                                                                       
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.3766011 0.62339887
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.4827210 0.51727904
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.4478401 0.55215994
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.5616675 0.43833251
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.5845864 0.41541355
  # 
  # 
  # pred.data %>% mutate(ProbB = pnorm(Fct.Low, mean = mean(Fct.High), 
  #                                    sd = sd(Fct.High)), 
  #                      ProbS = 1 - ProbB, 
  #                      Fct.High = round(Fct.High, 3), 
  #                      Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.4753219 0.5246781
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.4753219 0.5246781
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.4753219 0.5246781
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.4753219 0.5246781
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.4753219 0.5246781
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.4753219 0.5246781
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.4753219 0.5246781
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.4753219 0.5246781
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.4753219 0.5246781
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4753219 0.5246781
  # 
  # 
  # pred.data %>% mutate(
  #   ProbB = pnorm(Fct.Low, mean = mean(Lst.High), sd = sd(Lst.High)), 
  #   ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
  #   Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.6829508 0.3170492
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.7296487 0.2703513
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.6774416 0.3225584
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.7901496 0.2098504
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.8303839 0.1696161
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.3242934 0.6757066
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.2961039 0.7038961
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.3906327 0.6093673
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.3677742 0.6322258
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4816531 0.5183469
  #
  # pred.data %>% mutate(
  #   ProbB = pnorm(Fct.Low, mean = mean(Fct.Low), sd = sd(Fct.Low)), 
  #   ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
  #   Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.7106333 0.2893667
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.7626865 0.2373135
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.7044035 0.2955965
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.8275657 0.1724343
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.8685511 0.1314489
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.2943248 0.7056752
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.2627786 0.7372214
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.3701970 0.6298030
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.3438371 0.6561629
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4765542 0.5234458
  
  mbase %<>% mutate(
    ProbB = pnorm(Fct.Low, mean = mean(Fct.High), sd = sd(Fct.High)), 
    ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
    Fct.Low = round(Fct.Low, 3)) %>% data.table
  
  # Kelly criterion
  # Advantages = (prob of win * decimal odds) + (prob of lose * -1)
  # Optimal Kelly wager % = Advantages / decimal odds
  mbase$Adv <- (mbase$EMprob * mbase$COMOdds) + ((1-mbase$EMprob) * -1)
  mbase$Staking <- mbase$Adv / mbase$COMOdds
  mbase$Staking <- ifelse(mbase$Staking < 0, 0, mbase$Staking)
  
  return(res)
}

# ---------------- KellyS ------------------------------------------
## http://srdas.github.io/MLBook/Gambling.html
KellyS <- function(fitm, .preCat = 'Lo', .forCat = 'Hi', .initialFundSize = 10000, 
                   .filterBets = FALSE, .fundLeverageLog = FALSE) {
  
  fitm %<>% na.omit
  
  if(.preCat == 'Op') fitm %<>% rename(Point.Forecast = Fct.Open)
  if(.preCat == 'Hi') fitm %<>% rename(Point.Forecast = Fct.High)
  if(.preCat == 'Lo') fitm %<>% rename(Point.Forecast = Fct.Low)
  if(.preCat == 'Cl') fitm %<>% rename(Point.Forecast = Fct.Close)
  
  if(.forCat == 'Op') fitm %<>% rename(forClose = Fct.Open)
  if(.forCat == 'Hi') fitm %<>% rename(forClose = Fct.High)
  if(.forCat == 'Lo') fitm %<>% rename(forClose = Fct.Low)
  if(.forCat == 'Cl') fitm %<>% rename(forClose = Fct.Close)
  
  fitm %<>% mutate(
    ProbB = pnorm(Point.Forecast, mean = mean(forClose), sd = sd(forClose)), 
    ProbS = 1 - ProbB)#, Fct.High = round(Fct.High, 3), 
  #Fct.Low = round(Fct.Low, 3))
  
  fitm %<>% mutate(Point.Forecast = round(lag(Point.Forecast), 3), 
                   forClose = round(lag(forClose), 3)) %>% na.omit %>% data.table
  
  fitm %<>% mutate(BR = .initialFundSize) %>% 
    #'@ mutate(Return.Back = ifelse(Prob > 0.5, Diff * Back * stakes, 0), 
    #'@        Return.Lay = ifelse(Prob < 0.5, -Diff * Lay * stakes, 0))
    mutate(fB = 2 * ProbB - 1, fS = 2 * ProbS - 1, 
           #EUB = ProbB * log(BR * (1 + fB)) + (1 - ProbB) * log(BR * (1 - fB)), 
           #EUS = ProbS * log(BR * (1 + fS)) + (1 - ProbS) * log(BR * (1 - fS)), 
           EUB = ProbB * log(ProbB) + (1 - ProbB) * log(1 - ProbB), 
           EUS = ProbS * log(ProbS) + (1 - ProbS) * log(1 - ProbS), 
           #EUB = ProbB * (BR * (1 + fB)) + (1 - ProbB) * (BR * (1 - fB)), 
           #EUS = ProbS * (BR * (1 + fS)) + (1 - ProbS) * (BR * (1 - fS)), 
           #'@ Edge = ifelse(f > 0, EUB, EUS), #For f > 0 need to buy and f <= 0 need to sell.
           #need to study on the risk management on "predicted profit" and "real profit".
           Edge = ifelse(fB > 0, EUB, ifelse(fS > 0, EUS, 0)), 
           PF = ifelse(Point.Forecast >= Lst.Low & 
                         Point.Forecast <= Lst.High, 
                       Point.Forecast, 0), #if forecasted place-bet price doesn't existing within Hi-Lo price, then the buying action is not stand. Assume there has no web bandwith delay.
           FC = ifelse(forClose >= Lst.Low & forClose <= Lst.High, 
                       forClose, Lst.Close), #if forecasted settle price doesn't existing within Hi-Lo price, then the closing action at closing price. Assume there has no web bandwith delay.
           #'@ Diff = round(forClose - USDJPY.Close, 2),
           ##forecasted closed price minus real close price.
           
           Buy = ifelse(PF > 0 & FC > PF, 1, 0), ##buy action
           Sell = ifelse(PF > 0 & FC < PF, 1, 0), ##sell action
           BuyS = Edge * Buy * (forClose - PF), 
           SellS = Edge * Sell * (PF - forClose), 
           Profit = BuyS + SellS, Bal = BR + Profit)
  
  
  #'@ fitm %>% dplyr::select(Point.Forecast, forClose, Prob, BR, f, EU, Edge, PF, FC, Buy, Sell, SP, Bal)
  #'@ fitm %>% dplyr::select(ProbB, ProbS, BR, fB, fS, EUB, EUS, Edge, PF, USDJPY.Open, FC, Buy, Sell, BuyS, SellS, Profit, Bal) %>% filter(PF > 0, FC > 0)
  
  ## The ets staking models (Kelly criterion) Adjusted Banl-roll and Balance column.
  for(i in seq(2, nrow(fitm))) {
    fitm$BR[i] = fitm$Bal[i - 1]
    fitm$fB[i] = 2 * fitm$ProbB[i] - 1
    fitm$fS[i] = 2 * fitm$ProbS[i] - 1
    fitm$EUB[i] = fitm$ProbB[i] * log(fitm$BR[i] * (1 + fitm$fB[i])) + 
      (1 - fitm$ProbB[i]) * log(fitm$BR[i] * (1 - fitm$fB[i]))
    fitm$EUS[i] = fitm$ProbS[i] * log(fitm$BR[i] * (1 + fitm$fS[i])) + 
      (1 - fitm$ProbS[i]) * log(fitm$BR[i] * (1 - fitm$fS[i]))
    fitm$Edge[i] = ifelse(fitm$fB[i] > 0, fitm$EUB[i], 
                          ifelse(fitm$fS[i] > 0, fitm$EUS[i], 0)) #For f > 0 need to buy and f <= 0 need to sell.
    #need to study on the risk management on "predicted profit" and "real profit".
    
    fitm$BuyS[i] = fitm$Edge[i] * fitm$Buy[i] * (fitm$forClose[i] - fitm$PF[i])
    fitm$SellS[i] = fitm$Edge[i] * fitm$Sell[i] * (fitm$PF[i] - fitm$forClose[i])
    fitm$Profit[i] = fitm$BuyS[i] + fitm$SellS[i]
    fitm$Bal[i] = fitm$BR[i] + fitm$Profit[i]
    if(fitm$Bal[i] <= 0) stop('All invested fund ruined!')
  }; rm(i)
  
  #names(mbase) <- str_replace_all(names(mbase), '^(.*?)+\\.', nm)
  
  if(.filterBets == TRUE) {
    fitm %<>% filter(PF > 0, FC > 0)
  }
  
  fitm %<>% mutate(RR = Bal/BR)
  
  ## convert the log leverage value of fund size and profit into normal digital figure with exp().
  if(.fundLeverageLog == TRUE) fitm %<>% 
    mutate(BR = exp(BR), BuyS = exp(BuyS), SellS = exp(SellS), 
           Profit = exp(Profit), Bal = exp(Profit))
  
  return(fitm)
}


## ============= Data ==============================
for(i in seq(fx)) {
  assign(fxObj[i], na.omit(suppressWarnings(
    getSymbols(fx[i], from = (today('GMT') - days(prd)) %m-% years(2), 
               to = (today('GMT') - days(prd)), auto.assign = FALSE)))) }
rm(i)

mbase <- USDJPY
#names(mbase) <- str_replace_all(names(mbase), 'JPY=X', 'USDJPY')

if(!is.xts(mbase)) mbase <- xts(mbase[, -1], order.by = mbase$Date)
dateID <- index(mbase)
dateID0 <- dateID[259] #since 2 years data length(dateID) is 518.
dateID <- dateID[dateID >= dateID0]

## ------------------------------- Forecast Simulation ----------------------------------
## Now we try to use the daily mean value which is (Hi + Lo) / 2.
pred.dataHL <- ldply(dateID, function(dt) {
  smp = mbase
  dtr = tail(index(smp[index(smp) < dt]), 1)
  smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
  frd = as.numeric(difftime(dt, dtr), units = 'days')
  fit = forecastUSDJPYHL(mbase = smp, currency = 'JPY=X', ahead = 1, 
                         .preCat = 'Hi', .setPrice = 'Lo')
  #saveRDS(fit, paste0('testRealTimeTransc/data/fcstPunterGMT', as.character(dt), '.rds'))
  cat(as.character(dt), '\n')
  fit
}, .parallel = FALSE)

## --------- Start Simulate daily price ------------------------
## Simulate forecast data up-to-date.
dtb <- ldply(paste0('testRealTimeTransc/data/', dir('testRealTimeTransc/data', pattern = 'fcstPunterGMT')), readRDS)
dtc <- dir('testRealTimeTransc/data', pattern = 'fcstPunterGMT') %>% str_replace_all('fcstPunterGMT', '') %>% str_replace_all('.rds', '')
dtc <- dtc[!dtc %in% dtb$LatestDate.GMT]
dd <- dplyr::filter(pred.dataHL, !LatestDate.GMT %in% dtc)

## Save the forecast price.
llply(split(dd, dd$LatestDate.GMT), function(x) {
  saveRDS(x, paste0('testRealTimeTransc/data/fcstPunterGMT', as.character(x$LatestDate.GMT), '.rds'))
})

## Check again the files.
ldply(paste0('testRealTimeTransc/data/', dir('testRealTimeTransc/data', pattern = 'fcstPunterGMT')), readRDS)
## --------- End Simulate daily price ------------------------

## Simulate Kelly staking model.
##   Static data where closed price gather from Yahoo but not 
##   real-time closed price data from TFX::QueryFX() everyday 12AM GMT.
obs <- ldply(
  paste0('testRealTimeTransc/data/', 
         dir('testRealTimeTransc/data', pattern = 'fcstPunterGMT')), readRDS) %>% 
  mutate(Fct.High = lag(round(Fct.High, 3)), Fct.Low = lag(round(Fct.Low, 3))) %>% 
  data.table

## Closed price as settlement price for those no closing transaction.
Closed <- mbase %>% Cl %>% data.frame
Closed <- data.frame(LatestDate.GMT = as.Date(rownames(Closed)), 
                     Lst.Close = Closed$JPY.X.Close)
rownames(Closed) <- NULL

obs <- plyr::join(obs, Closed, by = 'LatestDate.GMT') %>% na.omit
obs$ForecastDate.GMT <- NULL

obs %<>% mutate(Back = percent(pnorm(Fct.High, mean = mean(Fct.Low), sd = sd(Fct.Low))), 
               Lay = percent(pnorm(Fct.Low, mean = mean(Fct.High), sd = sd(Fct.High))))

## Randomized dummy value.
## Method 1 - simulate sample() 1000 times.
##   Do not work since don't know the mean value based on central limit theory.
#'@ obs %>% mutate(HL = sample(0:1, nrow(.), replace = TRUE))

## Method 2 - directly use the mean value to determine the dummy value.
##   Based on pnorm of 'Back' and 'Lay' to determine which come first 
##   due to OHLC table has no timeline to know highest or lowest price 
##   come first therefore we don't know buy or sell transaction will be 
##   done first.
##   There will be a high risk due to the placed stakes will be different 
##   based on the percentage of bankroll and percentage of winning.
obs %<>% mutate(
  Median = (Lst.High + Lst.Low)/2, 
  Rdm = round(pnorm(Median, mean = mean(Median), sd = sd(Median)), 0))

## In order to know the timeline price movement, here I gather tick data 
##   via https://tickdata.fxcorporate.com/EURUSD/2018/25.csv.gz

dir.create('testRealTimeTransc/data/tickdata')
## number of week from 25:52
llply(25:52, function(i) {
  if(!file.exists(paste0('testRealTimeTransc/data/tickdata/W', i, '.csv.gz')))
    download.file(url = paste0('https://tickdata.fxcorporate.com/EURUSD/2018/', i,'.csv.gz'), 
                               destfile = paste0('testRealTimeTransc/data/tickdata/W', i, '.csv.gz'))
  })

library(R.utils)
llply(25:52, function(i) {
  if(!file.exists(paste0('testRealTimeTransc/data/tickdata/W', i, '.csv')))
    R.utils::gunzip(paste0('testRealTimeTransc/data/tickdata/W', i, '.csv.gz'), remove = FALSE)
})

## https://www.r-bloggers.com/memory-limit-management-in-r/
w <- dir('testRealTimeTransc/data/tickdata', pattern = '.csv$')
ldply(w, function(x) {
  fread(paste0('testRealTimeTransc/data/tickdata/', x))
})

## download txt format data due to csv files oversize...
llply(25:52, function(i) {
  download.file(paste0('https://github.com/englianhu/Quant-Strategies-HFT/blob/master/data/W', i,'.zip?raw=true'), 
                destfile = paste0('testRealTimeTransc/data/tickdata/W', i,'.zip'))
  })


llply(dir('testRealTimeTransc/data/tickdata', pattern = '.zip$'), function(x) {
  unzip(paste0('testRealTimeTransc/data/tickdata/', x), exdir = 'testRealTimeTransc/data/tickdata')
  })

## read files into 1 file.
WT <- ldply(dir('testRealTimeTransc/data/tickdata', pattern = '.txt$'), function(x) {
  data.table::fread(paste0('testRealTimeTransc/data/tickdata/', x))
  }) %>% tbl_df %>% mutate(
    DateTime = mdy_hms(DateTime), 
    Date = as.Date(DateTime))






## Various packages for moving average
## https://vandomed.github.io/moving_averages.html

## ------------------------------ rename file.name -----------------------------------
#ldply(dir('testRealTimeTransc/data', pattern = '^fit.'), function(dt) 
#  readRDS(paste0('testRealTimeTransc/data/', as.character(dt))))

#nm <- llply(dir('testRealTimeTransc/data', pattern = '^fit.'), function(x) {
#  str_replace_all(x, '^fit.', 'fcstPunterGMT')
#})
#
#file.rename(from = file.path(getwd(), 'testRealTimeTransc/data', 
#                             list.files('testRealTimeTransc/data', pattern = '^fit.')), 
#            to = file.path(getwd(), 'testRealTimeTransc/data', nm))

## Set as our daily settlement price.
obs.data <- mbase[index(mbase) > dateID0]

#pred.data %>% mutate(
#  ProbB = pnorm(Fct.Low, mean = mean(Fct.High), sd = sd(Fct.High)), 
#  ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
#  Fct.Low = round(Fct.Low, 3)) %>% data.table

#pred.data %>% mutate(
#  ProbB = pnorm(Fct.High, mean = mean(Fct.Low), sd = sd(Fct.Low)), 
#  ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
#  Fct.Low = round(Fct.Low, 3)) %>% data.table

## Closed price as settlement price for those no closing transaction.
Closed <- mbase %>% Cl %>% data.frame
Closed <- data.frame(LatestDate.GMT = as.Date(rownames(Closed)), 
                     Lst.Close = Closed$JPY.X.Close)
rownames(Closed) <- NULL

pred.data <- plyr::join(pred.data, Closed, by = 'LatestDate.GMT')


# --------------------------------- Kelly LH HL------------------------------

#> pred.dataHL <- plyr::join(pred.dataHL, Closed, by = 'LatestDate.GMT')
#> 
#> KellyS(pred.dataHL, .preCat = 'Hi', .forCat = 'Lo') %>% 
#    select(BR, Profit, Bal) %>% tail
# BR    Profit      Bal
#255 10009.05  0.000000 10009.05
#256 10009.05  0.000000 10009.05
#257 10009.05 -4.163753 10004.88
#258 10004.88  0.000000 10004.88
#259 10004.88 -3.678163 10001.21
#260 10001.21 10.258022 10011.46
#> pred.dataLH <- plyr::join(pred.dataLH, Closed, by = 'LatestDate.GMT')
#> 
#> KellyS(pred.dataLH, .preCat = 'Lo', .forCat = 'Hi') %>% select(BR, Profit, Bal) %>% tail
# BR   Profit      Bal
#255 10395.06 3.368258 10398.43
#256 10398.43 0.000000 10398.43
#257 10398.43 0.000000 10398.43
#258 10398.43 0.000000 10398.43
#259 10398.43 0.000000 10398.43
#260 10398.43 0.000000 10398.43



## ================== Declaration ========================================
options(warn = -1, 'getSymbols.yahoo.warning' = FALSE)
suppressPackageStartupMessages(suppressWarnings(require('BBmisc')))
suppressAll(require('shiny'))
suppressAll(require('cronR'))
suppressAll(require('xts'))
suppressAll(require('quantmod'))
suppressAll(require('TFX'))
suppressAll(require('lubridate'))
suppressAll(require('plyr'))
suppressAll(require('dplyr'))
suppressAll(require('data.table'))
suppressAll(require('tidyr'))
suppressAll(require('magrittr'))
suppressAll(require('memoise'))
suppressAll(require('stringr'))
suppressAll(require('RCurl'))
suppressAll(require('rugarch'))
suppressAll(require('rmgarch'))
suppressAll(require('forecast'))

Sys.setenv(TZ = 'GMT')
zones <- attr(as.POSIXlt(now('GMT')), 'tzone')
zone <- ifelse(zones[[1]] == '', paste(zones[-1], collapse = '/'), 
               zones[[1]])
timeR <- now('GMT')

#fx <- c('EURUSD=X', 'JPY=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'AUDUSD=X')
fx <- c('JPY=X')

#fxObj <- c('EURUSD', 'USDJPY', 'GBPUSD', 'USDCHF', 'USDCAD', 'AUDUSD')
fxObj <- c('USDJPY')

wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday')
wd %<>% factor(., levels = ., ordered = TRUE)
## https://beta.rstudioconnect.com/connect/#/apps/3803/logs
## ====================== Data ========================================
#if(weekdays(today('GMT')) %in% wd) {
  #prd <- ifelse(weekdays(today('GMT')) %in% wd[2:5], 1, 3)
#'@   prd = 1 #since count trading day.
#'@   
#'@   for(i in seq(fx)) {
#'@     assign(fxObj[i], na.omit(suppressWarnings(
#'@       getSymbols(fx[i], from = (today('GMT') - days(prd)) %m-% years(1), 
#'@                  to = (today('GMT') - days(prd)), auto.assign = FALSE)))) }
#'@   rm(i)
#}
#mbase <- `JPY=X`
#rm(`JPY=X`)
#'@ names(USDJPY) <- str_replace_all(names(USDJPY), 'JPY.X', 'USD.JPY')
#'@ USDJPY %<>% na.omit

## ================== Functions ========================================
# Function to get new observations
#'@ get_new_data <- function() readLines('http://webrates.truefx.com/rates/connect.html')

armaSearch <- function(data, .method = 'CSS-ML'){ 
  ## ARMA Modeling寻找AIC值最小的p,q
  ##
  ## I set .method = 'CSS-ML' as default method since the AIC value we got is 
  ##  smaller than using method 'ML' while using method 'CSS' facing error.
  ## 
  ## https://stats.stackexchange.com/questions/209730/fitting-methods-in-arima
  ## According to the documentation, this is how each method fits the model:
  ##  - CSS minimises the sum of squared residuals.
  ##  - ML maximises the log-likelihood function of the ARIMA model.
  ##  - CSS-ML mixes both methods: first, CSS is run, the starting parameters 
  ##    for the optimization algorithm are set to zeros or to the values given 
  ##    in the optional argument init; then, ML is applied passing the CSS 
  ##    parameter estimates as starting parameter values for the optimization algorithm.
  
  .methods = c('CSS-ML', 'ML', 'CSS')
  
  if(!.method %in% .methods) stop(paste('Kindly choose .method among ', 
                                        paste0(.methods, collapse = ', '), '!'))
  
  armacoef <- data.frame()
  for (p in 0:5){
    for (q in 0:5) {
      #data.arma = arima(diff(data), order = c(p, 0, q))
      #'@ data.arma = arima(data, order = c(p, 1, q), method = .method)
      if(.method == 'CSS-ML') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma, mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'ML')
          mth = 'ML'
          list(arma = arma, mth = mth)
        })
      } else if(.method == 'ML') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'ML')
          mth = 'ML'
          list(arma = arma, mth = mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma = arma, mth = mth)
        })
      } else if(.method == 'CSS') {
        data.arma = tryCatch({
          arma = arima(data, order = c(p, 1, q), method = 'CSS')
          mth = 'CSS'
          list(arma = arma, mth = mth)
        }, error = function(e) {
          arma = arima(data, order = c(p, 1, q), method = 'CSS-ML')
          mth = 'CSS-ML'
          list(arma = arma, mth = mth)
        })
      } else {
        stop(paste('Kindly choose .method among ', 
                   paste0(.methods, collapse = ', '), '!'))
      }
      names(data.arma) <- c('arma', 'mth')
      
      #cat('p =', p, ', q =', q, 'AIC =', data.arma$arma$aic, '\n')
      armacoef <- rbind(armacoef, c(p, q, data.arma$arma$aic))
    }
  }
  
  colnames(armacoef) <- c('p', 'q', 'AIC')
  pos <- which(armacoef$AIC == min(armacoef$AIC))
  cat(paste0('method = \'', data.arma$mth, '\', the min AIC = ', 
             armacoef$AIC[pos], ', p = ', armacoef$p[pos], 
             ', q = ', armacoef$q[pos], '\n'))
  return(armacoef)
}

filterFX <- function(mbase, currency = 'JPY=X', price = 'Cl') {
  
  if(currency == 'AUDUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`AUDUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`AUDUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('AUDUSD=X', 'AUD.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'EURUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`EURUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`EURUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('EURUSD=X', 'EUR.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'GBPUSD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`GBPUSD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`GBPUSD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('GBPUSD=X', 'GBP.USD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CHF=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CHF=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CHF=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CHF=X', 'USD.CHF')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CAD=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CAD=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CAD=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CAD=X', 'USD.CAD')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'CNY=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`CNY=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`CNY=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('CNY=X', 'USD.CNY')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else if(currency == 'JPY=X') {
    if(price == 'Op') {
      mbase %<>% Op %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Hi') {
      mbase %<>% Hi %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Lo') {
      mbase %<>% Lo %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Cl') {
      mbase %<>% Cl %>% na.omit; rm(`JPY=X`)
    } else if(price == 'Ad') {
      mbase %<>% Ad %>% na.omit; rm(`JPY=X`)
    } else {
      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
    }
    names(mbase) %<>% str_replace_all('JPY=X', 'USD.JPY')
    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
    
  } else {
    stop('Kindly choose common currencies exchange.')
  }
  return(mbase)
}

#filterFX <- function(mbase, currency, price = 'Cl') {
#  if(currency == 'AUDUSD=X') {
#    if(price == 'Op') {
#      mbase <- `AUDUSD=X` %>% Op %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `AUDUSD=X` %>% Hi %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `AUDUSD=X` %>% Lo %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `AUDUSD=X` %>% Cl %>% na.omit; rm(`AUDUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `AUDUSD=X` %>% Ad %>% na.omit; rm(`AUDUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('AUDUSD=X', 'AUD.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'EURUSD=X') {
#    if(price == 'Op') {
#      mbase <- `EURUSD=X` %>% Op %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `EURUSD=X` %>% Hi %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `EURUSD=X` %>% Lo %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `EURUSD=X` %>% Cl %>% na.omit; rm(`EURUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `EURUSD=X` %>% Ad %>% na.omit; rm(`EURUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('EURUSD=X', 'EUR.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'GBPUSD=X') {
#    if(price == 'Op') {
#      mbase <- `GBPUSD=X` %>% Op %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `GBPUSD=X` %>% Hi %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `GBPUSD=X` %>% Lo %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `GBPUSD=X` %>% Cl %>% na.omit; rm(`GBPUSD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `GBPUSD=X` %>% Ad %>% na.omit; rm(`GBPUSD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('GBPUSD=X', 'GBP.USD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CHF=X') {
#    if(price == 'Op') {
#      mbase <- `CHF=X` %>% Op %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CHF=X` %>% Hi %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CHF=X` %>% Lo %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CHF=X` %>% Cl %>% na.omit; rm(`CHF=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CHF=X` %>% Ad %>% na.omit; rm(`CHF=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CHF=X', 'USD.CHF')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CAD=X') {
#    if(price == 'Op') {
#      mbase <- `CAD=X` %>% Op %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CAD=X` %>% Hi %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CAD=X` %>% Lo %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CAD=X` %>% Cl %>% na.omit; rm(`CAD=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CAD=X` %>% Ad %>% na.omit; rm(`CAD=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CAD=X', 'USD.CAD')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'CNY=X') {
#    if(price == 'Op') {
#      mbase <- `CNY=X` %>% Op %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Hi') {
#      mbase <- `CNY=X` %>% Hi %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Lo') {
#      mbase <- `CNY=X` %>% Lo %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Cl') {
#      mbase <- `CNY=X` %>% Cl %>% na.omit; rm(`CNY=X`)
#    } else if(price == 'Ad') {
#      mbase <- `CNY=X` %>% Ad %>% na.omit; rm(`CNY=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('CNY=X', 'USD.CNY')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else if(currency == 'JPY=X') {
#    if(price == 'Op') {
#      mbase <- `JPY=X` %>% Op %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Hi') {
#      mbase <- `JPY=X` %>% Hi %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Lo') {
#      mbase <- `JPY=X` %>% Lo %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Cl') {
#      mbase <- `JPY=X` %>% Cl %>% na.omit; rm(`JPY=X`)
#    } else if(price == 'Ad') {
#      mbase <- `JPY=X` %>% Ad %>% na.omit; rm(`JPY=X`)
#    } else {
#      stop("'price' must be 'Op', 'Hi', 'Lo', 'Cl' or 'Ad'.")
#    }
#    names(mbase) %<>% str_replace_all('JPY=X', 'USD.JPY')
#    names(mbase) %<>% str_replace_all('Open|.High|.Low|.Close|Adjusted', '')
#    
#  } else {
#    stop('Kindly choose common currencies exchange.')
#  }
#  return(mbase)
#}

# Using "memoise" to automatically cache the results
calC <- memoise(function(mbase, currency = 'JPY=X', ahead = 1, price = 'Cl') {
  
  mbase = filterFX(mbase, currency = currency, price = price)
  
  armaOrder = armaSearch(mbase)
  armaOrder %<>% dplyr::filter(AIC == min(AIC)) %>% .[c('p', 'q')] %>% unlist
  
  spec = ugarchspec(
    variance.model = list(
      model = 'gjrGARCH', garchOrder = c(1, 1), 
      submodel = NULL, external.regressors = NULL, 
      variance.targeting = FALSE), 
    mean.model = list(
      armaOrder = armaOrder, 
      include.mean = TRUE, archm = FALSE, 
      archpow = 1, arfima = FALSE, 
      external.regressors = NULL, 
      archex = FALSE), 
    distribution.model = 'snorm')
  fit = ugarchfit(spec, mbase, solver = 'hybrid')
  fc = ugarchforecast(fit, n.ahead = ahead)
  res = tail(attributes(fc)$forecast$seriesFor, 1)
  colnames(res) = names(mbase)
  latestPrice = tail(mbase, 1)
  
  #----
  ## count the number of days to forecast.
  #dy = ifelse(weekdays(index(latestPrice)) %in% wd[1:4], 1, 2)
  #if(weekdays(index(latestPrice)) %in% wd[c(1:3, 7)]) {
  #  dy <- 1
  #} else if(weekdays(index(latestPrice)) %in% wd[6]) {
  #  dy <- 2
  #} else if(weekdays(index(latestPrice)) %in% wd[4:5]) {
  #  dy <- 3
  #} else {
  #  stop('Weekdays must be within Monday to Sunday.')
  #}
  #----
  #forDate = latestPrice %>% index + days(dy)
  
  ## straighly use today('GMT') since last date will be the last 
  ##   trading day we get from getSymbols(), therefore the next 
  ##   trading day will be today('GMT').
  #'@ forDate = as.Date(today('GMT'))
  
  #rownames(res) <- as.character(forDate)
  latestPrice <- xts(latestPrice)
  #res <- as.xts(res)
  
  tmp = list(latestPrice = latestPrice, forecastPrice = res)
  return(tmp)
})

forecastUSDJPY <- function(mbase, currency = 'JPY=X', ahead = 1, price = 'Cl') {
  forC.USDJPY <- calC(mbase, currency = currency, ahead = ahead, price = price)
  
  fxC <- data.frame(
    LatestDate.GMT = index(forC.USDJPY$latestPrice), 
    latestPrice = forC.USDJPY$latestPrice, 
    #ForecastDate.GMT = index(forC.USDJPY$forecastPrice), 
    ForecastDate.GMT = rownames(forC.USDJPY$forecastPrice), 
    Currency = forC.USDJPY$forecastPrice)
  
  rownames(fxC) <- NULL
  nm <- names(mbase) %>% 
    str_replace_all('.Open|.High|.Low|.Close|.Volume|.Adjusted', '') %>% unique
  
  if(nm == 'USD.JPY') {
    if(price == 'Op') fxC %<>% dplyr::rename(Lst.Open = USD.JPY, Fct.Open = USD.JPY.1)
    if(price == 'Hi') fxC %<>% dplyr::rename(Lst.High = USD.JPY, Fct.High = USD.JPY.1)
    if(price == 'Lo') fxC %<>% dplyr::rename(Lst.Low = USD.JPY, Fct.Low = USD.JPY.1)
    if(price == 'Cl') fxC %<>% dplyr::rename(Lst.Close = USD.JPY, Fct.Close = USD.JPY.1)
  }
  if(nm == 'USDJPY') {
    if(price == 'Op') fxC %<>% dplyr::rename(Lst.Open = USDJPY, Fct.Open = USDJPY.1)
    if(price == 'Hi') fxC %<>% dplyr::rename(Lst.High = USDJPY, Fct.High = USDJPY.1)
    if(price == 'Lo') fxC %<>% dplyr::rename(Lst.Low = USDJPY, Fct.Low = USDJPY.1)
    if(price == 'Cl') fxC %<>% dplyr::rename(Lst.Close = USDJPY, Fct.Close = USDJPY.1)
  }
  
  return(fxC)
  }

forecastUSDJPYHL <- function(mbase, .preCat = 'Op', .setPrice = 'Cl', 
                             currency = 'JPY=X', ahead = 1){
  fx1 <- forecastUSDJPY(mbase, currency = currency, ahead = ahead, price = .preCat)
  fx2 <- forecastUSDJPY(mbase, currency = currency, ahead = ahead, price = .setPrice)
  fxm <- merge(fx1, fx2, by = c('LatestDate.GMT', 'ForecastDate.GMT'))
  rm(fx1, fx2)
  
  fxm <- fxm[c(1, 3, 5, 2, 4, 6)]
  return(fxm)
  }

simKelly <- function(mbase) {
  
  
  return(res)
  }

kellyBet <- function(mbase, initialFundSize = 10000){
  
  ## https://quantstrattrader.wordpress.com/2017/09/29/the-kelly-criterion-does-it-work/
  mbase %<>% data.frame
  names(mbase) <- str_replace_all(names(mbase), 'JPY.X', 'USDJPY')
  ## https://github.com/englianhu/binary.com-interview-question/blob/master/function/simStakesGarch.R
  ## 
  # pred.data %>% mutate(ProbB = pnorm(Fct.High, mean = mean(Fct.Low), 
  #                                    sd = sd(Fct.Low)), 
  #                      ProbS = 1 - ProbB, 
  #                      Fct.High = round(Fct.High, 3), 
  #                      Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB      ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.8280676 0.17193237
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.8845984 0.11540162
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.8323185 0.16768149
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.9170950 0.08290501
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.9331140 0.06688596
  #---                                                                                       
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.3766011 0.62339887
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.4827210 0.51727904
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.4478401 0.55215994
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.5616675 0.43833251
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.5845864 0.41541355
  # 
  # 
  # pred.data %>% mutate(ProbB = pnorm(Fct.Low, mean = mean(Fct.High), 
  #                                    sd = sd(Fct.High)), 
  #                      ProbS = 1 - ProbB, 
  #                      Fct.High = round(Fct.High, 3), 
  #                      Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.4753219 0.5246781
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.4753219 0.5246781
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.4753219 0.5246781
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.4753219 0.5246781
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.4753219 0.5246781
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.4753219 0.5246781
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.4753219 0.5246781
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.4753219 0.5246781
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.4753219 0.5246781
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4753219 0.5246781
  # 
  # 
  # pred.data %>% mutate(
  #   ProbB = pnorm(Fct.Low, mean = mean(Lst.High), sd = sd(Lst.High)), 
  #   ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
  #   Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.6829508 0.3170492
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.7296487 0.2703513
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.6774416 0.3225584
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.7901496 0.2098504
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.8303839 0.1696161
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.3242934 0.6757066
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.2961039 0.7038961
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.3906327 0.6093673
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.3677742 0.6322258
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4816531 0.5183469
  #
  # pred.data %>% mutate(
  #   ProbB = pnorm(Fct.Low, mean = mean(Fct.Low), sd = sd(Fct.Low)), 
  #   ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
  #   Fct.Low = round(Fct.Low, 3)) %>% data.table
  #
  #   LatestDate.GMT Lst.High Lst.Low ForecastDate.GMT Fct.High Fct.Low     ProbB     ProbS
  #1:     2017-06-27  112.399 111.863              T+1  112.547 111.766 0.7106333 0.2893667
  #2:     2017-06-28  112.920 112.154              T+1  113.050 112.085 0.7626865 0.2373135
  #3:     2017-06-29  112.389 111.749              T+1  112.581 111.730 0.7044035 0.2955965
  #4:     2017-07-02  113.417 112.204              T+1  113.424 112.543 0.8275657 0.1724343
  #5:     2017-07-03  113.370 112.779              T+1  113.651 112.893 0.8685511 0.1314489
  #---                                                                                      
  #257:     2018-06-25  110.016 109.389              T+1  110.031 109.579 0.2943248 0.7056752
  #258:     2018-06-26  110.479 109.688              T+1  110.572 109.391 0.2627786 0.7372214
  #259:     2018-06-27  110.411 109.974              T+1  110.396 109.997 0.3701970 0.6298030
  #260:     2018-06-28  110.871 110.388              T+1  110.968 109.856 0.3438371 0.6561629
  #261:     2018-07-01  111.053 110.606              T+1  111.084 110.541 0.4765542 0.5234458
  
  mbase %<>% mutate(
    ProbB = pnorm(Fct.Low, mean = mean(Fct.High), sd = sd(Fct.High)), 
    ProbS = 1 - ProbB, Fct.High = round(Fct.High, 3), 
    Fct.Low = round(Fct.Low, 3)) %>% data.table
  
  # Kelly criterion
  # Advantages = (prob of win * decimal odds) + (prob of lose * -1)
  # Optimal Kelly wager % = Advantages / decimal odds
  mbase$Adv <- (mbase$EMprob * mbase$COMOdds) + ((1-mbase$EMprob) * -1)
  mbase$Staking <- mbase$Adv / mbase$COMOdds
  mbase$Staking <- ifelse(mbase$Staking < 0, 0, mbase$Staking)
  
  return(res)
  }

# ---------------- KellyS ------------------------------------------
## http://srdas.github.io/MLBook/Gambling.html
KellyS <- function(fitm, .preCat = 'Lo', .forCat = 'Hi', .initialFundSize = 10000, 
                   .filterBets = FALSE, .fundLeverageLog = FALSE) {
  
  fitm %<>% na.omit
  
  if(.preCat == 'Op') fitm %<>% rename(Point.Forecast = Fct.Open)
  if(.preCat == 'Hi') fitm %<>% rename(Point.Forecast = Fct.High)
  if(.preCat == 'Lo') fitm %<>% rename(Point.Forecast = Fct.Low)
  if(.preCat == 'Cl') fitm %<>% rename(Point.Forecast = Fct.Close)
  
  if(.forCat == 'Op') fitm %<>% rename(forClose = Fct.Open)
  if(.forCat == 'Hi') fitm %<>% rename(forClose = Fct.High)
  if(.forCat == 'Lo') fitm %<>% rename(forClose = Fct.Low)
  if(.forCat == 'Cl') fitm %<>% rename(forClose = Fct.Close)
  
  fitm %<>% mutate(
    ProbB = pnorm(Point.Forecast, mean = mean(forClose), sd = sd(forClose)), 
    ProbS = 1 - ProbB)#, Fct.High = round(Fct.High, 3), 
  #Fct.Low = round(Fct.Low, 3))
  
  fitm %<>% mutate(Point.Forecast = round(lag(Point.Forecast), 3), 
                   forClose = round(lag(forClose), 3)) %>% na.omit %>% data.table
  
  fitm %<>% mutate(BR = .initialFundSize) %>% 
    #'@ mutate(Return.Back = ifelse(Prob > 0.5, Diff * Back * stakes, 0), 
    #'@        Return.Lay = ifelse(Prob < 0.5, -Diff * Lay * stakes, 0))
    mutate(fB = 2 * ProbB - 1, fS = 2 * ProbS - 1, 
           #EUB = ProbB * log(BR * (1 + fB)) + (1 - ProbB) * log(BR * (1 - fB)), 
           #EUS = ProbS * log(BR * (1 + fS)) + (1 - ProbS) * log(BR * (1 - fS)), 
           EUB = ProbB * log(ProbB) + (1 - ProbB) * log(1 - ProbB), 
           EUS = ProbS * log(ProbS) + (1 - ProbS) * log(1 - ProbS), 
           #EUB = ProbB * (BR * (1 + fB)) + (1 - ProbB) * (BR * (1 - fB)), 
           #EUS = ProbS * (BR * (1 + fS)) + (1 - ProbS) * (BR * (1 - fS)), 
           #'@ Edge = ifelse(f > 0, EUB, EUS), #For f > 0 need to buy and f <= 0 need to sell.
           #need to study on the risk management on "predicted profit" and "real profit".
           Edge = ifelse(fB > 0, EUB, ifelse(fS > 0, EUS, 0)), 
           PF = ifelse(Point.Forecast >= Lst.Low & 
                         Point.Forecast <= Lst.High, 
                       Point.Forecast, 0), #if forecasted place-bet price doesn't existing within Hi-Lo price, then the buying action is not stand. Assume there has no web bandwith delay.
           FC = ifelse(forClose >= Lst.Low & forClose <= Lst.High, 
                       forClose, Lst.Close), #if forecasted settle price doesn't existing within Hi-Lo price, then the closing action at closing price. Assume there has no web bandwith delay.
           #'@ Diff = round(forClose - USDJPY.Close, 2),
           ##forecasted closed price minus real close price.
           
           Buy = ifelse(PF > 0 & FC > PF, 1, 0), ##buy action
           Sell = ifelse(PF > 0 & FC < PF, 1, 0), ##sell action
           BuyS = Edge * Buy * (forClose - PF), 
           SellS = Edge * Sell * (PF - forClose), 
           Profit = BuyS + SellS, Bal = BR + Profit)
  
  
  #'@ fitm %>% dplyr::select(Point.Forecast, forClose, Prob, BR, f, EU, Edge, PF, FC, Buy, Sell, SP, Bal)
  #'@ fitm %>% dplyr::select(ProbB, ProbS, BR, fB, fS, EUB, EUS, Edge, PF, USDJPY.Open, FC, Buy, Sell, BuyS, SellS, Profit, Bal) %>% filter(PF > 0, FC > 0)
  
  ## The ets staking models (Kelly criterion) Adjusted Banl-roll and Balance column.
  for(i in seq(2, nrow(fitm))) {
    fitm$BR[i] = fitm$Bal[i - 1]
    fitm$fB[i] = 2 * fitm$ProbB[i] - 1
    fitm$fS[i] = 2 * fitm$ProbS[i] - 1
    fitm$EUB[i] = fitm$ProbB[i] * log(fitm$BR[i] * (1 + fitm$fB[i])) + 
      (1 - fitm$ProbB[i]) * log(fitm$BR[i] * (1 - fitm$fB[i]))
    fitm$EUS[i] = fitm$ProbS[i] * log(fitm$BR[i] * (1 + fitm$fS[i])) + 
      (1 - fitm$ProbS[i]) * log(fitm$BR[i] * (1 - fitm$fS[i]))
    fitm$Edge[i] = ifelse(fitm$fB[i] > 0, fitm$EUB[i], 
                          ifelse(fitm$fS[i] > 0, fitm$EUS[i], 0)) #For f > 0 need to buy and f <= 0 need to sell.
    #need to study on the risk management on "predicted profit" and "real profit".
    
    fitm$BuyS[i] = fitm$Edge[i] * fitm$Buy[i] * (fitm$forClose[i] - fitm$PF[i])
    fitm$SellS[i] = fitm$Edge[i] * fitm$Sell[i] * (fitm$PF[i] - fitm$forClose[i])
    fitm$Profit[i] = fitm$BuyS[i] + fitm$SellS[i]
    fitm$Bal[i] = fitm$BR[i] + fitm$Profit[i]
    if(fitm$Bal[i] <= 0) stop('All invested fund ruined!')
  }; rm(i)
  
  #names(mbase) <- str_replace_all(names(mbase), '^(.*?)+\\.', nm)
  
  if(.filterBets == TRUE) {
    fitm %<>% filter(PF > 0, FC > 0)
  }
  
  fitm %<>% mutate(RR = Bal/BR)
  
  ## convert the log leverage value of fund size and profit into normal digital figure with exp().
  if(.fundLeverageLog == TRUE) fitm %<>% 
    mutate(BR = exp(BR), BuyS = exp(BuyS), SellS = exp(SellS), 
           Profit = exp(Profit), Bal = exp(Profit))
  
  return(fitm)
  }





## ================== Reference ========================================
## https://shiny.rstudio.com/articles/persistent-data-storage.html
## https://github.com/bnosac/cronR
## http://www.bnosac.be/index.php/blog/64-scheduling-r-scripts-and-processes-on-windows-and-unix-linux
## ================== Declaration ======================================
suppressWarnings(require('shiny'))
suppressWarnings(require('shinyjs'))
suppressWarnings(require('TFX'))
suppressWarnings(require('formattable'))
suppressWarnings(require('DT'))
suppressWarnings(require('cronR'))
suppressWarnings(require('xts'))
suppressWarnings(require('lubridate'))
suppressWarnings(require('plyr'))
suppressWarnings(require('dplyr'))
suppressWarnings(require('magrittr'))
suppressWarnings(require('memoise'))
suppressWarnings(require('stringr'))
suppressWarnings(require('RCurl'))
suppressWarnings(require('forecast'))

#fx <- c('EURUSD=X', 'JPY=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'AUDUSD=X')
fx <- c('JPY=X')
fxObj <- c('USDJPY')

#wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday')
wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday')
wd %<>% factor(., levels = ., ordered = TRUE)

## ================== Server ===========================================
# Define server logic required to draw a histogram
#shinyServer <- function(input, output, session) {
server <- shinyServer(function(input, output, session) {
    
    output$currentTime <- renderText({
        # Forces invalidation in 1000 milliseconds
        invalidateLater(1000, session)
        as.character(now('Asia/Tokyo')) #Japanese Timezone
    })
    
    fcstPunterData <- reactive({
        isolate({
            withProgress({
                setProgress(message = "Processing algorithmic forecast...")
                #fxHL <- forecastUSDJPYHL(ahead = prd)
                
                if(file.exists(paste0('data/fcstPunterGMT', today('GMT'), '.rds'))) {
                    fxHL <- ldply(
                        dir('data', pattern = 
                                paste0('fcstPunterGMT', today('GMT'))), function(x){
                                    readRDS(paste0('data/', x)) })
                    
                } else {
                    
                    ## https://stackoverflow.com/questions/20507247/r-repeat-function-until-condition-met?answertab=votes#tab-top
                    repeat{
                        # startTime <- now('GMT')
                        startTime <- today('GMT')
                        # validate(need(weekdays(today('GMT')) %in% wd, 'Today has no data.'))
                        
                        ## https://finance.yahoo.com/quote/AUDUSD=X?p=AUDUSD=X
                        ## Above link prove that https://finance.yahoo.com using GMT time zone.  
                        #if(weekdays(today('GMT')) %in% wd) {
                        #prd <- ifelse(weekdays(today('GMT')) %in% wd[2:5], 1, 3)
                        prd <- 1 #since count trading day.
                        
                        for(i in seq(fx)) {
                            assign(fxObj[i], na.omit(suppressWarnings(
                                getSymbols(fx[i], from = (today('GMT') - prd) %m-% years(1), 
                                           to = (today('GMT') - prd), auto.assign = FALSE)))) }
                        USDJPY %<>% na.omit
                        rm(i) #}
                        
                        fxHL <- suppressWarnings(forecastUSDJPYHL(USDJPY, ahead = prd))
                        #'@ print(as.character(now('GMT')))
                        #'@ print(fxHL)
                        if(exists('fxHL')) break
                        
                        ## scheduled sleepTime as 24 hours to start next task
                        sleepTime <- startTime + 24*60*60 - startTime
                        if (sleepTime > 0)
                            Sys.sleep(sleepTime) }
                    
                    if(!dir.exists('data')) dir.create('data')
                    if(!file.exists(paste0('data/fcstPunterGMT', today('GMT'), '.rds'))){
                        saveRDS(fxHL, paste0('data/fcstPunterGMT', today('GMT'), '.rds')) }
                }
            })
        })
        
        #'@ if(!dir.exists('data')) dir.create('data')
        #'@ if(!file.exists(paste0('data/fcstPunterGMT', today('GMT'), '.rds'))){
        #'@     saveRDS(fxHL, paste0('data/fcstPunterGMT', today('GMT'), '.rds')) }
        
        return(fxHL)
    })
    # ---------------------------------------------------------------
    ## https://segmentfault.com/a/1190000009775258
    ## seq(from = now('GMT'), length.out = 60 * 24, by = "mins") %>% range
    #'@ observeEvent({
    #'@     if(now('GMT') == timeR) {
    #'@         timeR <- timeR + minutes(1)
    #'@     } else {
    #'@         fxLo <- forecastUSDJPY(price = 'Lo')
    #'@         fxHi <- forecastUSDJPY(price = 'Hi')
    #'@         fxHL <- merge(fxHi, fxLo, by = c('.id', 'ForecastDate.GMT'))
    #'@         rm(fxHi, fxLo)
    #'@         fxHL %>% mutate(
    #'@             Currency.Hi = rnorm(6, mean = (Currency.Hi + Currency.Lo) / 2, sd = 0.001), 
    #'@             Currency.Lo = rnorm(6, mean = (Currency.Hi + Currency.Lo) / 2, sd = 0.001))
    #'@     }
    #'@     
    #'@     output$fxdata <- renderFormattable({
    #'@         
    #'@         rx <- refresh()
    #'@         
    #'@         rx %>% formattable(list(
    #'@             Bid.Price = formatter('span', 
    #'@                                   style = x ~ style(color = ifelse(x > (rx$Fct.Low + rx$Fct.High) / 2, 'red', 'green')), 
    #'@                                   x ~ icontext(ifelse(x > (rx$Fct.Low + rx$Fct.High) / 2, 'arrow-down', 'arrow-up'), x)), 
    #'@             Ask.Price = formatter('span', 
    #'@                                   style = x ~ style(color = ifelse(x < (rx$Fct.Low + rx$Fct.High) / 2, 'red', 'green')),
    #'@                                   x ~ icontext(ifelse(x < (rx$Fct.Low + rx$Fct.High) / 2, 'arrow-down', 'arrow-up'), x)), 
    #'@             Fct.Low = formatter('span', 
    #'@                                style = x ~ style(color = ifelse(x > 0, 'red', 'green')), 
    #'@                                x ~ icontext(ifelse(x > 0, 'arrow-down', 'arrow-up'), x)), 
    #'@             Fct.High = formatter('span',
    #'@                                 style = x ~ style(color = ifelse(x < 0, 'red', 'green')),
    #'@                                 x ~ icontext(ifelse(x < 0, 'arrow-down', 'arrow-up'), x))
    #'@         ))})
    #'@ })
    # ---------------------------------------------------------------
    
    fetchData <- reactive({
        #if(!input$pause)
            invalidateLater(750)
        ## http://webrates.truefx.com/rates/connect.html
        qtf <- QueryTrueFX() %>% mutate(TimeStamp = as.character(TimeStamp)) %>% 
            dplyr::rename(`TimeStamp (GMT)` = TimeStamp)
        qtf <- qtf[, c(6, 1:3, 5:4)] %>% filter(Symbol == 'USD/JPY')
        return(qtf)
    })
    
    refresh <- reactive({
        line <- fetchData()
        fcPR <- fcstPunterData()
        
        rx <- cbind(line, fcPR) %>% 
            mutate(Fct.High = round(Fct.High, 3), Fct.Low = round(Fct.Low, 3))
        
        rx %<>% dplyr::rename(`LatestDate (GMT)` = LatestDate.GMT, 
                              `ForecastDate (GMT)` = ForecastDate.GMT)
        
        trdDay <- str_split(rx$'TimeStamp (GMT)', ' ')[[1]][1]
        forDay <- rx$'ForecastDate (GMT)'
        
        ## http://www.dailypricecreaction.com/forex-begginers/forex-bid-ask-spread
        #if((rx$Fct.Low == rx$Ask.Price) & (forDay == trdDay)){
        if(rx$Fct.Low == rx$Ask.Price){
            tr.buy <- rx %>% mutate(Price = Fct.Low, Transaction = 'Buy') %>% 
                dplyr::select(`TimeStamp (GMT)`, Price, Transaction)
            saveRDS(tr.buy, paste0('data/buy.', now('GMT'), '.rds')) }
        
        #if((rx$Fct.High == rx$Bid.Price) & (forDay == trdDay)){
        if(rx$Fct.High == rx$Bid.Price){
            tr.sell <- rx %>% mutate(Price = Fct.High, Transaction = 'Sell') %>% 
                dplyr::select(`TimeStamp (GMT)`, Price, Transaction)
            saveRDS(tr.sell, paste0('data/sell.', now('GMT'), '.rds')) }
        
        return(rx)
    })
    
    output$fxdata <- renderFormattable({
    
        rx <- refresh()
        
        rx %>% formattable(list(
            Bid.Price = formatter('span', 
                                  style = x ~ style(color = ifelse(x > (rx$Fct.Low + rx$Fct.High) / 2, 'red', 'green')), 
                                  x ~ icontext(ifelse(x > (rx$Fct.Low + rx$Fct.High) / 2, 'arrow-down', 'arrow-up'), x)), 
            Ask.Price = formatter('span', 
                                  style = x ~ style(color = ifelse(x < (rx$Fct.Low + rx$Fct.High) / 2, 'red', 'green')),
                                  x ~ icontext(ifelse(x < (rx$Fct.Low + rx$Fct.High) / 2, 'arrow-down', 'arrow-up'), x)), 
            Fct.Low = formatter('span', 
                            style = x ~ style(color = ifelse(x > 0, 'red', 'green')), 
                            x ~ icontext(ifelse(x > 0, 'arrow-down', 'arrow-up'), x)), 
            Fct.High = formatter('span',
                             style = x ~ style(color = ifelse(x < 0, 'red', 'green')),
                             x ~ icontext(ifelse(x < 0, 'arrow-down', 'arrow-up'), x))
        ))})
    
    output$transc <- DT::renderDataTable({
        
        input$refresh
        
        if(length(dir('data', pattern = 'sell|buy')) > 0) {
            trn <- ldply(dir('data', pattern = 'sell|buy'), function(x){
                readRDS(paste0('data/', x)) }) %>% 
                mutate(`TimeStamp (GMT)` = ymd_hms(`TimeStamp (GMT)`), 
                       Transaction = factor(Transaction)) %>% 
                dplyr::arrange(desc(`TimeStamp (GMT)`)) %>% 
                mutate(ID = rev(seq_len(nrow(.))), 
                       `TimeStamp (GMT)` = factor(`TimeStamp (GMT)`))
        } else {
            trn <- NULL
        }
        
        trn %>% DT::datatable(caption = "Transaction Table", 
                              escape = FALSE, filter = 'top', rownames = FALSE, 
                              extensions = list('ColReorder' = NULL, 'RowReorder' = NULL, 
                                                'Buttons' = NULL, 'Responsive' = NULL), 
                              options = list(dom = 'BRrltpi', scrollX = TRUE, #autoWidth = TRUE, 
                                             lengthMenu = list(c(10, 50, 100, -1), c('10', '50', '100', 'All')), 
                                             ColReorder = TRUE, rowReorder = TRUE, 
                                             buttons = list('copy', 'print', 
                                                            list(extend = 'collection', 
                                                                 buttons = c('csv', 'excel', 'pdf'), 
                                                                 text = 'Download'), I('colvis'))))
    })
    
    ## https://shiny.rstudio.com/articles/reconnecting.html
    ## Set this to "force" instead of TRUE for testing locally (without Shiny Server)
    #session$allowReconnect(TRUE)
    })

# Run the application 
#'@ shinyApp(ui = ui, server = server)
#'@ runApp('testRealTimeTransc', display.mode = 'showcase')

## ================== Declaration =====================================
suppressWarnings(require('shiny'))
suppressWarnings(require('formattable'))
suppressWarnings(require('DT'))
suppressWarnings(require('memoise'))
suppressWarnings(require('TFX'))
suppressWarnings(require('stringr'))
suppressWarnings(require('RCurl'))

## ===================== UI ===========================================
# Define UI for application that draws a histogram
shinyUI <- fluidPage(
  
  # Application title
  titlePanel(div(
    img(src = 'ENG.jpg', width = '40', align = 'right'), 
    img(src = 'RYO.jpg', width = '20', align = 'right'), 
    img(src = 'binary-logo-resize.jpg', width = '200'), 
    'Real Time Trading System (Trial)')),
  
  pageWithSidebar(
    mainPanel(
      tabsetPanel(
        tabPanel('Price Board', 
                 br(), 
                 p('By refer to', 
                   HTML("<a href='http://matchodds.org'>Match Odds</a>"), 
                   'I created this app to test the real-time trading system for hedge fund... ', 
                   'Once the buying/selling limit orders match the ask/bid offer by banker ', 
                   'a transaction will be closed.', strong('Fct.High'), 'is the sell limit ', 
                   'order while', strong('Fct.Low'), 'is the buy limit order. Kindly refer to', 
                   HTML("<a href='https://dailypriceaction.com/forex-beginners/forex-bid-ask-spread'>Forex Bid Ask Spread</a>"), 
                   'for more information.'), 
                 p('I will fit the real-time trading into ', 
                   HTML("<a href='https://beta.rstudioconnect.com/content/3138/'>Q1App2</a>"), 
                   'in the', strong('Punter tab'), '(Hedge Fund). Kindly refer to ', 
                   HTML("<a href='https://github.com/englianhu/binary.com-interview-question'>binary.com Interview Question</a>"), 
                   'for project details.'), 
                 tags$hr(),
                 h4('Real Time Data'), 
                 p('Real Time bid/ask price and placed orders.'), 
                 p(strong(paste0('Current time (Asia/Tokyo):')), 
                   # p(strong(paste0('Current time (', zone, '):')), 
                   textOutput('currentTime', inline = TRUE)),
                 # actionButton('calculate', 'Start Calculate', 
                 #              icon = icon('calculator'), class = 'btn-primary'), 
                 formattableOutput('fxdata'), 
                 br(), 
                 tags$hr(), 
                 h4('Transaction List'), 
                 p('Below shows the transactions done.'), 
                 actionButton('refresh', 'Refresh Data', 
                              icon = icon('refresh'), class = 'btn-primary'), 
                 br(), 
                 DT::dataTableOutput('transc')), 
        
        tabPanel('Settlement List', 
                 br(), 
                 p('The transaction list will be settled once the opposite site ', 
                   'bid/ask request met. Otherwise, the closed price will be the', 
                   'price for closed transaction.'), 
                 tags$hr()
                 ), 
        tabPanel('Profit & Lose', 
                 br(), 
                 p('The settlement list will be compounded and plot as a graph to ', 
                   'the ROI (return of investment). Therefore investors can evaluate ', 
                   'the performance of the hedge fund.'), 
                 tags$hr()
        ))), 
    
    
    br(), 
    p('Powered by - Copyright® Intellectual Property Rights of ', 
      tags$a(href='http://www.scibrokes.com', target = '_blank', 
             tags$img(height = '20px', alt = 'scibrokes', #align='right', 
                      src='https://raw.githubusercontent.com/scibrokes/betting-strategy-and-model-validation/master/regressionApps/oda-army.jpg')), 
      HTML("<a href='http://www.scibrokes.com'>Scibrokes®</a>"))))