R/summary.R

In nelson16silva/wavcoreinf: Estimation and Evaluation of Wavelet Core Inflation Measures

#' Summarize Wavelet Core Inflation
#'
#' This function calculates statistics that summarize the quality of
#' an estimated wavelet-based core inflation measure, excluding the forecasting
#' criterion.
#'
#' @param x An object generated by the function \code{\link{wcore_table}}.
#' @param y A numeric vector (headline inflation) that must be the same \code{x} used in \code{\link{wav_smooth}}.
#'
#' @return A tibble. New columns are added to the object \code{x}:
#' \describe{
#' \item{sd}{Standard desviation of \code{x_sm} column that represents the
#' wavelet core inflation measure.}
#' \item{mav25}{RMSE of headline inflation 25-period centered
#'  moving avarage (\code{\link{mavc}}) and
#'  wavelet core inflation.}
#'  \item{no_bias}{p-value calculated by the
#'  function \code{\link{no_bias2}} to
#'  verify if the bias of the wavelet core inflation
#'  measure is not significant.}
#'  \item{alpha, val_p, alpha1 and val_p1}{Coefficients
#'  \eqn{\lambda_h} and \eqn{\lambda^*_h} and respective
#'  p-value from function \code{\link{dyn_adj}}, where
#'  \code{H = 1 and p = 1}.}
#' }
#'
#' @seealso \code{\link{wcore_table}},
#' \code{\link{wav_smooth}}, \code{\link{mavc}},
#' \code{\link{no_bias2}}.
#'
#' @export
#'
#' @examples
#' library(lubridate)
#'
#' inf_head <- coreinf_br[["ipca"]]
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#'
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' wcore_summary(core_wavelet2, inf_head)
wcore_summary <- function(x, y) {
  x %>%
    dplyr::mutate(
      sd = purrr::map(.data$x_sm, ~purrr::possibly(stats::sd, NA)(.x)),
      mav25 = purrr::map(.data$x_sm, ~sqrt(purrr::possibly(mean, NA)((.x - mavc(y, 25))^2))),
      no_bias = purrr::map(.data$x_sm, ~purrr::possibly(no_bias2, NA)(y, .x)),
      dyn_inf = purrr::map(.data$x_sm, ~purrr::possibly(dplyr::summarise_all, NA)(purrr::possibly(dyn_adj, NA)(y, .x, 1, 1), mean)),
      dyn_core = purrr::map(.data$x_sm, ~purrr::possibly(dplyr::summarise_all, NA)(purrr::possibly(dyn_adj, NA)(.x, y, 1, 1), mean))
    ) %>%
    tidyr::drop_na() %>%
    tidyr::unnest(.data$sd, .data$mav25, .data$no_bias, .data$dyn_inf, .data$dyn_core) %>%
    tidyr::drop_na()
}

#' Includes Forecasting in the Wavelet Core Inflation Summary
#'
#' \code{wcore_summary_fcast} includes forecasting error in the
#' summary of the wavelet core inflation measure. This is done
#' separetely because forecasting can be too consuming in terms of
#' computation time.
#'
#' @inheritParams wcore_summary
#' @param wcoretbl An object generated by the function \code{\link{wcore_table}}.
#' @param error An object generated by the function \code{\link{error_wave_summary}}.
#'
#' @return A tibble. New columns are added to the object \code{wcoretbl}:
#' \describe{
#' \item{error}{Mean of RMSE for several horizons. See \code{\link{error_wave_summary}}.}
#' \item{sd, mav25, no_bias, alpha, val_p, alpha1, val_p1}{These columns are
#' the same ones explained in the section \strong{Value}
#' of the \code{\link{wcore_summary}} function.}
#' }
#' @export
#' @examples
#' library(lubridate)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' inf_head <- coreinf_br[["ipca"]]
#'
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' # A more realistic estimation of the forecasting
#' # error could have h and k greather than 2 and 6.
#'
#' err_wcore <- error_wave_summary(h = 2, x = wshr_obj,
#'                                 y = inf_head, lags = lags(2,1),
#'                                 k = 6, RMSE = TRUE)
#'
#' wcore_summary_fcast(inf_head, core_wavelet2, err_wcore)
#'
wcore_summary_fcast <- function(y, wcoretbl, error) {
  wcoretbl %>%
    tibble::add_column(error = error$error) %>%
    wcore_summary(., y)
}

#' Choose Best Wavelet Model
#'
#' \code{wcore_summary_best} chooses the wavelet models that are the most
#' favorable ones in terms of statistics calculated by the function
#' \code{\link{wcore_summary_fcast}}.
#'
#' @param x A tibble from \code{\link{wcore_summary_fcast}}.
#' @param d A vector of weigths. These weigths stand for standard
#' deviation, \link[=mavc]{moving avarage}, \link[=no_bias2]{no bias},
#' \link[=dyn_adj]{dynamic adjustment} and
#' \link[=error_wave_summary]{forecast error}, respectively.
#'
#' @details Criteria variables that are in input \code{x}
#' are normalized to the interval [0, 1]. Given \code{d},
#' the function \code{wcore_summary_best} returns the model in which the sum
#' of criteria is minimal. When the criterion is p-value, as in
#' \link[=no_bias2]{no bias}, the normalization is (1 - "p-value").
#'
#' The motivation for this function is that a good core inflation
#' should possess desirable statistical features. Some of them are
#' captured in \code{wcore_summary_best}. A good core inflation
#' should have low standard deviation, capture trend inflation
#' (moving avarage), not be biased,  have dynamic consistency, and should help to predict headline
#' inflation.
#'
#' @return A tibble with the best models. If more than one wavelet
#' specification have the same statistics, all these models are presented
#' in the tibble.
#' @export
#' @references
#'
#' Silva Filho, Tito N. Teixeira da, &
#' Figueiredo, Francisco Marcos Rodrigues. (2011).
#' Has core inflation been doing a good job in Brazil?.
#' Revista Brasileira de Economia, 65(2), 207-233.
#'
#' Yash P. Mehra & Devin Reilly, 2009.
#' "Short-term headline-core inflation dynamics,"
#' Economic Quarterly, Federal Reserve Bank of Richmond,
#' issue Sum, pages 289-313.
#' @examples
#' library(lubridate)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' inf_head <- coreinf_br[["ipca"]]
#'
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' # A more realistic estimation of the forecasting
#' # error could have h and k greather than 2 and 6.
#'
#' err_wcore <- error_wave_summary(h = 2, x = wshr_obj,
#'                                 y = inf_head, lags = lags(2,1),
#'                                 k = 6, RMSE = TRUE)
#'
#' wavcore_smry <- wcore_summary_fcast(inf_head, core_wavelet2, err_wcore)
#'
#' wcore_summary_best(wavcore_smry)
wcore_summary_best <- function(x, d = c(1, 1, 1, 1, 1)) {
  min_diff <- function(obj, y) {
    y <- rlang::enexpr(y)
    min <- obj %>% dplyr::select(!!y) %>% min()
    max <- obj %>% dplyr::select(!!y) %>% max()
    list(min = min, diff = (max - min))
  }
  x_plus_crit <- x %>%
    dplyr::mutate(crit =
             d[1] * ((.data$sd - min_diff(x, .data$sd)$min) / min_diff(x, .data$sd)$diff) +
             d[2] * ((.data$mav25 - min_diff(x, .data$mav25)$min) /  min_diff(x, .data$mav25)$diff) +
             d[3] * (1 - .data$no_bias) +
             d[4] * (1 - .data$val_p1) +
             d[5] * ((.data$error - min_diff(x, .data$error)$min) / min_diff(x, .data$error)$diff))
  min_crit <- x_plus_crit  %>%  dplyr::select(.data$crit) %>% min()
  x_plus_crit %>% dplyr::filter(.data$crit < (min_crit + min_crit/10000))
}


#' Compute Best (Median) Wavelet Series
#'
#' \code{wcore_best_median} extracts the series of the best model
#' computed by the function \code{\link{wcore_summary_best}}. If more than
#' one model is selected, this function calculates the median of the models.
#'
#' @param x An object from \code{\link{wcore_summary_best}}.
#'
#' @return A tibble.
#'
#' @seealso \code{\link{wcore_summary_best}}
#'
#' @export
#'
#' @examples
#' library(lubridate)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' inf_head <- coreinf_br[["ipca"]]
#'
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' # A more realistic estimation of the forecasting
#' # error could have h and k greather than 2 and 6.
#'
#' err_wcore <- error_wave_summary(h = 2, x = wshr_obj,
#'                                 y = inf_head, lags = lags(2,1),
#'                                 k = 6, RMSE = TRUE)
#'
#' wavcore_smry <- wcore_summary_fcast(inf_head, core_wavelet2, err_wcore)
#'
#' x <- wcore_summary_best(wavcore_smry)
#'
#' wcore_best_median(x)
wcore_best_median <- function(x) {
  x %>%
    tidyr::unnest(.data$date, .data$x_sm) %>%
    dplyr::group_by(.data$date) %>%
    dplyr::summarise(wcore_med = stats::median(.data$x_sm))
}


#' Summarize Statistics of the Models by Group
#'
#' This function calculates some statistics about wavelet
#' core inflation measure by group.
#'
#' @param x An objetct generated by the functions \code{\link{wcore_summary}},
#'  \code{\link{wcore_summary_fcast}} or \code{\link{wcore_summary_best}}.
#' @inheritParams wcore_summary
#' @param group A groupping variable representing a parameter used to
#' compute wavelet-based signal estimation that must be
#' presenting  in the object \code{x}.
#'
#' @return A tibble. The fist column is the groupping variable. The other
#' columns are:
#' \describe{
#' \item{mean2}{Mean of the wavelet core inflation.}
#' \item{max}{Maximun value of the wavelet core inflation.}
#' \item{min}{Maximun value of the wavelet core inflation.}
#' \item{sd2}{Standard desviation.}
#' \item{cv}{Coeficient of variation of the wavelet core
#' inflation.}
#' \item{tmean}{\link[=t.test]{t-tests}
#' involving wavelet core inflation and headline inflation.}
#' }
#'
#' @export
#'
#' @examples
#' library(lubridate)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' inf_head <- coreinf_br[["ipca"]]
#'
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' # A more realistic estimation of the forecasting
#' # error could have h and k greather than 2 and 6.
#'
#' err_wcore <- error_wave_summary(h = 2, x = wshr_obj,
#'                                 y = inf_head, lags = lags(2,1),
#'                                 k = 6, RMSE = TRUE)
#'
#' wavcore_smry <- wcore_summary_fcast(inf_head, core_wavelet2, err_wcore)
#'
#' x <- wcore_summary_best(wavcore_smry)
#'
#' wcore_best_est(wavcore_smry, inf_head, wavelet)
#' wcore_best_est(x, inf_head, n.level)
wcore_best_est <- function(x, y, group) {
  group <- rlang::enexpr(group)
  x %>%
    tidyr::unnest(.data$date, .data$x_sm) %>%
    dplyr::group_by(!!group) %>%
    dplyr::summarise(
      mean2 = mean(.data$x_sm),
      max = max(.data$x_sm),
      min = min(.data$x_sm),
      sd2 = stats::sd(.data$x_sm, na.rm = TRUE),
      cv = .data$sd2 / .data$mean2,
      tmean = stats::t.test(.data$x_sm, y)$p.value
    )
}


#' Extract Wavelet Denoised Series
#'
#' This function computes the median series
#' representing the wavelet-based signal estimation
#'  series for a specific condition.
#'
#' @param x An object generated by the functions
#' \code{\link{wcore_summary}} or \code{\link{wcore_summary_fcast}}.
#' @param filterexpr A logical condition involving
#' variables  used in functions of type \code{\link{wav_args}}.
#'
#' @return A tibble
#' @export
#'
#' @examples
#' library(lubridate)
#'
#' inf_head <- coreinf_br[["ipca"]]
#' date_start <- coreinf_br[["date"]][1]
#' ts_start <- c(year(date_start), month(date_start))
#' inf_head_ts <- ts(inf_head, start = ts_start, frequency = 12)
#'
#' wshr_obj <- wav_args_wshr(list(
#' wavelet = c("haar", "d4", "d6", "d8", "s8"),
#' n.level = 1:4
#' ))
#'
#' core_wavelet <- wav_smooth(inf_head, wshr_obj)
#'
#' core_wavelet2 <- wcore_table(core_wavelet, inf_head_ts)
#'
#' x <- wcore_summary(core_wavelet2, inf_head)
#'
#' wcore_spec(x, wavelet == "haar")
wcore_spec <- function(x, filterexpr) {
  fexpr <- rlang::enexpr(filterexpr)
  x %>%
    dplyr::filter(!!fexpr & !is.null(.data$sd)) %>%
    tidyr::unnest(.data$date, .data$x_sm) %>%
    dplyr::group_by(.data$date) %>%
    dplyr::summarise(median = stats::median(.data$x_sm))
}