R/forecast_report.R

Defines functions forecast_report

#' @export
forecast_report <- function(forecast_param, start, end, n_ahead, X, index_x, index_y, accuracy_crit,
                   models_list, summary_models, models_weight, variant, output,
                   forecasts_lower, forecasts_upper, all_forecasts, ranking) {
    dir <- paste0("Output/", "Reports_variant_", variant, "/")
    suppressWarnings(
        dir.create(dir, recursive = TRUE)
    )
    
    options(width = 200)
    capture.output(
        file = paste0(dir, paste0(forecast_param, ".txt")),
        cat(
            "\nSCENARIO - scenario modeling and forecasting",
            "\nDate:",  format(Sys.time(), "%H:%M:%S - %d/%m/%Y"),
            "\n", R.version$version.string
        ),
        cat(
            "\n\nSPECIFICATION OF FORECAST",
            "\nScenario variant:", paste0(as.roman(variant)),
            "\nInitial time interval:", paste0(start, " - ", end - n_ahead),
            "\nThe forecasted time interval:", paste0(end - n_ahead + 1, " - ", end),
            "\nForecasting parameter:",  tolower(forecast_param),
            "\nPredictors:",
            if (!is.null(X)) {
                paste(tolower(names(data)[-1]), collapse = "; ")
            } else {
                "are absent."
            },
            if (!is.null(models_list)) {
                "\nModels type:"
            },
            if (!is.null(models_list) & !is.null(X)) {
                "take into account the influence of scenario conditions"
            } else if (!is.null(models_list) & is.null(X)) {
                "no scenario conditions"
            },
            if (!is.null(models_list)) {
                "\nNumber of successfully fitted models:"
            },
            if (!is.null(models_list) & !is.null(X)) {
                paste0(length(models_list), " of 7")
            } else if (!is.null(models_list) & is.null(X)) {
                paste0(length(models_list), " of 6")
            },
            "\nType of final forecast:",
            if (is.null(models_list)) {
                if (all(naive_forecast[setdiff(index_x, index_y), ] == 0)) {
                    "all initial parameter values are zero or none"
                } else {
                    "forecast for the last value (insufficient data / one repeating value / no successfully constructed models)"
                }
            } else {
                if (output == "consensus")  {
                    "consensus forecast based on all models using weighting factors (adaptive combination)"
                } else if (output == "best")  {
                    "forecast based on the best (the smallest error) model"
                } else {
                    "all options"
                }
            },
            if (!is.null(models_list)) {
                "\nThe basis for comparing the accuracy of models: full sample"
            },
            if (!is.null(models_list)) {
                "\nCriterion for comparing the accuracy of models:"
            },
            if (!is.null(models_list)) {
                accuracy_crit
            },
            if (!is.null(models_list)) {
                "\nThe best model by criterion:"
            },
            if (!is.null(models_list)) {
                row.names(ranking)[1]
            }
        ),
        if (is.null(models_list)) {
            cat("\nForecast:\n")
        },
        if (is.null(models_list)) {
            t(
                data.frame(
                    row.names = (end - n_ahead + 1):end,
                    naive_forecast = naive_forecast[as.character((end - n_ahead + 1):end), ]
                )
            )
        },
        if (!is.null(models_list)) {
            cat("\n\nThe accuracy of full-sample models and the weight in the consensus forecast (N - number of observations):\n")
        },
        if (!is.null(models_list)) {
            round(
                x = cbind(
                    ranking,
                    data.frame(`Weight (%)` = models_weight * 100, check.names = FALSE)
                ),
                digits = 4
            )
        },
        if (!is.null(models_list)) {
            cat("\nLower limit of 95% confidence interval of forecasts:\n")
        },
        if (!is.null(models_list)) {
            round(forecasts_lower, digits = 4)
        },
        if (!is.null(models_list)) {
            cat("\nUpper limit of 95% confidence interval of forecasts:\n")
        },
        if (!is.null(models_list)) {
            round(forecasts_upper, digits = 4)
        },
        if (!is.null(models_list)) {
            cat("\nAll variants of the forecast:\n")
        },
        if (!is.null(models_list)) {
            round(all_forecasts, digits = 4)
        },
        if (!is.null(models_list)) {
            cat("\nSPECIFICATION OF MODELS:\n")
        }, 
        if (!is.null(models_list)) {
            exc_models <- c("nnar", "nnar_xreg", "nnar_auto", "nnar_xreg_auto")
            for(i in seq_along(summary_models)) {
                if (names(summary_models[i]) == "ets_sc") {
                    cat("\n")
                    print(summary_models[[i]])
                } else if (any(names(summary_models[i]) == exc_models)) {
                    cat("\n", toupper(names(summary_models)[i]), "\n", sep = "")
                    print(summary_models[[i]])
                } else {
                    invisible(
                        {
                            cat("\n", toupper(names(summary_models)[i]), "\n", sep = "")
                            for(k in seq_along(summary_models[[i]])) {
                                cat("\n", names(summary_models[[i]])[[k]], ":\n", sep = "")
                                print(summary_models[[i]][[k]])
                            }
                        }
                    )
                }
            }
        }
    )
    options(width = 80)
}
faganok/scenario documentation built on Nov. 28, 2017, 4:06 p.m.