From d8381cdeaeb3297e6003cd59b29966bac2e6af67 Mon Sep 17 00:00:00 2001 From: Marco Zanotti Date: Tue, 9 Jan 2024 18:12:40 +0100 Subject: [PATCH] update --- dashboard/R/generate_forecast.R | 12 +- dashboard/R/get_data.R | 70 -------- dashboard/R/hp_testing.R | 84 ++++++++++ dashboard/R/transform_data.R | 97 +++++++++++ dashboard/R/utils.R | 3 +- dashboard/css/styles-default.css | 5 + dashboard/tsf_dashboard.Rmd | 268 +++++++++++++++++-------------- dashboard/ui.Rmd | 2 +- 8 files changed, 348 insertions(+), 193 deletions(-) create mode 100644 dashboard/R/hp_testing.R create mode 100644 dashboard/R/transform_data.R diff --git a/dashboard/R/generate_forecast.R b/dashboard/R/generate_forecast.R index d05c514..b72c229 100644 --- a/dashboard/R/generate_forecast.R +++ b/dashboard/R/generate_forecast.R @@ -1,5 +1,9 @@ # function to forecast using time series methods -generate_ts_forecast <- function(data, method, params, n_future, seed = 1992) { +generate_ts_forecast <- function( + data, method, params, + n_future, n_assess, assess_type, + seed = 1992 +) { future_tbl <- data |> future_frame(.date_var = date, .length_out = n_future) @@ -60,7 +64,11 @@ generate_ts_forecast <- function(data, method, params, n_future, seed = 1992) { } # function to forecast using machine learning methods -generate_ml_forecast <- function(data, method, params, n_future, seed = 1992) { +generate_ml_forecast <- function( + data, method, params, + n_future, n_assess, assess_type, + seed = 1992 +) { # time_scale <- data |> # tk_index() |> diff --git a/dashboard/R/get_data.R b/dashboard/R/get_data.R index 2c12b99..64dff01 100644 --- a/dashboard/R/get_data.R +++ b/dashboard/R/get_data.R @@ -50,73 +50,3 @@ get_data <- function(dataset_name) { # Monthly return(data) } - -# function to impute missing values -impute_data <- function(data, params, freq) { - - if (params$impute == FALSE) { - return(data) - } else { - n2f <- trunc(nrow(data) / freq) - p <- ifelse(n2f < 1, 1, 2) - data_impute <- data |> mutate(value = ts_impute_vec(value, period = p, lambda = "auto")) - return(data_impute) - } - -} - -# function to transform data -transform_data <- function(data, params, freq) { - - trf_prm <- getOption("tsf.dashboard.transfs") - if (!all(trf_prm %in% names(params))) { - stop(paste("Unknown transformations!")) - } - - transf_params <- c( - params$log, params$boxcox, params$norm, - params$stand, params$diff, params$sdiff - ) |> as.logical() - - if (!all(transf_params) == FALSE) { - return(data) - } else { - - data_transf <- data - - if (params$log) { # Log - data_transf <- data_transf |> mutate(value = log1p(value)) - } - if (params$boxcox) { # Box-Cox - data_transf <- data_transf |> mutate(value = box_cox_vec(value + 1, lambda = "auto")) - } - if (params$norm) { # Normalization - data_transf <- data_transf |> mutate(value = normalize_vec(value)) - } - if (params$stand) { # Standardization - data_transf <- data_transf |> mutate(value = standardize_vec(value)) - } - if (params$diff) { # Differencing - data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1)) |> drop_na() - } - if (params$sdiff) { # Seasonal differencing - data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1, lag = freq)) |> drop_na() - } - - return(data_transf) - } - -} - -# function to clean data from anomalies -clean_data <- function(data, params) { - - if (params$clean == FALSE) { - return(data) - } else { - data_clean <- data |> mutate(value = ts_clean_vec(value)) - return(data_clean) - } - -} - diff --git a/dashboard/R/hp_testing.R b/dashboard/R/hp_testing.R new file mode 100644 index 0000000..c9ca6bb --- /dev/null +++ b/dashboard/R/hp_testing.R @@ -0,0 +1,84 @@ +# function to extract significance stars +extract_significance <- function(p_value) { + + res <- dplyr::case_when( + p_value < 0.001 ~ "***", + p_value >= 0.001 & p_value < 0.01 ~ "**", + p_value >= 0.01 & p_value < 0.05 ~ "*", + p_value >= 0.05 & p_value < 0.1 ~ ".", + TRUE ~ "" + ) + return(res) + +} + +# function to perform hypothesis testing +compute_hptests <- function(data, digits = 4) { + + # urca::ur.kpss() type = c("mu", "tau"), use.lag = NULL + # urca::ur.pp() type = c("Z-alpha", "Z-tau"), model = c("constant", "trend"), use.lag = NULL + # urca::ur.df() type = c("none", "drift", "trend"), lags = 1 + + x <- data$value + k <- trunc((length(x) - 1) ^ (1 / 3)) + + res <- tibble::tibble( + "Type" = c(rep("normality", 2), rep("autocorrelation", 2), rep("stationarity", 3)), + "Test" = c( + "Jarque-Bera", "Shapiro-Wilk", + "Box-Pierce", "Ljung-Box", + "Augmented Dickey-Fuller", "Phillips-Perron", "KPSS" + ), + "H0" = c( + "Normality", "Normality", + "No autocorrelation", "No autocorrelation", + "No stationarity", "No stationarity", "Stationarity" + ), + "Statistic" = rep(0, 7), + "P_value" = rep(0, 7), + "Signif" = rep("", 7) + ) + + # normality tests + tmp <- tseries::jarque.bera.test(x) + res[1, 4] <- unname(tmp$statistic) + res[1, 5] <- tmp$p.value + tmp <- stats::shapiro.test(x) + res[2, 4] <- unname(tmp$statistic) + res[2, 5] <- tmp$p.value + + # autocorrelation tests + tmp <- stats::Box.test(x, type = "Box-Pierce", lag = k) + res[3, 4] <- unname(tmp$statistic) + res[3, 5] <- tmp$p.value + tmp <- stats::Box.test(x, type = "Ljung-Box", lag = k) + res[4, 4] <- unname(tmp$statistic) + res[4, 5] <- tmp$p.value + + # stationarity + tmp <- suppressWarnings(tseries::adf.test(x, k = k)) + res[5, 4] <- unname(tmp$statistic) + res[5, 5] <- tmp$p.value + tmp <- suppressWarnings(tseries::pp.test(x)) + res[6, 4] <- unname(tmp$statistic) + res[6, 5] <- tmp$p.value + tmp <- suppressWarnings(tseries::kpss.test(x)) + res[7, 4] <- unname(tmp$statistic) + res[7, 5] <- tmp$p.value + + res <- res |> + dplyr::mutate(Signif = extract_significance(P_value)) |> + dplyr::mutate( + Statistic = round(Statistic, digits), + P_value = round(P_value, digits) + ) |> + # dplyr::mutate( + # result = paste0( + # round(statistic, digits), " ", signif, " \n", "(", round(p_value, digits), ")" + # ) + # ) |> + dplyr::select(-Type) + + return(res) + +} diff --git a/dashboard/R/transform_data.R b/dashboard/R/transform_data.R new file mode 100644 index 0000000..b6f851e --- /dev/null +++ b/dashboard/R/transform_data.R @@ -0,0 +1,97 @@ +# function to impute missing values +impute_data <- function(data, params, freq) { + + if (params$impute == FALSE) { + return(data) + } else { + n2f <- trunc(nrow(data) / freq) + p <- ifelse(n2f < 1, 1, 2) + data_impute <- data |> mutate(value = ts_impute_vec(value, period = p, lambda = "auto")) + return(data_impute) + } + +} + +# function to transform data +transform_data <- function(data, section, params, freq) { + + if (section == "viz_transf") { + + trf_prm <- getOption("tsf.dashboard.transfs") + if (!all(trf_prm %in% names(params))) { + stop(paste("Unknown transformations!")) + } + transf_params <- c( + params$log, params$boxcox, params$norm, + params$stand, params$diff, params$sdiff + ) |> as.logical() + + if (all(!transf_params)) { + return(data) + } else { + data_transf <- data + if (params$log) { # Log + data_transf <- data_transf |> mutate(value = log1p(value)) + } + if (params$boxcox) { # Box-Cox + data_transf <- data_transf |> mutate(value = box_cox_vec(value + 1, lambda = "auto")) + } + if (params$norm) { # Normalization + data_transf <- data_transf |> mutate(value = normalize_vec(value)) + } + if (params$stand) { # Standardization + data_transf <- data_transf |> mutate(value = standardize_vec(value)) + } + if (params$diff) { # Differencing + data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1)) |> drop_na() + } + if (params$sdiff) { # Seasonal differencing + data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1, lag = freq)) |> drop_na() + } + return(data_transf) + } + + } else if (section == "test_hp") { + + trf_prm <- getOption("tsf.dashboard.test_transfs") + if (!all(trf_prm %in% names(params))) { + stop(paste("Unknown transformations!")) + } + transf_params <- c( + params$test_log, params$test_diff, params$test_sdiff + ) |> as.logical() + + if (all(!transf_params)) { + return(data) + } else { + data_transf <- data + if (params$test_log) { # Log + data_transf <- data_transf |> mutate(value = log1p(value)) + } + if (params$test_diff) { # Differencing + data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1)) |> drop_na() + } + if (params$test_sdiff) { # Seasonal differencing + data_transf <- data_transf |> mutate(value = diff_vec(value, difference = 1, lag = freq)) |> drop_na() + } + return(data_transf) + } + + } else { + stop(paste("Unknown section", section)) + } + +} + +# function to clean data from anomalies +clean_data <- function(data, params) { + + if (params$clean == FALSE) { + return(data) + } else { + data_clean <- data |> mutate(value = ts_clean_vec(value)) + return(data_clean) + } + +} + diff --git a/dashboard/R/utils.R b/dashboard/R/utils.R index 4b20211..922ac90 100644 --- a/dashboard/R/utils.R +++ b/dashboard/R/utils.R @@ -118,7 +118,8 @@ set_options <- function() { "Linear Regression" = "none", "Elastic Net" = c("penalty", "mixture") ), - tsf.dashboard.transfs = c("log", "boxcox", "norm", "stand", "diff", "sdiff") + tsf.dashboard.transfs = c("log", "boxcox", "norm", "stand", "diff", "sdiff"), + tsf.dashboard.test_transfs = c("test_log", "test_diff", "test_sdiff") ) toset <- !(names(op.tsf.dashboard) %in% names(op)) if (any(toset)) options(op.tsf.dashboard[toset]) diff --git a/dashboard/css/styles-default.css b/dashboard/css/styles-default.css index ea56801..4433093 100644 --- a/dashboard/css/styles-default.css +++ b/dashboard/css/styles-default.css @@ -1,3 +1,7 @@ +* { + box-sizing: border-box; +} + /* AUTH PANEL */ .panel-auth { position: fixed; @@ -51,6 +55,7 @@ body { } .sidebar { width: 250px !important; + /*margin-right: 30px !important;*/ } } diff --git a/dashboard/tsf_dashboard.Rmd b/dashboard/tsf_dashboard.Rmd index 5016f1a..bfac6a1 100644 --- a/dashboard/tsf_dashboard.Rmd +++ b/dashboard/tsf_dashboard.Rmd @@ -19,8 +19,9 @@ runtime: shiny - + + @@ -30,6 +31,8 @@ runtime: shiny ```{r setup, include=FALSE, message=FALSE} source("R/utils.R") source("R/get_data.R") +source("R/transform_data.R") +source("R/hp_testing.R") source("R/generate_forecast.R") source("R/packages.R") @@ -84,7 +87,7 @@ br() prettyRadioButtons(inputId = "table_type", label = NULL, choices = c("preview", "str", "summary")) # input <- list( -# dataset = datasets[2] +# dataset = datasets[1] # ) ``` @@ -202,7 +205,7 @@ observeEvent( hr() h3("Missing Imputation") -switchInput(inputId = "impute", value = FALSE, width = "500%", size = "small") +switchInput(inputId = "impute", value = FALSE, size = "mini") hr() h3("Transform") @@ -250,7 +253,7 @@ observeEvent( data_transformed <- reactive({ data_selected() |> impute_data(params = input, freq = ts_freq()) |> - transform_data(params = input, freq = ts_freq()) |> + transform_data(section = "viz_transf", params = input, freq = ts_freq()) |> filter(between(date, input$date_range[1], input$date_range[2])) }) ``` @@ -334,7 +337,7 @@ sliderInput(inputId = "max_anomalies", label = h4("Max Anomalies (%)"), min = 0. hr() h3("Anomaly Cleaning") -switchInput(inputId = "clean", value = FALSE, size = "small", width = "500px") +switchInput(inputId = "clean", value = FALSE, size = "mini") br() @@ -393,168 +396,190 @@ plotlyOutput(outputId = "clean_plot") -Time Series Algorithms {data-navmenu="Forecast" data-orientation=rows} +Hypothesis Testing {data-navmenu="Analyze" data-orientation=rows} =========================================================================== Input {.sidebar} --------------------------------------------------------------------------- ```{r} -sliderInput( - inputId = "n_future", label = h3("Forecast Horizon"), - value = 12, min = 1, max = 60, step = 1 -) +h3("Normality Tests") +h5("Shapiro-Wilk and Jarque-Bera") +br() -selectInput( - inputId = "ts_method", label = h3("Forecast Algorithm"), - choices = ts_methods, selected = ts_methods[1] -) +hr() +h3("Autocorrelation Tests") +h5("Ljung-Box and Box-Pierce") +br() -actionButton(inputId = "apply_ts_forecast", label = "Forecast!", icon = icon("play")) -actionButton(inputId = "ts_reset", label = "Reset", icon = icon("sync")) -observeEvent( - eventExpr = input$ts_reset, - handlerExpr = { - updateNumericInput(session = session, inputId = "n_future", value = 12) - updateSelectInput(session = session, inputId = "ts_method", selected = ts_methods[1]) - shinyjs::delay(ms = 300, expr = {shinyjs::click(id = "apply_ts_forecast")}) - } -) +hr() +h3("Stationarity Tests") +h5("ADF, PP and KPSS") -br() # break rule -br() # break rule +br() +br() +br() +materialSwitch(inputId = "test_log", label = "Test on log?", value = FALSE, status = "primary") +materialSwitch(inputId = "test_diff", label = "Test on diff?", value = FALSE, status = "primary") +materialSwitch(inputId = "test_sdiff", label = "Test on seasonal diff?", value = FALSE, status = "primary") +``` -# Rolling Average -conditionalPanel( - condition = "input.ts_method == 'Rolling Average'", - h5("Algorithm hyperparameters: "), - numericInput(inputId = "window_size", label = "Window Size", value = 12, min = 1) -) +```{r} +data_test <- reactive({ + data_selected() |> + transform_data(section = "test_hp", params = input, freq = ts_freq()) +}) -# ETS -conditionalPanel( - condition = "input.ts_method == 'ETS'", - h5("Algorithm hyperparameters: "), - selectInput(inputId = "error", label = "Error", choices = c("auto", "additive", "multiplicative"), selected = "auto"), - selectInput(inputId = "trend", label = "Trend", choices = c("auto", "additive", "multiplicative", "none"), selected = "auto"), - selectInput(inputId = "season", label = "Seasonality", choices = c("auto", "additive", "multiplicative", "none"), selected = "auto"), - selectInput(inputId = "damping", label = "Damped Trend", choices = c("auto", "damped", "none"), selected = "auto"), - numericInput(inputId = "smooth_level", label = "Alpha", value = 0.1, min = 0, max = 1), - numericInput(inputId = "smooth_trend", label = "Beta", value = 0.1, min = 0, max = 1), - numericInput(inputId = "smooth_season", label = "Gamma", value = 0.1, min = 0, max = 1) -) +test_results <- reactive({ + data_test() |> compute_hptests() +}) +``` -# ARIMA -conditionalPanel( - condition = "input.ts_method == 'ARIMA'", - h5("Algorithm hyperparameters: "), - sliderInput(inputId = "non_seasonal_ar", label = "p", value = 1, min = 0, max = 5, step = 1), - sliderInput(inputId = "non_seasonal_differences", label = "d", value = 1, min = 0, max = 2, step = 1), - sliderInput(inputId = "non_seasonal_ma", label = "q", value = 1, min = 0, max = 5, step = 1), - sliderInput(inputId = "seasonal_ar", label = "P", value = 0, min = 0, max = 5, step = 1), - sliderInput(inputId = "seasonal_differences", label = "D", value = 0, min = 0, max = 2, step = 1), - sliderInput(inputId = "seasonal_ma", label = "Q", value = 0, min = 0, max = 5, step = 1) -) -# input <- list( -# id = unique(data$id)[3], -# n_future = 12, -# method = "ETS", -# error = "auto", -# trend = "auto", -# season = "auto", -# damping = "auto", -# smooth_level = 0.1, -# smooth_trend = 0.1, -# smooth_season = 0.1 -# ) -``` +Row 1 {data-height=500} +--------------------------------------------------------------------------- + +### ```{r} -ts_forecast_results <- eventReactive( - eventExpr = input$apply_ts_forecast, - valueExpr = { - # ts_forecast_results <- - data_cleaned() |> - generate_forecast( - method = input$ts_method, params = input, - n_future = input$n_future, seed = 1992 +output$test_table <- renderDT({ + test_results() |> + datatable( + options = list( + ordering = FALSE, + pageLength = 20, + lengthChange = FALSE, + searching = FALSE, + info = FALSE, + paging = FALSE ) - } -) + ) +}) +DTOutput(outputId = "test_table") ``` -Row 1 {data-height=700} +Row 1 {data-height=500} --------------------------------------------------------------------------- -### Forecasting Plot {.no-padding} +### {.no-padding} ```{r} -output$plot_ts_forecast <- renderPlotly({ - ts_forecast_results()$forecast |> - plot_modeltime_forecast(.legend_show = FALSE, .title = FALSE) +output$test_ts_plot <- renderPlotly({ + data_test() |> + timetk::plot_time_series( + .date_var = date, .value = value, + .smooth = FALSE, .interactive = TRUE, .title = NULL + ) }) -plotlyOutput(outputId = "plot_ts_forecast") +plotlyOutput(outputId = "test_ts_plot") ``` - -Row 2 {data-height=300} ---------------------------------------------------------------------------- - -### Model Summary {.no-padding} +### {.no-padding} ```{r} -output$summary_ts_model <- renderPrint({ - ts_forecast_results()$model +output$test_autocorr_plot <- renderPlotly({ + data_test() |> + timetk::plot_acf_diagnostics( + .date_var = date, .value = value, + .lags = ifelse(ts_freq() < 60, ts_freq() * 3, 150), + .interactive = TRUE, .title = NULL, .y_lab = NULL + ) }) -verbatimTextOutput(outputId = "summary_ts_model") +plotlyOutput(outputId = "test_autocorr_plot") ``` -Machine Learning Algorithms {data-navmenu="Forecast" data-orientation=rows} +Test & Evaluate {data-navmenu="Forecast" data-orientation=rows} =========================================================================== Input {.sidebar} --------------------------------------------------------------------------- ```{r} -sliderInput( - inputId = "n_future", label = h3("Forecast Horizon"), - value = 12, min = 1, max = 60, step = 1 +br() +dropdownButton( + numericInput( + inputId = "n_future", label = "Forecast Horizon", + value = 12, min = 1, max = Inf, step = 1, width = "100%" + ), + numericInput( + inputId = "n_assess", label = "Assessment Period", + value = 24, min = 1, max = Inf, step = 1, width = "100%" + ), + prettyRadioButtons( + inputId = "assess_type", label = "Assessment Type", + choices = c("Expanding", "Rolling"), selected = "Rolling", + inline = TRUE + ), + icon = icon("gear"), width = "200px", size = "sm", circle = TRUE, + tooltip = tooltipOptions(title = "Click to see inputs!") ) selectInput( - inputId = "ml_method", label = h3("Forecast Method"), - choices = ml_methods, selected = ml_methods[1] + inputId = "method", label = h3("Forecast Algorithm"), + choices = methods, selected = methods[1] ) -actionButton(inputId = "apply_ml_forecast", label = "Forecast!", icon = icon("play")) -actionButton(inputId = "ml_reset", label = "Reset", icon = icon("sync")) +actionButton(inputId = "apply_forecast", label = "Forecast!", icon = icon("play")) +actionButton(inputId = "ts_reset", label = "Reset", icon = icon("sync")) observeEvent( - eventExpr = input$ml_reset, + eventExpr = input$ts_reset, handlerExpr = { updateNumericInput(session = session, inputId = "n_future", value = 12) - updateSelectInput(session = session, inputId = "ml_method", selected = ml_methods[1]) - shinyjs::delay(ms = 300, expr = {shinyjs::click(id = "apply_ml_forecast")}) + 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]) + shinyjs::delay(ms = 300, expr = {shinyjs::click(id = "apply_forecast")}) } ) br() # break rule br() # break rule +# Rolling Average +conditionalPanel( + condition = "input.method == 'Rolling Average'", + h5("Algorithm hyperparameters: "), + numericInput(inputId = "window_size", label = "Window Size", value = 12, min = 1) +) + +# ETS +conditionalPanel( + condition = "input.method == 'ETS'", + h5("Algorithm hyperparameters: "), + selectInput(inputId = "error", label = "Error", choices = c("auto", "additive", "multiplicative"), selected = "auto"), + selectInput(inputId = "trend", label = "Trend", choices = c("auto", "additive", "multiplicative", "none"), selected = "auto"), + selectInput(inputId = "season", label = "Seasonality", choices = c("auto", "additive", "multiplicative", "none"), selected = "auto"), + selectInput(inputId = "damping", label = "Damped Trend", choices = c("auto", "damped", "none"), selected = "auto"), + numericInput(inputId = "smooth_level", label = "Alpha", value = 0.1, min = 0, max = 1), + numericInput(inputId = "smooth_trend", label = "Beta", value = 0.1, min = 0, max = 1), + numericInput(inputId = "smooth_season", label = "Gamma", value = 0.1, min = 0, max = 1) +) + +# ARIMA +conditionalPanel( + condition = "input.method == 'ARIMA'", + h5("Algorithm hyperparameters: "), + sliderInput(inputId = "non_seasonal_ar", label = "p", value = 1, min = 0, max = 5, step = 1), + sliderInput(inputId = "non_seasonal_differences", label = "d", value = 1, min = 0, max = 2, step = 1), + sliderInput(inputId = "non_seasonal_ma", label = "q", value = 1, min = 0, max = 5, step = 1), + sliderInput(inputId = "seasonal_ar", label = "P", value = 0, min = 0, max = 5, step = 1), + sliderInput(inputId = "seasonal_differences", label = "D", value = 0, min = 0, max = 2, step = 1), + sliderInput(inputId = "seasonal_ma", label = "Q", value = 0, min = 0, max = 5, step = 1) +) + # Linear Regression conditionalPanel( - condition = "input.ml_method == 'Linear Regression'", + condition = "input.method == 'Linear Regression'", h5("Algorithm hyperparameters: "), h6("No hyperparameters for this algorithm!") - # input$none <- "none" ) # Elastic Net conditionalPanel( - condition = "input.ml_method == 'Elastic Net'", + condition = "input.method == 'Elastic Net'", h5("Algorithm hyperparameters: "), numericInput(inputId = "penalty", label = "Penalty", value = 1, min = 0, max = 100), numericInput(inputId = "mixture", label = "Mixture", value = 0.5, min = 0, max = 1) @@ -563,20 +588,25 @@ conditionalPanel( # input <- list( # id = unique(data$id)[3], # n_future = 12, -# method = "Elastic Net", -# penalty = 0.1, -# mixture = 0.1 +# method = "ETS", +# error = "auto", +# trend = "auto", +# season = "auto", +# damping = "auto", +# smooth_level = 0.1, +# smooth_trend = 0.1, +# smooth_season = 0.1 # ) ``` ```{r} -ml_forecast_results <- eventReactive( - eventExpr = input$apply_ml_forecast, +forecast_results <- eventReactive( + eventExpr = input$apply_forecast, valueExpr = { - # ml_forecast_results <- + # ts_forecast_results <- data_cleaned() |> generate_forecast( - method = input$ml_method, params = input, + method = input$method, params = input, n_future = input$n_future, seed = 1992 ) } @@ -590,11 +620,11 @@ Row 1 {data-height=700} ### Forecasting Plot {.no-padding} ```{r} -output$plot_ml_forecast <- renderPlotly({ - ml_forecast_results()$forecast |> +output$plot_forecast <- renderPlotly({ + forecast_results()$forecast |> plot_modeltime_forecast(.legend_show = FALSE, .title = FALSE) }) -plotlyOutput(outputId = "plot_ml_forecast") +plotlyOutput(outputId = "plot_forecast") ``` @@ -604,8 +634,8 @@ Row 2 {data-height=300} ### Model Summary {.no-padding} ```{r} -output$summary_ml_model <- renderPrint({ - ml_forecast_results()$model +output$summary_model <- renderPrint({ + forecast_results()$model }) -verbatimTextOutput(outputId = "summary_ml_model") +verbatimTextOutput(outputId = "summary_model") ``` diff --git a/dashboard/ui.Rmd b/dashboard/ui.Rmd index 5a1c83c..9a2e081 100644 --- a/dashboard/ui.Rmd +++ b/dashboard/ui.Rmd @@ -4,7 +4,7 @@ output: flexdashboard::flex_dashboard: orientation: rows vertical_layout: fill - css: css/styles-default2.css + css: css/styles-default.css # logo: img/logo.png social: ["menu"] source_code: https://github.com/marcozanotti/tsforecasting-course