Boosting Multiple Testingv0.0.0.9000

High-dimensional model selection / linear and binary-response inference.

DOC 04 / 06Empirical application

Linear inflation and PPM logit models using transformed FRED-MD data

A reproducible application showing data construction, model selection, threshold sensitivity, and post-selection estimation.

Data

Transformed FRED-MD variables

The package data contain transformed monthly U.S. macroeconomic series. After excluding date and the response PCEPI, the website calculations use 101 candidate variables.

McCracken, Michael W., and Serena Ng. 2016. “FRED-MD: A Monthly Database for Macroeconomic Research.” Journal of Business & Economic Statistics 34(4): 574–589. doi:10.1080/07350015.2015.1086655.

Source: Federal Reserve Bank of St. Louis, FRED-MD and FRED-QD. The package example uses the transformed snapshot distributed with the source tree.

Load package data
library(BoostingMultipleTesting)

data(
  "FREDMDPPM_transformed",
  package = "BoostingMultipleTesting"
)

fred_data <- as.data.frame(
  FREDMDPPM_transformed,
  stringsAsFactors = FALSE,
  check.names = FALSE
)

Data preview

datePCEPIRPIW875RX1DPCERA3M086SBEACMRMTSPLx
2-01-190.0010.00110.00090.00440.0144
3-01-190.00060.00190.00090.0141-0.028
4-01-190.00360.00350.00360.01530.0099
5-01-190.0010.00240.0024-0.0204-0.0315
6-01-190.00050.0008-0.0002-0.00030.0086
7-01-190.00180.00180.00190.0021-0.0069
Threshold specification

Compare the researcher-chosen exponent

The displayed results are computed when the website is built. Select a shared value for delta1 and delta2 to compare the resulting support while holding the data and all other settings fixed.

Current code value: delta1 = 1; delta2 is omitted and defaults to delta1.

\[c_p(n,\delta_s)=\Phi^{-1}\!\left(1-\frac{p}{2n^{\delta_s}}\right),\qquad s\in\{1,2\}\]
Linear application

Inflation as a continuous response

The linear application uses transformed PCEPI as the response. After complete-case filtering and removal of zero-variance columns, the estimation sample contains 785 observations and 101 standardized candidates.

\[\pi_t=c+\sum_{j\in\mathcal{S}_{\pi}}\beta_jx_{j,t}+u_t\]
Linear selection
delta1 <- 1
target_name <- "PCEPI"
inflation <- fred_data[[target_name]]
candidate_names <- setdiff(names(fred_data), c("date", target_name))
x_raw <- as.matrix(fred_data[candidate_names])
storage.mode(x_raw) <- "numeric"

keep <- is.finite(inflation) & complete.cases(x_raw)
y_linear <- inflation[keep]
x_linear <- x_raw[keep, , drop = FALSE]

sds <- apply(x_linear, 2, stats::sd)
x_linear <- scale(x_linear[, is.finite(sds) & sds > 0, drop = FALSE])

selected_linear <- boosting_glm(
  y = y_linear,
  X = x_linear,
  link = "linear",
  pval = 0.05,
  delta1 = delta1,
  HAC = FALSE
)

colnames(x_linear)[selected_linear]
Computed result

Linear inflation model, delta1 = delta2 = 1

7 of 101 candidates
\[\pi_t=c+\sum_{j\in\mathcal{S}_{\pi}}\beta_jx_{j,t}+u_t\]

\(\mathcal{S}_{\pi}\) = {AWHMAN, S&P div yield, T5YFFM, AAAFFM, DDURRG3M086SBEA, DNDGRG3M086SBEA, DSERRG3M086SBEA}

HAC option. The displayed grids use the documented default HAC = FALSE. Set HAC = TRUE for Newey-West standard errors with automatic bandwidth selection in linear, logit, or probit models.
Binary application

Persistent price movement logit

The binary response equals one when trailing smoothed annual inflation exceeds 2.5 percent. The resulting complete-case sample contains 763 observations and 101 standardized candidates.

\[PPM_t=\mathbf{1}\{\bar{\pi}^{(12)}_t>2.5\},\qquad \Pr(PPM_t=1\mid x_t)=\Lambda(\eta_t)\]
Logit selection
delta1 <- 1
target_name <- "PCEPI"
inflation <- as.numeric(fred_data[[target_name]])
candidate_names <- setdiff(names(fred_data), c("date", target_name))
x_raw <- as.matrix(fred_data[candidate_names])
storage.mode(x_raw) <- "numeric"

annual_inflation <- 100 * as.numeric(
  stats::filter(inflation, rep(1, 12), sides = 1)
)
smoothed_inflation <- as.numeric(
  stats::filter(annual_inflation, rep(1 / 12, 12), sides = 1)
)
ppm <- as.integer(smoothed_inflation > 2.5)

keep <- is.finite(ppm) & complete.cases(x_raw)
y_ppm <- ppm[keep]
x_ppm <- x_raw[keep, , drop = FALSE]
sds <- apply(x_ppm, 2, stats::sd)
x_ppm <- scale(x_ppm[, is.finite(sds) & sds > 0, drop = FALSE])

selected_ppm <- boosting_glm(
  y = y_ppm,
  X = x_ppm,
  link = "logit",
  pval = 0.05,
  delta1 = delta1
)

colnames(x_ppm)[selected_ppm]
Computed result

PPM logit model, delta1 = delta2 = 1

8 of 101 candidates
\[\Pr(PPM_t=1\mid x_t)=\Lambda(\eta_t),\qquad \eta_t=c+\sum_{j\in\mathcal{S}_{PPM}}\beta_jx_{j,t}\]

\(\mathcal{S}_{PPM}\) = {CES0600000007, AWHMAN, BUSINVx, TB3SMFFM, T1YFFM, EXCAUSx, DSERRG3M086SBEA, DTCOLNVHFNM}

Post-selection estimation

Estimate the final specifications

The logical selection vectors subset the standardized candidate matrices. The final regressions can then be estimated with the selected columns only.

Final models
inflation_data <- data.frame(
  inflation = y_linear,
  x_linear[, selected_linear, drop = FALSE],
  check.names = FALSE
)
inflation_model <- stats::lm(inflation ~ ., data = inflation_data)

ppm_data <- data.frame(
  ppm = y_ppm,
  x_ppm[, selected_ppm, drop = FALSE],
  check.names = FALSE
)
ppm_model <- stats::glm(
  ppm ~ .,
  data = ppm_data,
  family = stats::binomial("logit")
)