R/calculateAvgRelMAEs.R

In svcuonghvktqs/FORA: A package for time sereis forecast accuracy evaluation

#' Average Relative Mean Absolute Error for the given data from dataset(AvgRelMAEs)
#'
#' This function calculates and returns list of two dataframes,
#' where the first data frame contains AvgRelMAEs for the given data, diferent horizons and methods,
#' the second one contains ranked dataframe of the methods according to AvgRelMAEs.
#' Also the function plots AvgRelMAEs for different hirizons and methods.
#'
#' @aliases calculateAvgRelMAEs
#' @param frame A data frame containing columns "seies_id", "actual", "forecast", "method", and "horizon".
#' @param frame2 A data frame containing observations of each time series (containing columns named "series_id" and "value").
#' @param sort logical. If TRUE the resulting list of AvgRelMAEs dataframe and ranked dataframe of AvgRelMAEs sorting by average value.
#' @return \code{calculateAvgRelMAEs} function calculates and returns list of two dataframes,
#' where the first data frame contains AvgRelMAEs for the given data, diferent horizons and methods,
#' the second one contains ranked dataframe of the methods according to AvgRelMAEs.
#' Also the function plots AvgRelMAEs for different horizons and methods.
#' @author Sai Van Cuong, Maixm Shcherbakov and Andrey Davydenko
#' @seealso \code{\link{calculateGMAPEs}}, \code{\link{calculateGMRAEs}},
#' \code{\link{calculateMAD_MEAN_ratio}}, \code{\link{calculateMAEs}}, \code{\link{calculateMAPEs}},
#' \code{\link{calculateMASEs}}, \code{\link{calculateMdAPEs}}, \code{\link{calculateMPEs}},
#' \code{\link{calculateMSEs}}, \code{\link{calculatePB_MAEs}}, \code{\link{calculateRMSEs}},
#' \code{\link{calculateSMAPEs}}, \code{\link{calculateSMdAPEs}}.
#' @references Andrey Davydenko, Robert Fildes (2015) Volume title: \emph{Forecast Error Measures: Critical Review and Practical Recommendations}. \url{https://www.researchgate.net/publication/284947381_Forecast_Error_Measures_Critical_Review_and_Practical_Recommendations}.
#' @references Chao Chen, Jamie Twycross, Jonathan M. Garibaldi (2017) Volume title: \emph{A new accuracy measure based on bounded relative error for time series forecasting}. \url{http://journals.plos.org/plosone/article?id=10.1371/journal.pone.0174202}.
#' @references MV Shcherbakov, A Brebels, NL Shcherbakova (2013) Volume title: \emph{Information Technologies in Modern Industry, Education & Society}. \url{https://www.researchgate.net/publication/281718517_A_survey_of_forecast_error_measures}.
#' \url{http://eva.fcea.edu.uy/pluginfile.php/109034/mod_resource/content/0/2006_Hyndman_Predicc.pdf}.
#' @references MV Shcherbakov, A Brebels, NL Shcherbakova (2013) Volume title: \emph{Information Technologies in Modern Industry, Education & Society}. \url{https://www.researchgate.net/publication/281718517_A_survey_of_forecast_error_measures}.
#' @keywords dataframe
#' @examples
#' calculateAvgRelMAEs(frame = FORAYearForecast, frame2 = FORAYearSeries)
#' calculateAvgRelMAEs(frame = FORAYearForecast, frame2 = FORAYearSeries, sort = TRUE)
#'
#' @export
calculateAvgRelMAEs <- function(frame, frame2,  sort = FALSE){
  out <-matrix(NA, nrow = length(unique(frame$method)), ncol = length(unique(frame$horizon)))
  methodlist <- list()
  horizonlist <- list()
  AvgRelMAElist <- list()
  AvgRelMAE <- c()
  df3 = data.frame(out)
  colnames(df3) <- paste("horizon = ", 1:length(unique(frame$horizon)), sep ="")
  rownames(df3) <- unique(frame$method)
  ranks = data.frame(out)
  colnames(ranks) <- paste("horizon = ", 1:length(unique(frame$horizon)), sep ="")
  rownames(ranks) <- unique(frame$method)
  outlist <- list()
  df2 <- list()
  NAIVE_MAE <- c()
  df <- list()
  df2 <- list()
  ni <- c()
  for(k in unique(frame2$series_id)){
    df[[k]] <- subset(frame, series_id == k)
    df2 <-  subset(frame2, series_id ==k)
    NAIVE_MAE[k] <- mean(abs(diff(df2$value)))
    ni[k] <- length(unique(df[[k]]$horizon))
    df[[k]] <- cbind(df[[k]], " NAIVE_MAE " = rep(NAIVE_MAE[k], length(unique(frame$horizon))*length(unique(frame$method))), "ni" = rep(ni[k], length(unique(frame$horizon))*length(unique(frame$method))))
  }
  df = do.call(rbind, df)
  lnr <- log(abs(df$actual - df$forecast)/ df$` NAIVE_MAE `)
  df <- cbind(df, "lnr" = lnr)
  # we want to remove rows contain any NA or Inf/-Inf values
  df <- df[Reduce(`&`, lapply(df, function(x) !is.na(x)  & is.finite(x))),]
  for(j in as.vector(unique(df$horizon))){
    for(i in as.vector(unique(df$method))){
      df3[i, j] <- exp(sum(subset(df, method == i & horizon == j)$ni*subset(df,method == i & horizon == j )$lnr)/ sum(subset(df, method == i & horizon == j)$ni))
    }
  }

  for (k in 1:length(unique(frame$horizon))){
    ranks[,k] <- rank(df3[, k])
  }
  averagerank <- rowMeans(ranks, na.rm =TRUE)
  averageAvgRelMAE <- rowMeans(df3, na.rm =TRUE)
  ranks <- cbind(ranks, "average rank" = averagerank)
  df3 <- cbind(df3, " average AvgRelMAE" = averageAvgRelMAE)

  for(m in 1:length(unique(frame$method))){
    AvgRelMAElist[[m]] <- unname(df3[m, 1:length(unique(frame$horizon))])
    methodlist[[m]] <- rep(as.vector(unique(frame$method))[m],length(unique(frame$horizon)))
    horizonlist[[m]]<- as.vector(unique(frame$horizon))
  }
  AvgRelMAE1 <- Reduce(c, AvgRelMAElist)
  AvgRelMAE <- Reduce(c, AvgRelMAE1)
  horizon <- Reduce(c, horizonlist)
  method = Reduce(c, methodlist)
  df4 <- data.frame(AvgRelMAE, horizon, method )
# Plot AvgRelMAEs
  gp1 <- ggplot2::ggplot(df4, ggplot2::aes(x=horizon, y=AvgRelMAE, group=method,color=method, shape=method))+
    ggplot2::scale_shape_manual(values=1:nlevels(df4$method)) +
    ggplot2::labs(title = "AvgRelMAE for different horizons and methods") +
    ggplot2::geom_line() +
    ggplot2::geom_point(size=3)+
    ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
  print(gp1)

  outlist <- list("AvgRelMAE" = df3,"rank" =ranks)
  if(sort == FALSE){
    return(outlist)
  }else{
    frame1 <-df3[order(df3$` average AvgRelMAE`),]
    frame11 <- ranks[order(ranks$`average rank`),]
    outlist <- list("AvgRelMAE" = frame1,"rank" = frame11)
    return(outlist)
  }
}