R/calculateMAPEs.R

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

#' Mean Absolute Percentage errors for the given data from dataset (MAPEs)
#'
#' This function calculates and returns list of two dataframes,
#' where the first data frame contains MAPEs for the given data, diferent horizons and methods,
#' the second one contains ranked list of the methods according to MAPEs.
#' Also the function plots MAPEs for different hirizons and methods.
#'
#' @aliases calculateMAPEs
#' @param frame A data frame containing columns "actual", "forecast", "method", and "horizon".
#' @param sort logical. If TRUE the resulting list of MAPEs dataframe and ranked dataframe of MAPEs sorting by average value.
#' @return \code{calculateMAPEs} function calculates and returns list of two dataframes,
#' where the first data frame contains MAPEs for the given data, diferent horizons and methods,
#' the second one contains ranked dataframe of the methods according to MAPEs.
#' Also the function plots MAPEs for different hirizons and methods.
#' @author Sai Van Cuong, Maixm Shcherbakov and Andrey Davydenko
#' @seealso \code{\link{calculateAvgRelMAEs}}, \code{\link{calculateGMAPEs}}, \code{\link{calculateGMRAEs}}, \code{\link{calculateMAD_MEAN_ratio}},
#' \code{\link{calculateMAEs}}, \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 Rob J. Hyndman, Anne B. Koehler (2006) Volume title: "International Journal of Forecasting".
#' Chapter title: \emph{Another look at measures of forecast accuracy}. Chapter pages : (p.679-688).
#' \url{http://eva.fcea.edu.uy/pluginfile.php/109034/mod_resource/content/0/2006_Hyndman_Predicc.pdf}.
#' @keywords dataframe
#' @examples
#' calculateMAPEs(frame = FORAYearForecast)
#' calculateMAPEs(frame = FORAYearForecast, sort = TRUE)
#' data1 <- subset(FORAYearForecast, actual >= 5000| forecast < 8000)
#' data2 <- FORAYearForecast[1:300,]
#' calculateMAPEs(frame = data1, sort = TRUE)
#' calculateMAPEs(frame = data2, sort = TRUE)
#'
#' @export
calculateMAPEs <- function(frame, sort = FALSE){
 out <-matrix(NA, nrow = length(unique(frame$method)), ncol = length(unique(frame$horizon)))
 methodlist <- list()
 horizonlist <- list()
 MAPElist <- list()
 MAPE <- c()
 df = data.frame(out)
 colnames(df) <- paste("horizon = ", 1:length(unique(frame$horizon)), sep ="")
 rownames(df) <- unique(frame$method)
 ranks = data.frame(out)
 colnames(ranks) <- paste("horizon = ", 1:length(unique(frame$horizon)), sep ="")
 rownames(ranks) <- unique(frame$method)
 obsCount <- data.frame(out)
 colnames(obsCount) <- paste("horizon = ", 1:length(unique(frame$horizon)), sep ="")
 rownames(obsCount) <- unique(frame$method)
 outlist <- list()

 for(j in as.vector(unique(frame$horizon))){
   for(i in as.vector(unique(frame$method))){
     df[i, j] <-  100*mean(abs((subset(frame, method == i & horizon == j)$actual - subset(frame, method == i & horizon == j)$forecast)/subset(frame, method == i & horizon == j)$actual), na.rm=TRUE)
     obsCount[i, j] <- length(subset(frame, method == i & horizon == j)$actual[subset(frame, method == i & horizon == j)$actual != 0 & !is.na(subset(frame, method == i & horizon == j)$actual)])
   }
 }

 for (k in 1:length(unique(frame$horizon))){
   ranks[,k] <- rank(df[, k])
 }
 averagerank <- rowMeans(ranks, na.rm =TRUE)
 averageMAPE <- rowMeans(df, na.rm =TRUE)
 sumObs <- rowSums(obsCount, na.rm = TRUE)

 ranks <- cbind(ranks, "average rank" = averagerank)
 df <- cbind(df, " average MAPE" = averageMAPE)
 obsCount <- cbind(obsCount, "sumObs" = sumObs)

 for(m in 1:length(unique(frame$method))){
   MAPElist[[m]] <- unname(df[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))
 }
  MAPE1 <- Reduce(c, MAPElist)
  MAPE <- Reduce(c, MAPE1)
  horizon <- Reduce(c, horizonlist)
  method = Reduce(c, methodlist)
  df2 <- data.frame(MAPE, horizon, method )
# plots MAPEs frame
  gp1 <- ggplot2::ggplot(df2, ggplot2::aes(x=horizon, y=MAPE, group=method,color=method, shape=method))+
    ggplot2::scale_shape_manual(values=1:nlevels(df2$method)) +
    ggplot2::labs(title = "MAPE 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("MAPE" = df, "rank" =ranks, "obsCount" = obsCount)

  if(sort == FALSE){
    return(outlist)
  }else{
  frame1 <-df[order(df$` average MAPE`),]
  frame2 <- ranks[order(ranks$`average rank`),]
  outlist <- list("MAPE" = frame1,"rank" = frame2, "obsCount" = obsCount)
  return(outlist)
  }

}