Kolassa gives a reference for the true answer: the (-1)-median of the future distribution.
I do not know how to calculate this, so I will turn to a numerical approximation. The following R
code seems to do the trick.
set.seed(2022)
N <- 100
x <- rbinom(10, 100, 1/5) + 1 # Some numbers to try it out
# Function to calculate MAPE
#
mape <- function(y_true, y_pred){
return(
mean(
abs(
(y_true - y_pred)
/
(y_true)
)
)
)
}
# Function to find value that minnimizes MAPE for an input x
#
min_mape <- function(x, N = 1000){
x_pred_possibilities <- seq(min(x), max(x), (max(x) - min(x))/(N - 1))
mapes <- rep(NA, length(x_pred_possibilities))
for (i in 1:length(mapes)){
x_preds <- rep(x_pred_possibilities[i], length(x))
mapes[i] <- mape(x, x_preds)
}
plot(x_pred_possibilities, mapes)
return(x_pred_possibilities[which(mapes == min(mapes))])
}
min_mape(x)
Without proving that this is the case (indeed, I might be wrong), I speculate that the minimizer of MAPE must not be less than the lowest value and must not be higher than the higher value. The x_pred_possibilities
variable is all of the numbers between the minimum and maximum values, incrementing up by a fixed amount to give a vector of length N
, as defined in the function arguments.
Then I make a prediction vector that repeats each x_pred_possibilities
value so that the prediction is the same for each true value in the input vector x
. I make every such vector, as allowed by the possibilities in x_pred_possibilities
. Finally, I graph the MAPE values as a function of the prediction, and I return the prediction value giving the smallest MAPE.
A slight modification allows us to do this for other loss functions, such as MSE or MAE.
set.seed(2022)
N <- 100
x <- rbinom(N, 100, 1/5) + 1
# Function to calculate MAPE
#
mape <- function(y_true, y_pred){
return(
mean(
abs(
(y_true - y_pred)
/
(y_true)
)
)
)
}
mse <- function(y_true, y_pred){
return(
mean(
(
y_true - y_pred
)^2
)
)
}
mae <- function(y_true, y_pred){
return(
mean(
abs(
y_true - y_pred
)
)
)
}
# Function to find value that minnimizes MAPE for an input x
#
min_mape <- function(x, loss, N = 1000){
x_pred_possibilities <- seq(min(x), max(x), (max(x) - min(x))/(N - 1))
mapes <- rep(NA, length(x_pred_possibilities))
for (i in 1:length(mapes)){
x_preds <- rep(x_pred_possibilities[i], length(x))
mapes[i] <- loss(x, x_preds)
}
plot(x_pred_possibilities, mapes)
return(x_pred_possibilities[which(mapes == min(mapes))])
}
min_mape(x, mse, 100000) # 20.90993
mean(x) # 20.91
min_mape(x, mae, 100000) # 21.00009
median(x) # 21
My function is highly accurate, being perfect if we round to two decimal places.
However, note that, despite the initial appeal of MAPE, the metric suffers from some problems, as discussed on its Wikipedia page.