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

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)
library(ggplot2)
library(shiny)
library(DT)
library(shinyjs)
library(shinycssloaders)
library(googleAuthR)
......@@ -121,8 +122,10 @@ server = shinyServer(
# shinyjs::disable("plot")
shinyjs::disable("forecastTable")
shinyjs::disable("downloadData")
shinyjs::disable("reset")
shinyjs::disable("smalltable")
shinyjs::hideElement("forecastTable")
shinyjs::hideElement("reset")
shinyjs::hideElement("downloadData")
shinyjs::hideElement("smalltable")
......@@ -187,6 +190,9 @@ server = shinyServer(
selected = "Adjusted MAPE")
})
output$resetButton <- renderUI({
actionButton("reset", "Reset Model Selection")
})
output$dataOptions <- renderUI({
file <- datasetSelect()
......@@ -437,7 +443,9 @@ server = shinyServer(
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))
......@@ -459,6 +467,8 @@ server = shinyServer(
if(input$var!="All")
{
getV <- deselection()
modname <- dataSelect()
timeval <- getTimeVal()
......@@ -597,6 +607,42 @@ server = shinyServer(
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(
filename = function(){
......@@ -791,7 +837,11 @@ ui = #ui.R
# label = "Choose accuracy error metric",
# choices = list("Standard MAPE","Adjusted MAPE","Weighted MAPE"),
# selected = "Adjusted MAPE"),
uiOutput("modelSelect"),
uiOutput("resetButton"),
width=3
),
......@@ -812,9 +862,9 @@ ui = #ui.R
br(),
fluidRow(
#box(width=12, title="Check",
splitLayout(cellWidths = c("75%","25%"),
splitLayout(cellWidths = c("85%","15%","15%"),
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