R/long_term_future_data.R

In oRaklE: Multi-Horizon Electricity Demand Forecasting in High Resolution

#' Get future predictions for the macro economic covariates
#'
#' This function gets predictions from the World Economic Outlook Database (April 2025 edition) for the covariates utilized in the long-term models. If the dataset argument is not set to "WEO",
#' the function will indicate which covariates require user-supplied predictions for \code{\link{long_term_future}}.
#'
#' @param longterm_predictions Dataframe or list. Generated by \code{\link{long_term_lm}}. Either the prediction dataframe or the complete output list can be used.
#' If the full list is supplied the function will extract the necessary models automatically.
#' @param end_year Integer. Specifies the final year for which future predictions will be generated.
#' @param dataset Character. By default the World Economic Outlook (WEO) Database April 2025 edition is used to generate covariate predictions for the long term models. If the dataset option is set to anything else than "WEO" the function will tell you for which covariates data will be needed to run \code{\link{long_term_future}}.
#' @param data_directory The path to the directory where the function will look for
#' the long-term models from \code{\link{long_term_lm}}. Only needed if dataset is not set to "WEO" and no model list is supplied.
#' @param model_list A list with the models from \code{\link{long_term_lm}}. Only needs to be specified if dataset is not set to "WEO" and if the models
#' are not in the data directory.
#' @return The extended initial dataframe until the specified end year with the covariate predictions if dataset = "WEO" . Otherwise, the dataframe will have empty covariate predictions and a note for which covariates a forecast must be supplied.
#' @export
#'
#' @examples
#' example_longterm_future_macro_data <- long_term_future_data(example_longterm_predictions,
#'   end_year = 2028, dataset = "WEO"
#' )
#'
long_term_future_data <- function(longterm_predictions, end_year, dataset = "WEO", data_directory = tempdir(), model_list = NULL) {
  if (inherits(longterm_predictions, "list") && names(longterm_predictions)[1] == "longterm_predictions") {
    lm_models <- longterm_predictions$longterm_models
    longterm_predictions <- longterm_predictions$longterm_predictions
  } else {
    lm_models <- NULL
  }
  new_data_length <- end_year - max(longterm_predictions$year)
  new_rows <- as.data.frame(matrix(nrow = new_data_length, ncol = ncol(longterm_predictions)))
  colnames(new_rows) <- colnames(longterm_predictions)
  longterm_predictions <- rbind(longterm_predictions, new_rows)

  if (dataset == "WEO") {
    weo_data_set <- oRaklE::weo_data
    message("Macro-economic predictions until ", end_year, " are taken from the World Economic Outlook Database April 2025 edition.")

    country <- countrycode::countrycode(unique(longterm_predictions$country), origin = "iso2c", destination = "country.name")[1]
    country_subset <- weo_data_set[weo_data_set$Country == country, ]
    colnames(country_subset)[10:60] <- 1980:2030

    first_year <- min(longterm_predictions$year, na.rm = T)
    start_year <- max(longterm_predictions$year, na.rm = T) + 1
    col_year_first <- which(colnames(country_subset) == as.character(first_year))
    col_year_end <- which(colnames(country_subset) == as.character(end_year))

    longterm_predictions$GDP_growth_weo <- 0
    longterm_predictions$GDP_deflator_weo <- 0
    longterm_predictions$population_growth_weo <- 0

    ngdp_r <- as.numeric(country_subset[1, col_year_first:col_year_end])
    ngdp_d <- as.numeric(country_subset[6, col_year_first:col_year_end])
    pl <- as.numeric(country_subset[27, col_year_first:col_year_end])
    # pcpipch <- as.numeric(country_subset[4,col_year_first:col_year_end])
    # longterm_predictions$consumer_price_pct_change_weo <-pcpipch


    for (i in 2:nrow(longterm_predictions)) {
      longterm_predictions$GDP_growth_weo[i] <- (ngdp_r[i] / ngdp_r[(i - 1)] - 1) * 100
      longterm_predictions$GDP_deflator_weo[i] <- (ngdp_d[i] / ngdp_d[(i - 1)] - 1) * 100
      longterm_predictions$population_growth_weo[i] <- (pl[i] / pl[(i - 1)] - 1) * 100
    }

    new_row_start <- (which(longterm_predictions$year == max(longterm_predictions$year, na.rm = T)) + 1)
    longterm_predictions$year[new_row_start:nrow(longterm_predictions)] <- (max(longterm_predictions$year, na.rm = T) + 1):end_year
    longterm_predictions$country <- unique(longterm_predictions$country)[1]
    longterm_predictions$test_set_steps <- unique(longterm_predictions$test_set_steps)[1]
    # longterm_predictions$consumer_price_inflation_pct[new_row_start:nrow(longterm_predictions)] <- longterm_predictions$consumer_price_pct_change_weo[new_row_start:nrow(longterm_predictions)]

    longterm_predictions$GDP_deflator[new_row_start:nrow(longterm_predictions)] <- longterm_predictions$GDP_deflator_weo[new_row_start:nrow(longterm_predictions)]
    longterm_predictions$GDP_growth[new_row_start:nrow(longterm_predictions)] <- longterm_predictions$GDP_growth_weo[new_row_start:nrow(longterm_predictions)]

    for (i in new_row_start:nrow(longterm_predictions)) {
      longterm_predictions$GDP[i] <- longterm_predictions$GDP[(i - 1)] * (1 + longterm_predictions$GDP_growth_weo[i] / 100)
      longterm_predictions$population[i] <- longterm_predictions$population[(i - 1)] * (1 + longterm_predictions$population_growth_weo[i] / 100)
    }

    for (i in new_row_start:nrow(longterm_predictions)) {
      longterm_predictions$industrial_value_added[i] <- mean(longterm_predictions$industrial_value_added[(i - 3):(i - 1)] / longterm_predictions$GDP[(i - 3):(i - 1)]) * longterm_predictions$GDP[i]
      longterm_predictions$manufacturing_value_added[i] <- mean(longterm_predictions$manufacturing_value_added[(i - 3):(i - 1)] / longterm_predictions$GDP[(i - 3):(i - 1)]) * longterm_predictions$GDP[i]
      longterm_predictions$service_value_added[i] <- mean(longterm_predictions$service_value_added[(i - 3):(i - 1)] / longterm_predictions$GDP[(i - 3):(i - 1)]) * longterm_predictions$GDP[i]
      longterm_predictions$household_consumption_expenditure[i] <- mean(longterm_predictions$household_consumption_expenditure[(i - 3):(i - 1)] / longterm_predictions$GDP[(i - 3):(i - 1)]) * longterm_predictions$GDP[i]
      longterm_predictions$GNI[i] <- mean(longterm_predictions$GNI[(i - 3):(i - 1)] / longterm_predictions$GDP[(i - 3):(i - 1)]) * longterm_predictions$GDP[i]
    }

    rural_model <- stats::lm(rural_population ~ year, data = longterm_predictions[1:(new_row_start - 1), ])
    longterm_predictions$rural_population[new_row_start:nrow(longterm_predictions)] <- stats::predict(rural_model, newdata = longterm_predictions[new_row_start:nrow(longterm_predictions), ])
    longterm_predictions <- longterm_predictions[, !names(longterm_predictions) %in% c("GDP_growth_weo", "GDP_deflator_weo", "population_growth_weo")]
  } else if (!is.null(lm_models)) {
    message("\nIf you want to use your own dataset you will need predictions for the following macro-economic variables:")
    i <- 1
    for (m in lm_models) {
      print_vars <- paste(attr(m$terms, "term.labels"), collapse = ", ")
      message("\n", print_vars, " for model ", i)
      i <- i + 1
    }
  } else {
    model_path <- paste0(data_directory,"/", unique(stats::na.omit(longterm_predictions$country)), "/models/longterm/best_lm_model1.Rdata")
    if (file.exists(model_path)) {
      best_lm_model <- NULL
      message("\nIf you want to use your own dataset you will need predictions for the following macro-economic variables:\n")
      for (i in 1:3) {
        model_path <- paste0(data_directory,"/", unique(stats::na.omit(longterm_predictions$country)), "/models/longterm/best_lm_model", i, ".Rdata")
        load(model_path)
        print_vars <- paste(attr(best_lm_model$terms, "term.labels"), collapse = ", ")
        message(print_vars, " for model ", i, "\n")
      }
    } else {
      message("Please load in the list of results from oRaklE::long_term_lm() or supply a valid *data_directory* if you want to know which macro-economic variables you need for future forecasts.")
    }
  }
  return(longterm_predictions)
}