Skip to content

Commit 3086cc8

Browse files
donotdespairdonotdespair
authored
Merge pull request #32 from bsvars/28-forecast-performance-evaluation
28 forecast performance evaluation
2 parents 7864caf + 757695a commit 3086cc8

21 files changed

+3213
-39
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ Authors@R: c(person(given="Tomasz", family="Woźniak", email="wozniak.tom@pm.me"
1111
Maintainer: Tomasz Woźniak <wozniak.tom@pm.me>
1212
License: GPL (>= 3)
1313
Depends:
14-
R (>= 2.10),
14+
R (>= 4.1.0),
1515
bsvars (>= 3.2)
1616
Imports:
1717
R6,

‎NAMESPACE‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,26 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
S3method(compute_forecast_performance,ForecastsPANELpoos)
34
S3method(compute_variance_decompositions,PosteriorBVARPANEL)
45
S3method(estimate,BVARGROUPPANEL)
56
S3method(estimate,BVARPANEL)
67
S3method(estimate,PosteriorBVARGROUPPANEL)
78
S3method(estimate,PosteriorBVARPANEL)
9+
S3method(forecast,PosteriorBVARGROUPPANEL)
810
S3method(forecast,PosteriorBVARPANEL)
11+
S3method(forecast_poos_recursively,BVARGROUPPANEL)
12+
S3method(forecast_poos_recursively,BVARPANEL)
913
S3method(plot,ForecastsPANEL)
1014
S3method(plot,PosteriorFEVDPANEL)
1115
S3method(summary,ForecastsPANEL)
1216
S3method(summary,PosteriorBVARPANEL)
1317
S3method(summary,PosteriorFEVDPANEL)
18+
export(compute_forecast_performance)
19+
export(forecast_poos_recursively)
1420
export(specify_bvarGroupPANEL)
1521
export(specify_bvarPANEL)
1622
export(specify_panel_data_matrices)
23+
export(specify_poosf_exercise)
1724
export(specify_posterior_bvarGroupPANEL)
1825
export(specify_posterior_bvarPANEL)
1926
export(specify_prior_bvarPANEL)

‎R/compute_forecast_performance.R‎

Lines changed: 202 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,202 @@
1+
2+
#' @title Computes forecasting performance measures for recursive
3+
#' pseudo-out-of-sample forecasts
4+
#'
5+
#' @description Computes forecasting performance measures selected from:
6+
#' log-predictive score \code{"lps"}, root-mean-squared-forecast error \code{"rmsfe"},
7+
#' mean-absolute-forecast error \code{"mafe"} from the output of the recursive
8+
#' pseudo-out-of-sample forecastinge exercise performed using function
9+
#' \code{\link{forecast_poos_recursively}}.
10+
#'
11+
#' @param forecasts an object containing the
12+
#' outcome of Bayesian recursive pseudo-out-of-sample forecasting exercise
13+
#' using expanding window samples generated using function \code{\link{forecast_poos_recursively}}.
14+
#' @param measures a character vector with any of the values \code{"lps"},
15+
#' \code{"rmsfe"}, \code{"mafe"} indicating the forecasting performance measures
16+
#' to be computed.
17+
#'
18+
#' @return An object of class \code{ForecastingPerformance}
19+
#'
20+
#' @seealso \code{\link{forecast_poos_recursively}},
21+
#' \code{\link{forecast_poos_recursively.BVARPANEL}},
22+
#' \code{\link{forecast_poos_recursively.BVARGROUPPANEL}}
23+
#'
24+
#' @author Tomasz Woźniak \email{wozniak.tom@pm.me}
25+
#'
26+
#' @examples
27+
#' spec = specify_bvarPANEL$new(ilo_dynamic_panel) # specify the model
28+
#' poos = specify_poosf_exercise$new(spec, 10, 5, c(1,2), 30) # specify the forecasting exercise
29+
#' fore = forecast_poos_recursively(spec, poos) # perform the forecasting exercise
30+
#' fp = compute_forecast_performance(fore, "pls") # compute forecasting performance measures
31+
#' fp$PLS$POL # print the forecasting performance measures
32+
#'
33+
#' @export
34+
compute_forecast_performance <- function(
35+
forecasts,
36+
measures = c("pls", "rmsfe", "mafe")
37+
) {
38+
# check the inputs
39+
stopifnot("Argument measures must contain any of the values `pls`, `rmsfe`, `mafe`"
40+
= any(c(unique(measures) == "pls", unique(measures) == "rmsfe", unique(measures) == "mafe")))
41+
42+
# call method
43+
UseMethod("compute_forecast_performance", forecasts)
44+
} # END compute_forecast_performance
45+
46+
47+
48+
49+
50+
#' @inherit compute_forecast_performance
51+
#' @method compute_forecast_performance ForecastsPANELpoos
52+
#' @param forecasts an object of class \code{ForecastsPANELpoos} containing the
53+
#' outcome of Bayesian recursive pseudo-out-of-sample forecasting exercise
54+
#' using expanding window samples generated using function
55+
#' \code{\link{forecast_poos_recursively}}.
56+
#'
57+
#' @export
58+
compute_forecast_performance.ForecastsPANELpoos <- function(
59+
forecasts,
60+
measures = c("pls", "rmsfe", "mafe")
61+
) {
62+
63+
64+
forecasting_sample = length(forecasts)
65+
C = length(forecasts[[1]])
66+
dims = dim(forecasts[[1]][[1]]$forecast_mean)
67+
N = dims[1]
68+
H = dims[2]
69+
S = dims[3]
70+
71+
# RMSFE and MAFE computations
72+
if (any(c(measures == "rmsfe", measures == "mafe"))) {
73+
forecast_error = sapply(
74+
1:forecasting_sample,
75+
function(i) {
76+
sapply(
77+
1:C,
78+
function(c) {
79+
forecasts[[i]][[c]]$evaluation_data - apply(forecasts[[i]][[c]]$forecasts, 1:2, mean)
80+
},
81+
simplify = "array"
82+
)
83+
},
84+
simplify = "array"
85+
)
86+
}
87+
88+
if (any(measures == "rmsfe")) {
89+
rmsfe_array = array(NA, c(N + 1, H, C + 1))
90+
rmsfe_array[1:N,,1:C] = apply(forecast_error, 1:3, function(x) sqrt(mean(x^2)))
91+
rmsfe_array[N + 1,,1:C] = apply(
92+
array(rmsfe_array[1:N,,1:C], c(N,H,C)),
93+
2:3,
94+
function(x) sqrt(mean(x^2)))
95+
rmsfe_array[1:N,,C + 1] = apply(
96+
array(rmsfe_array[1:N,,1:C], c(N,H,C)),
97+
1:2,
98+
function(x) sqrt(mean(x^2)))
99+
rmsfe_array[N + 1,,C + 1] = apply(
100+
array(rmsfe_array[N + 1,,1:C], c(1,H,C)),
101+
1,
102+
function(x) sqrt(mean(x^2)))
103+
}
104+
105+
if (any(measures == "mafe")) {
106+
mafe_array = array(NA, c(N + 1, H, C + 1))
107+
mafe_array[1:N,,1:C] = apply(forecast_error, 1:3, function(x) mean(abs(x)))
108+
mafe_array[N + 1,,1:C] = apply(
109+
array(mafe_array[1:N,,1:C], c(N,H,C)),
110+
2:3,
111+
mean)
112+
mafe_array[1:N,,C + 1] = apply(
113+
array(mafe_array[1:N,,1:C], c(N,H,C)),
114+
2,
115+
mean)
116+
mafe_array[N + 1,,C + 1] = apply(
117+
array(mafe_array[N + 1,,1:C], c(1,H,C)),
118+
1,
119+
mean)
120+
}
121+
122+
# PLS computations
123+
if (any(measures == "pls")) {
124+
log_norm = sapply(
125+
1:forecasting_sample,
126+
function(i) {
127+
sapply(
128+
1:C,
129+
function(c) {
130+
log_dnormm_ic = array(NA, c(N + 1, H, S))
131+
forecast_cov_ic = .Call(`_bpvars_fourDarray_to_field_cube`,
132+
forecasts[[i]][[c]]$forecast_cov
133+
)
134+
log_dnormm_ic[1:N,,] = .Call(`_bpvars_log_dnormm_marginal`, # (N, H, S)
135+
forecasts[[i]][[c]]$evaluation_data,
136+
forecasts[[i]][[c]]$forecast_mean,
137+
forecast_cov_ic
138+
)
139+
log_dnormm_ic[N + 1,,] = .Call(`_bpvars_log_dnormm_joint`, # (H, S)
140+
forecasts[[i]][[c]]$evaluation_data,
141+
forecasts[[i]][[c]]$forecast_mean,
142+
forecast_cov_ic
143+
)
144+
return(log_dnormm_ic)
145+
},
146+
simplify = "array"
147+
)
148+
},
149+
simplify = "array"
150+
)
151+
152+
log_mean = function(x) {.Call("_bpvars_log_mean", as.numeric(x))}
153+
lps_tmp = apply(log_norm, c(1,2,4), log_mean)
154+
pls_array = array(NA, c(N + 1, H, C + 1))
155+
pls_array[,,1:C] = lps_tmp
156+
pls_array[,,C + 1] = apply(lps_tmp, c(1,2), log_mean)
157+
}
158+
159+
# output
160+
country_names = names(forecasts[[1]])
161+
horizons = colnames(forecasts[[1]][[1]]$evaluation_data)
162+
variable_names = c(rownames(forecasts[[1]][[1]]$evaluation_data), "joint")
163+
164+
RMSFE = vector("list", C + 1)
165+
MAFE = vector("list", C + 1)
166+
PLS = vector("list", C + 1)
167+
168+
names(RMSFE) = names(MAFE) = names(PLS) = c(country_names, "Global")
169+
170+
for (c in 1:(C + 1)) {
171+
if (any(measures == "rmsfe")) {
172+
RMSFE[[c]] = matrix(rmsfe_array[,,c], ncol = H)
173+
rownames(RMSFE[[c]]) = variable_names
174+
colnames(RMSFE[[c]]) = horizons
175+
}
176+
177+
if (any(measures == "mafe")) {
178+
MAFE[[c]] = matrix(mafe_array[,,c], ncol = H)
179+
rownames(MAFE[[c]]) = variable_names
180+
colnames(MAFE[[c]]) = horizons
181+
}
182+
183+
if (any(measures == "pls")) {
184+
PLS[[c]] = matrix(pls_array[,,c], ncol = H)
185+
rownames(PLS[[c]]) = variable_names
186+
colnames(PLS[[c]]) = horizons
187+
}
188+
}# END c loop
189+
190+
out = list()
191+
if (any(measures == "rmsfe")) {
192+
out$RMSFE = RMSFE
193+
}
194+
if (any(measures == "mafe")) {
195+
out$MAFE = MAFE
196+
}
197+
if (any(measures == "pls")) {
198+
out$PLS = PLS
199+
}
200+
201+
return(out)
202+
}# END compute_forecast_performance.ForecastsPANELpoos

0 commit comments

Comments
 (0)