Commit 6ba48587 authored by Aqeel Padaria's avatar Aqeel Padaria
Browse files

check for less than 4 forecasts forward, and add reset button to go back from...

check for less than 4 forecasts forward, and add reset button to go back from plot to main model table
parent 448a4987
...@@ -13,6 +13,7 @@ forecastUI <- function(directory = ".", run = TRUE) ...@@ -13,6 +13,7 @@ forecastUI <- function(directory = ".", run = TRUE)
library(ggplot2) library(ggplot2)
library(shiny) library(shiny)
library(DT) library(DT)
library(shinyjs)
library(shinycssloaders) library(shinycssloaders)
library(googleAuthR) library(googleAuthR)
...@@ -121,8 +122,10 @@ server = shinyServer( ...@@ -121,8 +122,10 @@ server = shinyServer(
# shinyjs::disable("plot") # shinyjs::disable("plot")
shinyjs::disable("forecastTable") shinyjs::disable("forecastTable")
shinyjs::disable("downloadData") shinyjs::disable("downloadData")
shinyjs::disable("reset")
shinyjs::disable("smalltable") shinyjs::disable("smalltable")
shinyjs::hideElement("forecastTable") shinyjs::hideElement("forecastTable")
shinyjs::hideElement("reset")
shinyjs::hideElement("downloadData") shinyjs::hideElement("downloadData")
shinyjs::hideElement("smalltable") shinyjs::hideElement("smalltable")
...@@ -187,6 +190,9 @@ server = shinyServer( ...@@ -187,6 +190,9 @@ server = shinyServer(
selected = "Adjusted MAPE") selected = "Adjusted MAPE")
}) })
output$resetButton <- renderUI({
actionButton("reset", "Reset Model Selection")
})
output$dataOptions <- renderUI({ output$dataOptions <- renderUI({
file <- datasetSelect() file <- datasetSelect()
...@@ -437,7 +443,9 @@ server = shinyServer( ...@@ -437,7 +443,9 @@ server = shinyServer(
newdates <- seq.Date(max(original$valdate+timeband), by = timeval, length.out = 4) newdates <- seq.Date(max(original$valdate+timeband), by = timeval, length.out = 4)
newvals <- data.frame("95% Above" = hi95[1:4], "80% Above" = hi80[1:4], "Point Forecast" = pointforecast[1:4], "80% Below" = lo80[1:4], "95% Below" = lo95[1:4], check.names = FALSE) forecastLength <- min(4, length(periods))
newvals <- data.frame("95% Above" = hi95[1:forecastLength], "80% Above" = hi80[1:forecastLength], "Point Forecast" = pointforecast[1:forecastLength], "80% Below" = lo80[1:forecastLength], "95% Below" = lo95[1:forecastLength], check.names = FALSE)
newvals <- data.frame(t(newvals)) newvals <- data.frame(t(newvals))
...@@ -459,6 +467,8 @@ server = shinyServer( ...@@ -459,6 +467,8 @@ server = shinyServer(
if(input$var!="All") if(input$var!="All")
{ {
getV <- deselection()
modname <- dataSelect() modname <- dataSelect()
timeval <- getTimeVal() timeval <- getTimeVal()
...@@ -597,6 +607,42 @@ server = shinyServer( ...@@ -597,6 +607,42 @@ server = shinyServer(
NULL NULL
}) })
deselection <- eventReactive(input$reset,
{
datasetName <- datasetSelect()
modname <- dataSelect()
timeval <- getTimeVal()
Models <- read.xlsx(datasetName, sheet = paste("m", modname, sep = "_"), colNames = TRUE)
Models <- Models[Models$Value==input$metric & Models$TestingSplit==input$testsplit,]
Models <- Models[Models$TestingAccuracy!=0,c("Model","TrainingAccuracy","TestingAccuracy")]
errval <- errorSelect()
Models$Error <- 0:2
params <- Models$Parameters[!(Models$Parameters %in% c("High 95", "Low 95", "High 80", "Low 80"))]
Models <- Models[Models$Error==errval,]
Models$Parameters <- params
Models$Error <- NULL
#main <- read.xlsx(datasetName, sheet = "main")
models <- unique(Models[,"Model"])
models <- models[complete.cases(models)]
models <- c("All",models)
updateSelectInput(session, "var", "Choose a model to display",
choices = models,
selected = "All")
})
output$downloadData <- downloadHandler( output$downloadData <- downloadHandler(
filename = function(){ filename = function(){
...@@ -791,7 +837,11 @@ ui = #ui.R ...@@ -791,7 +837,11 @@ ui = #ui.R
# label = "Choose accuracy error metric", # label = "Choose accuracy error metric",
# choices = list("Standard MAPE","Adjusted MAPE","Weighted MAPE"), # choices = list("Standard MAPE","Adjusted MAPE","Weighted MAPE"),
# selected = "Adjusted MAPE"), # selected = "Adjusted MAPE"),
uiOutput("modelSelect"), uiOutput("modelSelect"),
uiOutput("resetButton"),
width=3 width=3
), ),
...@@ -812,9 +862,9 @@ ui = #ui.R ...@@ -812,9 +862,9 @@ ui = #ui.R
br(), br(),
fluidRow( fluidRow(
#box(width=12, title="Check", #box(width=12, title="Check",
splitLayout(cellWidths = c("75%","25%"), splitLayout(cellWidths = c("85%","15%","15%"),
withSpinner(tableOutput("forecastTable")), withSpinner(tableOutput("forecastTable")),
withSpinner(downloadButton("downloadData", label = "Download Forecasts")) withSpinner(downloadButton("downloadData", label = "Download"))
) )
#) #)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment