0

I'm using shiny for the first time and I'm trying to make an App capable of receiving CSV files, fit some models and forecast data (3 months).

The app delivers a table with the accuracy measures of the fitted models but these numbers are very different from the accuracy of the same models when they are run in a normal R script.

I cannot think of any reason for these differences! I'm using the same data files, models and variables. The same training and testing data as well. The differences are much bigger in the fasster models!

Can anyone see the problem?

For example, if I run the model function with the following models (code bellow), the accuracy measures for 3 months forecast as follow:

R script results

> erros (forecast: 130.23 sec elapsed)
# A tibble: 5 x 9
  .model         .type    ME    RMSE   MAE   MPE   MAPE   MASE   ACF1
  <chr>          <chr>   <dbl>  <dbl>  <dbl> <dbl>  <dbl> <dbl>  <dbl>
1 ANNC_HOLIDAY   Test   10.2    19.8  14.4   6.41  10.2   NaN   0.131 
2 ARIMA          Test   6.18    19.0  14.2   2.95  10.2   NaN   0.0506
3 ETS_auto       Test   5.46    17.0  12.1   2.78  8.69   NaN   0.135 
4 fasst          Test  -0.0758  13.0  9.82  -1.06  7.45   NaN   0.0695
5 fasst_original Test   7.84    17.9  12.9   4.59  9.16   NaN   0.135

Shiny APP results

Accuracy Measures
.model                  .type     ME     RMSE    MAE     MPE     MAPE   MASE   ACF1
 ANNC_HOLIDAY            Test   15.06   29.44   24.77   9.92    18.96   NA    -0.01
  ARIMA                  Test   -1.55   17.85   14.28   -3.18   11.57   NA     0.31
  ETS_auto               Test   -2.34   19.99   15.37   -3.83   12.52   NA     0.11
  fast                   Test   -6.91   49.77   30.47   -8.24   25.00   NA    -0.18
  fasst_original         Test    0.12   90.58   62.47   -4.00   50.84   NA    -0.18

R script Code (fitting part) 

#code for the models (fitmodels: 12.24 sec elapsed)
fit_demand <- train %>%
      model(
     # Seasonal Naive Method (benchmark)
        Benchmark = SNAIVE(Demand, lag = "1 year"),
        Benchmark_week = SNAIVE(Demand, lag = "1 week"),
        ETS_auto = ETS(Demand),
     # ANNS
        ANNC_HOLIDAY = NNETAR(Demand ~ AR(period = "1 day, 1 week") + DaysAfterHoliday, scale_inputs = TRUE),
        ANNC_HOLIDAY_diff = NNETAR(Demand ~ AR(period = "1 day, 1 week") 
                                   + DaysAfterHoliday + Diference, scale_inputs = TRUE),
     #FASSTER
        fasst_original = fasster(Demand ~ WeekDay + fourier(7,3)),
        fasst = fasster(Demand ~ WeekDay + fourier(7,3) + Influenza + DaysAfterHoliday 
                        + Diference + poly(1))
    )

Shiny APP code (fitting + forecast + accuracy)

    # FORECAST ----------------------------------------------------------------
#data_final is the historical data and data_extra_final is the forecasting external data

      # fit models
  fit_demand = reactive({
    train = filter_index(data_final(),.~"2019-09-30")
    train %>% 
      model(
        ETS_auto = ETS(Demand),
        # #ARIMA
        ARIMA = ARIMA(Demand),
        # # ANNS
        ANNC_HOLIDAY = NNETAR(Demand ~ AR(period = "1 day, 1 week"), scale_inputs = TRUE),
        #FASSTER
        fasst_original = fasster(Demand ~ WeekDay + fourier(7,3)),
        fasst = fasster(Demand ~ WeekDay + fourier(7,3) + Influenza + DaysAfterHoliday 
                        + Diference + poly(1))
      )
  })

  # Generate forecasts
  demand_forecast = reactive({
    new_data = filter_index(data_extra_final(),.~"2019-10-01" )
    modelo = fit_demand()
    forecast(modelo, new_data)
  })

  #accuracy
  output$table_erro = renderTable ({
    if(is.null(demand_forecast())){return()}
    test = filter_index(data_final(),.~"2019-10-01" )
    forecasted = demand_forecast()
    as.data.frame(accuracy(forecasted,test))
  })

Data

    dataset = as.tsibble(data.frame(Date = c(2017-05-01, 2017-05-02, 2017-05-03, 2017-05-04, 2017-05-05, 2017-05-06, 2017-05-07, 2017-05-08, 2017-05-09, 2017-05-10, 2017-05-11, 2017-05-12, 2017-05-13, 2017-05-14, 2017-05-15, 2017-05-16, 2017-05-17, 2017-05-18, 2017-05-19, 2017-05-20, 2017-05-21, 2017-05-22, 2017-05-23, 2017-05-24, 2017-05-25, 2017-05-26, 2017-05-27, 2017-05-28, 2017-05-29, 2017-05-30, 2017-05-31),
Demand = c(122, 124, 113, 124, 126, 114, 100, 121, 118, 135, 120, 118, 106, 104, 130, 130, 103, 106, 141, 85, 119, 140, 123, 130, 105, 124, 115, 107, 159, 121, 87),
Weekday=c(1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3)), index = Date)

train = filter_index(data_final(),.~"2017-05-15")
test = filter_index(data_final(),"2017-05-16"~.)
Diana Serrano
  • 47
  • 7
  • Hello Diana, do you have some data to make this question reproducible? What libraries do you use? – Manu Mar 26 '20 at 20:51
  • @Manu The data is confidential hence I cannot share it! But the data structure is like this: `dados # A tsibble: 975 x 6 [1D] Date Demand WeekDay DaysAfterHoliday Influenza_tax Diference 2017-05-01 122 1 0 6.87 -13.5` I use `fpp3` and `fasster` for the R script. For shinny I use `fpp3, fasster, shiny and shinydashboard` – Diana Serrano Mar 27 '20 at 15:30
  • Hello @Diana Serrano, if you can write a sample dataset it could help us to help you, like: `dataset <- data.frame(Date = c(...), Demand = c(...), Weekday=c(...), ...)`it doesn't need to be the real data, just some dummy values to test our proposed solution. – Manu Mar 27 '20 at 23:09
  • @manu I added the dummy values to test in the original post! Is only a month of data (the original has 975 days). The data_extra is a similar data set but without the demand variable. thank you for your help – Diana Serrano Mar 30 '20 at 11:05

0 Answers0