diff --git a/dashboard/R/generate_forecast.R b/dashboard/R/generate_forecast.R index b72c229..fe93baf 100644 --- a/dashboard/R/generate_forecast.R +++ b/dashboard/R/generate_forecast.R @@ -5,11 +5,12 @@ generate_ts_forecast <- function( seed = 1992 ) { + set.seed(seed) + + future_tbl <- data |> future_frame(.date_var = date, .length_out = n_future) - set.seed(seed) - if (method == "Rolling Average") { check_parameters(method, params) @@ -127,14 +128,18 @@ generate_ml_forecast <- function( } # function to generate the forecasts -generate_forecast <- function(data, method, params, n_future, seed = 1992) { +generate_forecast <- function( + data, method, params, + n_future, n_assess, assess_type, + seed = 1992 +) { method_type <- parse_method(method) if (method_type == "ts") { - res <- generate_ts_forecast(data, method, params, n_future, seed) + res <- generate_ts_forecast(data, method, params, n_future, n_assess, assess_type, seed) } else if (method_type == "ml") { - res <- generate_ml_forecast(data, method, params, n_future, seed) + res <- generate_ml_forecast(data, method, params, n_future, n_assess, assess_type, seed) } else { stop(paste("Unknown method", method)) } diff --git a/dashboard/tsf_dashboard.Rmd b/dashboard/tsf_dashboard.Rmd index bfac6a1..87dcd50 100644 --- a/dashboard/tsf_dashboard.Rmd +++ b/dashboard/tsf_dashboard.Rmd @@ -14,18 +14,19 @@ runtime: shiny + + + - - - + - + ```{r setup, include=FALSE, message=FALSE} @@ -41,10 +42,7 @@ datasets <- c( "Air Passengers", # "Electricity Demand", "Stock Price", "Tobacco Prod", "EU Population", "People Traffic", "custom" ) -ts_methods <- getOption("tsf.dashboard.methods")$ts -ml_methods <- getOption("tsf.dashboard.methods")$ml - -useShinyjs(rmd = TRUE) # use Shiny JavaScript to allow delay on buttons +methods <- getOption("tsf.dashboard.methods") |> unlist() |> unname() ``` ```{r auth} @@ -498,6 +496,7 @@ Input {.sidebar} --------------------------------------------------------------------------- ```{r} +useShinyjs(rmd = TRUE) # use Shiny JavaScript to allow delay on buttons br() dropdownButton( numericInput( @@ -523,14 +522,15 @@ selectInput( ) actionButton(inputId = "apply_forecast", label = "Forecast!", icon = icon("play")) -actionButton(inputId = "ts_reset", label = "Reset", icon = icon("sync")) +actionButton(inputId = "tsf_reset", label = "Reset", icon = icon("sync")) observeEvent( - eventExpr = input$ts_reset, + eventExpr = input$tsf_reset, handlerExpr = { updateNumericInput(session = session, inputId = "n_future", value = 12) updateNumericInput(session = session, inputId = "n_assess", value = 24) updatePrettyRadioButtons(session = session, inputId = "assess_type", selected = "Rolling") - updateSelectInput(session = session, inputId = "method", selected = ts_methods[1]) + updateSelectInput(session = session, inputId = "method", selected = methods[1]) + updateNumericInput(session = session, inputId = "window_size", value = 12) shinyjs::delay(ms = 300, expr = {shinyjs::click(id = "apply_forecast")}) } ) @@ -607,7 +607,8 @@ forecast_results <- eventReactive( data_cleaned() |> generate_forecast( method = input$method, params = input, - n_future = input$n_future, seed = 1992 + n_future = input$n_future, n_assess = input$n_assess, + assess_type = input$assess_type, seed = 1992 ) } )