Application of cronR in Shiny App scheduled task

cronr

#1

I would like to schedule a daily task to scrap and calculate price.

cronR : Add scheduled task

> cronR:::cron_rstudioaddin()
Loading required namespace: miniUI
Loading required namespace: shinyFiles

Listening on http://127.0.0.1:5145
Warning in normalizePath(input$rscript_repository, winslash = "/") :
  path[1]="/cloud/project/Q": No such file or directory
RscriptRepository /cloud/project/Q does not exist, make sure this is an existing directory without spaces
Adding cronjob:
---------------

## cronR job
## id:   job_a8c93b03178d613ed999810c61baa9c1
## tags: forex
## desc: Scraping data for algorithmic calculation.
0 0 * * * /opt/R/3.4.4/lib/R/bin/Rscript '/cloud/project/Q1App2/global.R'  >> '/cloud/project/Q1App2/global.log' 2>&1

Below is my script for reproducible task...

suppressWarnings(require('cronR'))
suppressWarnings(require('xts'))
suppressWarnings(require('quantmod'))
suppressWarnings(require('lubridate'))

fx <- c('EURUSD=X', 'JPY=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'AUDUSD=X')
wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday')

#'@ if(now('GMT') == today('GMT')) {
## 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) {
  for(i in seq(fx)) {
    getSymbols(fx[i], from = (today('GMT') - 1) %m-% years(1), 
               to = (today('GMT') - 1))
  }
  rm(i)
}

Reference


#2

Just checking because I wasn’t totally sure: do you have a question, or are you just reporting the solution you’ve found?


#4

I would like to schedule a daily task in shiny app as refer to Application of cronR in Shiny App scheduled task but dont know how do I conduct it.

Here I refered to ReactiveTimer with if statement R-Shiny. I do appreciate if D. Iseli he or somebody else can shade me a light.


#5

Besides, I would like to write another section which can matching the bid/ask request and close a transaction. However I wonder if the invalidateLater(750) will not be able to run whole filtering and matching data within 0.75 second.

By the way, wonder if the coding is correct or not.

  output$transc <- renderTable({
    
    invalidateLater(750)
    rx <- qtf %>% filter(Symbol == 'USD/JPY') %>% 
      dplyr::select(`TimeStamp (GMT)`, Bid.Price, Ask.Price)
    
    fxHL <- fcstPunterData()
    Hi <- tail(fxHL, 1)$Currency.Hi %>% round(3)
    Lo <- tail(fxHL, 1)$Currency.Lo %>% round(3)
    transc.buy <- data.frame()
    transc.sell <- data.frame()
    
    # qtf %>% filter(Symbol == 'USD/JPY') %>% select(`TimeStamp (GMT)`, Bid.Price, Ask.Price)
    # fxHL %>% filter(.id == 'USDJPY') %>% select(Currency.Hi) %>% unclass %>% .$Currency.Hi
    if(Lo == rx$Bid.Price){
      transc.buy <- tail(fxHL, 1) %>% 
        dplyr::select(ForecastDate.GMT, Currency.Lo) %>% 
        mutate(Currency.Lo = round(Currency.Lo, 3))
      saveRDS(transc.buy, paste0('data/buy.', now('GMT'), '.rds'))
    }
    if(Hi == rx$Ask.Price){
      transc.sell <- tail(fxHL, 1) %>% 
        dplyr::select(ForecastDate.GMT, Currency.Hi) %>% 
        mutate(Currency.Hi = round(Currency.Hi, 3))
      saveRDS(transc.sell, paste0('data/sell.', now('GMT'), '.rds'))
    }
    
    tmp <- list(buy.transc = transc.buy, sell.transc = transc.sell)
    return(tmp)
  })

#7

You appear to be attempting to create this cron task in rstudio.cloud, which is not likely to work the way you would want as projects that are idle are shut down until a user comes back.

Or are you writing the script on rstudio.cloud and you intended to deploy it elsewhere?

Could you say more about what is not working?


#8

I have 2 questions here.


source code

The 1st question kindly refer to Test real-time transaction app where I wrote with display.mode = showcase to observe if the app working fine. I wonder if the coding works for matching transaction or not. As we can observe from the real-time highlighting output$transc function, I wonder if its correct or not...

2nd question will be using cronR but not describe in this post. Might be next post in this thread upon solved Q1.

App.R file for shiny app.

library('shiny')
library('TFX')
library('cronR')



# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Application title
    titlePanel("Old Faithful Geyser Data"),
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(),
        
        # Show a plot of the generated distribution
        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.'), 
            tableOutput('transc'))))

# Define server logic required to draw a histogram
server <- function(input, output, session) {
    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(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(currency, ahead = 1, price = 'Cl') {
        
        mbase = filterFX(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 = attributes(fc)$forecast$seriesFor
        colnames(res) = names(mbase)
        latestPrice = tail(mbase, 1)
        forDate = latestPrice %>% index + days(1)
        rownames(res) <- as.character(forDate)
        
        tmp = list(latestPrice = latestPrice, forecastPrice = res)
        return(tmp)
    })
    
    forecastData <- function(price = 'Cl') {
        forC.USDJPY <- calC('JPY=X', price = price)
        
        fxC <- ldply(list(
            USDJPY = forC.USDJPY), function(x) 
                data.frame(ForecastDate.GMT = rownames(x$forecastPrice), 
                                         x$forecastPrice)) %>% 
            rename(Currency = USD.JPY) %>% 
            mutate(Currency = as.numeric(str_replace_all(Currency, 'NA|_', '')))
        if(price == 'Hi') names(fxC)[3] <- 'Currency.Hi'
        if(price == 'Lo') names(fxC)[3] <- 'Currency.Lo'
        
        return(fxC)
    }
    
    fcstPunterData <- reactive({
        ## Change when the "update" button is pressed...
        #'@ input$curr
        
        ## ...but not for anything else
        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)
    })
    
    output$transc <- renderTable({
        
        fxHL <- fcstPunterData()
        Hi <- tail(fxHL, 1)$Currency.Hi %>% round(3)
        Lo <- tail(fxHL, 1)$Currency.Lo %>% round(3)
        transc.buy <- data.frame()
        transc.sell <- data.frame()
        
        invalidateLater(1000, session)
        rx <- qtf %>% filter(Symbol == 'USD/JPY') %>% 
            dplyr::select(`TimeStamp (GMT)`, Bid.Price, Ask.Price)
        
        # qtf %>% filter(Symbol == 'USD/JPY') %>% select(`TimeStamp (GMT)`, Bid.Price, Ask.Price)
        # fxHL %>% filter(.id == 'USDJPY') %>% select(Currency.Hi) %>% unclass %>% .$Currency.Hi
        if(Lo == rx$Bid.Price){
            transc.buy <- tail(fxHL, 1) %>% 
                dplyr::select(ForecastDate.GMT, Currency.Lo) %>% 
                mutate(Currency.Lo = round(Currency.Lo, 3))
            saveRDS(transc.buy, paste0('data/buy.', now('GMT'), '.rds'))
        }
        if(Hi == rx$Ask.Price){
            transc.sell <- tail(fxHL, 1) %>% 
                dplyr::select(ForecastDate.GMT, Currency.Hi) %>% 
                mutate(Currency.Hi = round(Currency.Hi, 3))
            saveRDS(transc.sell, paste0('data/sell.', now('GMT'), '.rds'))
        }
        
        tmp <- list(buy.transc = transc.buy, sell.transc = transc.sell)
        return(tmp)
    })
    
    
    # Plot the 60 most recent values
    #'@ output$realPlot <- renderPlot({
    #'@     fxD <- fcstPunterData()
    #'@ }
    }

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

global.R for variable and function declaration.

suppressWarnings(require('cronR'))
suppressWarnings(require('xts'))
suppressWarnings(require('quantmod'))
suppressWarnings(require('lubridate'))

fx <- c('EURUSD=X', 'JPY=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'AUDUSD=X')
wd <- c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday')

#'@ if(now('GMT') == today('GMT')) {
## 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) {
  for(i in seq(fx)) {
    getSymbols(fx[i], from = (today('GMT') - 1) %m-% years(1), 
               to = (today('GMT') - 1))
  }
  rm(i)
}


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(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(currency, ahead = 1, price = 'Cl') {
  
  mbase = filterFX(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 = attributes(fc)$forecast$seriesFor
  colnames(res) = names(mbase)
  latestPrice = tail(mbase, 1)
  forDate = latestPrice %>% index + days(1)
  rownames(res) <- as.character(forDate)
  
  tmp = list(latestPrice = latestPrice, forecastPrice = res)
  return(tmp)
})

forecastData <- function(price = 'Cl') {
  forC.EURUSD <- calC('EURUSD=X', price = price)
  forC.USDJPY <- calC('JPY=X', price = price)
  forC.GBPUSD <- calC('GBPUSD=X', price = price)
  forC.USDCHF <- calC('CHF=X', price = price)
  forC.USDCAD <- calC('CAD=X', price = price)
  forC.AUDUSD <- calC('AUDUSD=X', price = price)
  
  fxC <- ldply(list(EURUSD = forC.EURUSD, 
                    USDJPY = forC.USDJPY, 
                    GBPUSD = forC.GBPUSD, 
                    USDCHF = forC.USDCHF, 
                    USDCAD = forC.USDCAD, 
                    AUDUSD = forC.AUDUSD), function(x) 
                      data.frame(ForecastDate.GMT = rownames(x$forecastPrice), 
                                 x$forecastPrice)) %>% 
    unite(., Currency, EUR.USD:AUD.USD) %>% 
    mutate(Currency = as.numeric(str_replace_all(Currency, 'NA|_', '')))
  if(price == 'Hi') names(fxC)[3] <- 'Currency.Hi'
  if(price == 'Lo') names(fxC)[3] <- 'Currency.Lo'
  
  return(fxC)
}

fcstBankerData <- reactive({
  ## Change when the "update" button is pressed...
  #'@ input$curr
  
  ## ...but not for anything else
  isolate({
    withProgress({
      setProgress(message = "Processing algorithmic forecast...")
      fxCl <- forecastData()
      names(fxCl) <- str_replace_all(names(fxCl), '\\.x$', '.Cl')
    })
  })
  if(!dir.exists('data')) dir.create('data')
  if(!file.exists(paste0('data/fcstBankerGMT', today('GMT'), '.rds'))){
    saveRDS(fxCl, paste0('data/fcstBankerGMT', today('GMT'), '.rds'))
  }
  return(fxCl)
})

fcstPunterData <- reactive({
  ## Change when the "update" button is pressed...
  #'@ input$curr
  
  ## ...but not for anything else
  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)
})

fxD <- fcstBankerData()

DESCRIPTION file without files extension.

Title: Test real-time transaction
  Author: Ryo, Eng Lian Hu
AuthorUrl: https://github.com/englianhu
  License: GPL-3
DisplayMode: Showcase
Tags: getting-started
Type: Shiny

#9

The 1st question I solved few days ago, the real-time fluctuated price can be closed a transaction.

The 2nd question about resedulng task for daily calculation, I have just refer to scheduling r functions after every particular time interval and test it just now Rescheduled time unit.