Add SMAPE to diagnostics.R (#1711)

* Add SMAPE to diagnostics.R

Add symmetric mean absolute percentage error.
Include mdape and smape as default performance metrics.

* Add SMAPE to diagnostics.R

Add symmetric mean absolute percentage error.
Include mdape and smape as default performance metrics.

* sMAPE minor code formatting improvements

* Fixed smape function in diagnostics.R
This commit is contained in:
Pawel Kranzberg 2020-11-09 19:42:20 +01:00 committed by GitHub
parent 4f34de0363
commit ad3832bb19
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23

View file

@ -222,6 +222,7 @@ prophet_copy <- function(m, cutoff = NULL) {
#' 'mae': mean absolute error,
#' 'mape': mean percent error,
#' 'mdape': median percent error,
#' 'smape': symmetric mean absolute percentage error,
#' 'coverage': coverage of the upper and lower intervals
#'
#' A subset of these can be specified by passing a list of names as the
@ -246,7 +247,7 @@ prophet_copy <- function(m, cutoff = NULL) {
#'
#' @param df The dataframe returned by cross_validation.
#' @param metrics An array of performance metrics to compute. If not provided,
#' will use c('mse', 'rmse', 'mae', 'mape', 'mdape', 'coverage').
#' will use c('mse', 'rmse', 'mae', 'mape', 'mdape', 'smape', 'coverage').
#' @param rolling_window Proportion of data to use in each rolling window for
#' computing the metrics. Should be in [0, 1] to average.
#'
@ -254,7 +255,7 @@ prophet_copy <- function(m, cutoff = NULL) {
#'
#' @export
performance_metrics <- function(df, metrics = NULL, rolling_window = 0.1) {
valid_metrics <- c('mse', 'rmse', 'mae', 'mape', 'coverage')
valid_metrics <- c('mse', 'rmse', 'mae', 'mape', 'mdape', 'smape', 'coverage')
if (is.null(metrics)) {
metrics <- valid_metrics
}
@ -500,6 +501,24 @@ mdape <- function(df, w) {
}
#' Symmetric mean absolute percentage error
#' based on Chen and Yang (2004) formula
#'
#' @param df Cross-validation results dataframe.
#' @param w Aggregation window size.
#'
#' @return Array of symmetric mean absolute percent errors.
#'
#' @keywords internal
smape <- function(df, w) {
sape <- abs(df$y - df$yhat) / ((abs(df$y) + abs(df$yhat)) / 2)
if (w < 0) {
return(data.frame(horizon = df$horizon, smape = sape))
}
return(rolling_mean_by_h(x = sape, h = df$horizon, w = w, name = 'smape'))
}
#' Coverage
#'
#' @param df Cross-validation results dataframe.