inst/doc/tourism-comp.R

In Tcomp: Data from the 2010 Tourism Forecasting Competition

## ---- echo = FALSE, results = 'hide', message = FALSE--------------------
library(Tcomp)
library(knitr)
opts_chunk$set(comment=NA, fig.width=7, fig.height=4)
options(verbose = FALSE, xtable.type = "html")

## ------------------------------------------------------------------------
length(tourism)
class(tourism)

## ------------------------------------------------------------------------
tourism$Y5

## ------------------------------------------------------------------------
str(tourism$Y5)

## ------------------------------------------------------------------------
par(bty = "l")
plot(tourism$M11); grid()


## ----results = 'asis'----------------------------------------------------
library(dplyr, warn.conflicts = FALSE)
library(xtable)
lengthsm <- sapply(subset(tourism, "monthly"), function(s){length(s$x) + length(s$xx)})
lengthsq <- sapply(subset(tourism, "quarterly"), function(s){length(s$x) + length(s$xx)})
lengthsy <- sapply(subset(tourism, "yearly"), function(s){length(s$x) + length(s$xx)})

tmp <- data.frame(series_length = c(lengthsm, lengthsq, lengthsy),
                          series_type = c(rep("Monthly", length(lengthsm)),
                                          rep("Quarterly", length(lengthsq)),
                                          rep("Yearly", length(lengthsy))
                          )) %>%
  group_by(series_type) %>%
  summarise(
    TotalNumber = length(series_length),
    MeanLength = round(mean(series_length), 1),
    MedianLength = median(series_length),
    MinLength = min(series_length),
    MaxLength = max(series_length)
  ) %>%
  select(-series_type) %>%
  t() %>%
  as.matrix()
colnames(tmp) <- c("Monthly", "Quarterly", "Yearly")
xtable(tmp, digits = 1)

## ---- \\-----------------------------------------------------------------
forecast_comp(tourism[[300]], tests = list(6, 12, 24))

## ---- fig.height = 8-----------------------------------------------------
forecast_comp(tourism[[1000]], tests = list(1,2,3,4), plot = TRUE)

## ----eval = FALSE--------------------------------------------------------
#  library(Tcomp)
#  library(dplyr)
#  library(tidyr)
#  library(parallel)
#  
#  # this function runs the four standard models in forecast_comp
#  # on a large chunk of the competition series from either Mcomp or Tcomp.
#  # The aim is to help comparisons with Athanasopoulos et al.
#  #
#  # The use of makePSOCKcluster and parLapply speeds up the analysis nearly four fold on my laptop
#  # eg running the test on all the yearly tourism series takes 12 seconds rather than 44 seconds.
#  
#  #' @param dataobj a list of class Mcomp such as M3 or tourism
#  #' @param cond1 a condition for subsetting dataobj eg "yearly"
#  #' @param tests a list of different horizons at which to return the MASE for four different models
#  #'
#  #' @return a data.frame with \code{length(tests) + 2} columns and 8 rows
#  accuracy_measures <- function(dataobj, cond1, tests){
#    cores <- detectCores()
#  
#    cluster <- makePSOCKcluster(max(1, cores - 1))
#  
#    clusterEvalQ(cluster, {
#      library(Tcomp)
#      library(forecast)
#    })
#  
#    results <- parLapply(cluster,
#                         subset(dataobj, cond1),
#                         forecast_comp,
#                         tests = tests)
#  
#    results_mat <- do.call(rbind, results)
#    nr <- nrow(results_mat)
#  
#    tmp <- as.data.frame(results_mat) %>%
#      mutate(measure = rep(rep(c("MAPE", "MASE"), times = c(4, 4)), times = nr / 8)) %>%
#      mutate(method = rownames(results_mat)) %>%
#      gather(horizon, mase, -method, -measure) %>%
#      group_by(method, measure, horizon) %>%
#      summarise(result = round(mean(mase), 2)) %>%
#      ungroup() %>%
#      mutate(horizon = factor(horizon, levels = colnames(results[[1]]))) %>%
#      spread(horizon, result) %>%
#      arrange(measure) %>%
#      as.data.frame()
#  
#    stopCluster(cluster)
#  
#    return(tmp)
#  }
#  
#  accuracy_measures(tourism, "monthly", list(1, 2, 3, 6, 12, 18, 24, 1:3, 1:12, 1:24))
#  accuracy_measures(tourism, "quarterly", list(1, 2, 3, 4, 6, 8, 1:4, 1:8))
#  accuracy_measures(tourism, "yearly", list(1, 2, 3, 4, 1:2, 1:4))
#  
#  

## ----results = 'asis'----------------------------------------------------
xtable(Tcomp_reproduction$monthly)
xtable(Tcomp_reproduction$quarterly)
xtable(Tcomp_reproduction$yearly)