Name of Quantlet: 'CRIXForecastApp'
Published in: 'Master Thesis'
Description: 'R-Shiny app which does a one day forecast of the CRIX (thecrix.de) using an LSTM Model'
Keywords: 'CRIX, Bitcoin, Ethereum, Forecast, LSTM'
Author: 'Gonzalo Garcia'
See also: 'listing related Quantlets or Github code'
Submitted: '16. Jun 2021'
Datafile: 'CRIXForecastApp.R'
Additional Info: 'CRIXForecastApp contains the app interface and server, it binds the other scripts together.
CRIXFAAnalysisFuns and CRIXFAModelFuns tie directly into it by defining the graphs the app uses and helping decongest the code of CRIXForecastApp.
CRIXLRETS, CRIXLRML and CRIXLRAnalysis are non-essential for the functioning of the App. They were used for analysis and model training. CRIXCompPlot
was used to get the plots of the CRIX components used on the thesis paper. CRIXdataloader is a function used to load data and it is used throughout.'
library("shiny")
library("shinyjs")
library("tidyverse")
library("dplyr")
library("xts")
library("dygraphs")
library("lubridate")
library("tibbletime")
library("forecast")
library("zoo")
library("timetk")
library("reshape2")
library("keras")
library("htmltools")
source("CRIXdataloader/CRIXdataloader.R")
source("r/analysis.R")
ETS <-
readRDS(file = "models/ets.rds")
coin <- get_crypto()
coin$date <- ymd(coin$date)
log_returns <- diff.xts(coin[, 2], lag = 1, log = T)
log_returns <- xts(log_returns, order.by = coin$date)
log_returns <- na.omit(log_returns)
ui <- fluidPage(
tags$head(tags$style(".rightAlign{float:right;}")), # Align right the plots from Analysis page
useShinyjs(),
theme = 'bootstrap.min.css',
# Navigation Bar
navbarPage(
"Seiðr",
# Forecast Tab
tabPanel(
"Forecast",
sidebarPanel(
textInput(
"coin",
"Entity:",
"CRIX"
),
numericInput("periods_to_forecast",
"Select Number of Days to Forecast:",
value = 1),
uiOutput('no_value'), # No error caused by empty periods_to_forecast
uiOutput('ptf_text'), # Prompt user to enter a value if periods_to_forecast is empty
selectInput(
"model",
"Select Model:",
c(
"LSTM" = 'lstm',
"Naive" = 'naive_lr',
"Mean" = "mean_lr",
"ETS" = "ets_lr"
)
),
uiOutput('lstm_loading_time_text'), # Note about LSTM loading times
# Show ETS parameters. Hidden if model != ETS
conditionalPanel(
condition = "input.model == 'ets_lr'",
textInput("spec_ets",
"Method",
value = ETS$method),
textInput("error",
"Error",
value = ETS$components[1]),
textInput("trend",
"Trend",
value = ETS$components[2]),
textInput("seasonality",
"Seasonality",
value = ETS$components[3]),
numericInput("alpha",
"Alpha",
signif(ETS[["par"]][["alpha"]], 3))
),
actionButton("update_plot", "Plot") # Button to update plot.
),
mainPanel(dygraphOutput("series")) # App Output
),
# Analysis Tab
tabPanel(
"Analysis",
sidebarPanel(
textInput(
"coin_analysis",
"Entity:",
"CRIX"
),
selectInput(
"analysis",
"Select Analysis:",
c(
"Autocorrelation" = "acf",
"Partial Autocorrelation" = "pacf",
"Monthly Decomposition" = "mdecomp"
)
),
actionButton("update_analysis", "Plot")
),
# Determines which analysis is shown based on user input.
mainPanel(
conditionalPanel(
condition = "input.analysis == 'mdecomp'",
dygraphOutput("seasonal",height='230px')
),
conditionalPanel(
condition = "input.analysis == 'mdecomp'",
dygraphOutput("trend",height='230px')
),
conditionalPanel(
condition = "input.analysis == 'mdecomp'",
dygraphOutput("remainder",height='230px')
),
conditionalPanel(
condition = "input.analysis == 'acf' | input.analysis == 'pacf'",
plotOutput("acfpacf")
)
)),
tabPanel("References"),
tabPanel("Terms of Use"),
tabPanel("Contact"),
tabPanel("About"),
# Dark background for the NavBar
inverse = TRUE
)
)
server <- function(input, output) {
# Backend of "Plot" button
observeEvent(input$update_plot, {
if (is.na(input$periods_to_forecast)) {
} else {
output$series <- renderDygraph({
interactive_graph(
periods_to_forecast = isolate(floor(input$periods_to_forecast)),
for_model = isolate(input$model)
)
})}
})
# Backend of "Prompt user to enter a value if periods_to_forecast is empty" text
output$ptf_text <-
renderUI({
if (is.na(input$periods_to_forecast)){
br()
} else if(input$model == 'lstm' & input$periods_to_forecast > 1){
return(p("Warning: The LSTM model was designed to forecast exactly one step into the future. The chosen forecasting horizon is greater than one.", style = "color:red"))
}
})
# Backend of LSTM loading times text
output$lstm_loading_time_text <-
renderUI({
if(input$model == 'lstm'){
return(p("Note: Loading the necessary libraries for prediction with the LSTM model might take a few seconds.", style = "color:gray"))
}
})
# Backend of empty periods_to_forecast
result<-reactive({
validate(
need(input$periods_to_forecast, "Please input a value.")
)
})
output$no_value <- renderPrint({
result()
})
# Disable coin Input
disable('coin')
disable('coin_analysis')
# Disable user Input on ETS parameters
disable('spec_ets')
disable('error')
disable('trend')
disable('seasonality')
disable('alpha')
# Analysis Backend
observeEvent(input$update_analysis, {
if (isolate(input$analysis) == "mdecomp") {
output$seasonal <- renderDygraph({
analysis(for_analysis = isolate(input$analysis), part="seasonal")
})
output$trend <- renderDygraph({
analysis(for_analysis = isolate(input$analysis), part="trend")
})
output$remainder <- renderDygraph({
analysis(for_analysis = isolate(input$analysis), part="remainder")
})
} else if (isolate(input$analysis) == "acf") {
output$acfpacf <- renderPlot({
analysis(for_analysis = isolate(input$analysis))
})
} else if (isolate(input$analysis) == "pacf") {
output$acfpacf <- renderPlot({
analysis(for_analysis = isolate(input$analysis))
})
}
})
}
shinyApp(ui = ui, server = server)
automatically created on 2021-06-18