R/calculateMAD_MEANs.R

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

#'  MAD/Mean ratio for the given data from dataset(MAD_MEAN_ratio)
#'
#' This function calculates and returns list of two dataframes,
#' where the first data frame contains MAD_MEAN_ratio for the given data, diferent horizons and methods,
#' the second one contains ranked list of the methods according to MAD_MEAN_ratio.
#' Also the function plots MAD_MEAN_ratio for different hirizons and methods.
#'
#' @aliases calculateMAD_MEAN_ratio
#' @param frame A data frame containing columns "actual", "forecast", "method" and "horizon".
#' @param sort logical. If TRUE the resulting list of MAD_MEAN_ratio dataframe and ranked dataframe of MAD_MEAN_ratio sorting by average value.
#' If not specify by default.
#' @return \code{calculateMAEs} function calculates and returns list of two dataframes,
#' where the first data frame contains MAD_MEAN_ratio for the given data, diferent horizons and methods,
#' the second one contains ranked dataframe of the methods according to MAD_MEAN_ratio.
#' Also the function plots MAD_MEAN_ratio 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{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 Stephan Kolassa and Wolfgang Schütz: "The International Journal of Applied Forecasting".
#' Title: \emph{Advantages of the MAD/Mean Ratio over the MAPE}. (p.40-43).
#' \url{https://econpapers.repec.org/article/forijafaa/y_3a2007_3ai_3a6_3ap_3a40-43.htm}.
#' @references S. D. Prestwich, R. Rossi, S. A. Tarim and B. Hnich: "Mean-Based Error Measures for
#' Intermittent Demand Forecasting". \url{https://arxiv.org/pdf/1310.5663.pdf}.
#' @keywords dataframe
#' @examples
#' calculateMAD_MEAN_ratio(frame = FORAYearForecast)
#' calculateMAD_MEAN_ratio(frame = FORAYearForecast, sort = TRUE)
#' data1 <- subset(FORAYearForecast, actual >= 5000| forecast < 8000)
#' data2 <- FORAYearForecast[1:300,]
#' calculateMAD_MEAN_ratio(frame = data1, sort = TRUE)
#' calculateMAD_MEAN_ratio(frame = data2, sort = TRUE)
#'
#' @export
calculateMAD_MEAN_ratio <- function(frame, sort = FALSE){
  out <-matrix(NA, nrow = length(unique(frame$method)), ncol = length(unique(frame$horizon)))
  methodlist <- list()
  horizonlist <- list()
  MAD_meanlist <- list()
  MAD_mean <- 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), na.rm = TRUE)/mean(subset(frame, method == i & horizon == j)$actual, na.rm=TRUE)
    }
  }

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

  for(m in 1:length(unique(frame$method))){
    MAD_meanlist[[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))
  }
  MAD_mean1 <- Reduce(c, MAD_meanlist)
  MAD_mean <- Reduce(c, MAD_mean1)
  horizon <- Reduce(c, horizonlist)
  method = Reduce(c, methodlist)
  df2 <- data.frame(MAD_mean, horizon, method )
  names(df2) <- c("MAD_MEAN", "horizon", "method")
# Plot MAD/MAE ratio
  gp1 <- ggplot2::ggplot(df2, ggplot2::aes(x=horizon, y=MAD_MEAN, group=method,color=method, shape=method))+
    ggplot2::scale_shape_manual(values=1:nlevels(df2$method)) +
    ggplot2::labs(title = "MAD/MEAN ratio 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("MAD/MEAN ratio" = df, "rank" =ranks)
  if(sort == FALSE){
    return(outlist)
  }else{
    frame1 <-df[order(df$` average MAD_MEAN`),]
    frame2 <- ranks[order(ranks$`average rank`),]
    outlist <- list("MAD/MEAN ration" = frame1,"rank" = frame2)
    return(outlist)
  }
}