A34 - Aplicación del Filtro de Hodrick Prescott (HP)

library(readxl)
library(tidyverse)
library(kableExtra)
library(dplyr)
library(tidyr)
library(knitr)

Datos a ocupar.

# Datos.
raw <- read_excel("C:/Users/50372/Desktop/Fatima U/Metodos para el Analisis Economico/Tareas perido 3/tarea a34/datos_PIB_trim_CA.xlsx", col_names = FALSE)

paises <- c("Costa Rica", "El Salvador", "Guatemala",
            "Honduras", "Nicaragua", "Panama")

datos <- raw[6:nrow(raw), ]
periodos <- datos[[1]] %>% as.character()
valores <- datos[, -1]

nombres_cols <- make.names(paises, unique = TRUE)
colnames(valores) <- nombres_cols

valores[valores == "--"] <- NA
names(valores)[is.na(names(valores)) | names(valores) == ""] <-
  paste0("columna_", seq_len(sum(is.na(names(valores)) | names(valores) == "")))
valores <- valores %>% mutate(across(everything(), as.numeric))


# Data frame

final <- bind_cols(tibble(periodo = periodos), valores) %>%
pivot_longer(cols = -periodo,
names_to = "pais",
values_to = "pib") %>%
drop_na(pib) %>%
mutate(
pais = factor(pais, levels = nombres_cols),
periodo = factor(periodo, levels = unique(periodo), ordered = TRUE)
)
#Resultado

final %>% head(10) %>%
  kable("html", caption = "Primeras observaciones del PIB trimestral") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped","hover"))

Primeras observaciones del PIB trimestral

periodo	pais	pib
1990-I	El.Salvador	48.97
1990-II	El.Salvador	56.32
1990-III	El.Salvador	56.41
1990-IV	El.Salvador	59.88
1991-I	Costa.Rica	2730297.53
1991-I	El.Salvador	50.54
1991-I	Panama	43.20
1991-II	Costa.Rica	2585732.53
1991-II	El.Salvador	58.01
1991-II	Panama	40.69

Función HP manual

hp_manual <- function(y, lambda = 1600){
  
  n <- length(y)
  I <- diag(n)
  
  D <- matrix(0, n - 2, n)
  for(i in 1:(n - 2)){
    D[i, i] <- 1
    D[i, i + 1] <- -2
    D[i, i + 2] <- 1
  }
  
  trend <- solve(I + lambda * t(D) %*% D, y)
  
  tibble(trend = as.numeric(trend),
         cycle = y - trend)
}

Aplicar filtro HP por país

resultados <- final %>%
group_by(pais) %>%
arrange(periodo) %>%
mutate(id = row_number()) %>%
group_modify(~{
hp <- hp_manual(.x$pib)
bind_cols(.x, hp)
})


resultados %>% head()

## # A tibble: 6 × 6
## # Groups:   pais [1]
##   pais       periodo       pib    id    trend    cycle
##   <fct>      <ord>       <dbl> <int>    <dbl>    <dbl>
## 1 Costa.Rica 1991-I   2730298.     1 2685448.   44850.
## 2 Costa.Rica 1991-II  2585733.     2 2730747. -145015.
## 3 Costa.Rica 1991-III 2614917.     3 2776075. -161158.
## 4 Costa.Rica 1991-IV  2873790.     4 2821367.   52422.
## 5 Costa.Rica 1992-I   2966525.     5 2866462.  100063.
## 6 Costa.Rica 1992-II  2788824.     6 2911229. -122404.

Graficos

resultados %>%
  ggplot(aes(x = id)) +
  geom_line(aes(y = pib), color = "black") +
  geom_line(aes(y = trend), color = "blue") +
  facet_wrap(~pais, scales = "free_y") +
  labs(title = "Filtro HP – Versión Personalizada",
       x = "Periodo", y = "PIB / Tendencia") +
  theme_minimal()

# Representación rapida.

for(p in unique(resultados$pais)){

  sub <- resultados %>% filter(pais == p)

  if(nrow(sub) == 0) next  

  plot(sub$id, sub$pib, type = "l",
       main = paste("HP rapido –", p),
       xlab = "Periodo", ylab = "PIB",
       col = "black")

  lines(sub$id, sub$trend, col = "blue", lwd = 2)
}