Resumen Ejecutivo: Este documento analiza la relación entre Bitcoin (BTC-USD) y los principales indicadores de liquidez global —M2 de EE.UU., tasa de fondos federales (Fed Funds Rate) y el índice del dólar (DXY)— utilizando datos mensuales desde enero de 2012 hasta la fecha actual. Se aplican tests de raíz unitaria, cointegración de Johansen, modelos VAR y detección de cambios estructurales mediante el procedimiento Bai-Perron.

1 Introducción y Marco Teórico

1.1 Hipótesis Central

Bitcoin, al ser un activo sin flujos de caja descontables, responde fuertemente a las condiciones de liquidez global. La teoría sugiere tres canales de transmisión:

  1. Canal de liquidez directa: Cuando los bancos centrales expanden la oferta monetaria (↑M2), el exceso de liquidez busca activos de mayor riesgo/retorno, incluyendo criptomonedas.

  2. Canal de tipo de cambio / dólar: Un dólar débil (↓DXY) refleja condiciones financieras laxas globalmente y tiende a correlacionarse positivamente con activos de riesgo como BTC.

  3. Canal de tasa de interés: Tasas bajas (↓FFR) reducen el costo de oportunidad de mantener activos sin yield y estimulan el apetito por riesgo.

1.2 Indicadores Utilizados

Variable Fuente Frecuencia Descripción
BTC-USD Yahoo Finance Mensual Precio de cierre ajustado de Bitcoin
M2SL FRED (St. Louis Fed) Mensual M2 Money Stock EE.UU. (miles de millones USD)
FEDFUNDS FRED Mensual Tasa efectiva de fondos federales (%)
DXY Yahoo Finance Mensual Índice del Dólar Americano

2 Recolección y Preparación de Datos

2.1 Descarga de Datos

# ─── Fechas ────────────────────────────────────────────────────────────────
fecha_inicio <- as.Date("2012-01-01")
fecha_fin    <- Sys.Date()

# ─── BTC desde Yahoo Finance ───────────────────────────────────────────────
getSymbols("BTC-USD", src = "yahoo",
           from = fecha_inicio, to = fecha_fin,
           auto.assign = TRUE)
## [1] "BTC-USD"
btc_raw     <- `BTC-USD`[, 6]          # Adjusted Close
btc_mensual <- to.monthly(btc_raw, indexAt = "lastof", OHLC = FALSE)
colnames(btc_mensual) <- "BTC"

# ─── DXY desde Yahoo Finance ──────────────────────────────────────────────
getSymbols("DX-Y.NYB", src = "yahoo",
           from = fecha_inicio, to = fecha_fin,
           auto.assign = TRUE)
## [1] "DX-Y.NYB"
dxy_raw     <- `DX-Y.NYB`[, 6]
dxy_mensual <- to.monthly(dxy_raw, indexAt = "lastof", OHLC = FALSE)
colnames(dxy_mensual) <- "DXY"

# ─── FRED: descarga directa vía CSV público (sin API key) ─────────────────
# FRED ofrece descarga en CSV a través de una URL pública estable.
# No requiere registro ni API key.

descargar_fred <- function(serie_id, col_nombre) {
  url <- paste0(
    "https://fred.stlouisfed.org/graph/fredgraph.csv?id=", serie_id
  )
  tmp <- tempfile(fileext = ".csv")
  
  tryCatch({
    download.file(url, destfile = tmp, quiet = TRUE, mode = "wb")
    raw <- read.csv(tmp, stringsAsFactors = FALSE)
    colnames(raw) <- c("fecha", col_nombre)
    raw$fecha      <- as.Date(raw$fecha)
    raw[[col_nombre]] <- suppressWarnings(as.numeric(raw[[col_nombre]]))
    raw <- raw[!is.na(raw$fecha) & raw$fecha >= fecha_inicio, ]
    raw
  }, error = function(e) {
    stop(paste0("Error descargando ", serie_id, " desde FRED: ", e$message))
  })
}

m2_df  <- descargar_fred("M2SL",     "M2")
ffr_df <- descargar_fred("FEDFUNDS", "FFR")

# Convertir a xts mensual (último día del mes)
df_a_xts_mensual <- function(df_fred, col) {
  xts_obj <- xts(df_fred[[col]], order.by = df_fred$fecha)
  to.monthly(xts_obj, indexAt = "lastof", OHLC = FALSE)
}

m2_mensual  <- df_a_xts_mensual(m2_df,  "M2")
ffr_mensual <- df_a_xts_mensual(ffr_df, "FFR")
colnames(m2_mensual)  <- "M2"
colnames(ffr_mensual) <- "FFR"

# ─── Fusión de series ──────────────────────────────────────────────────────
datos <- merge(btc_mensual, m2_mensual, dxy_mensual, ffr_mensual, join = "inner")
datos <- na.omit(datos)

df <- data.frame(
  fecha = as.Date(index(datos)),
  BTC   = as.numeric(datos$BTC),
  M2    = as.numeric(datos$M2),
  DXY   = as.numeric(datos$DXY),
  FFR   = as.numeric(datos$FFR)
)

cat(sprintf("✔ Datos disponibles: %d observaciones mensuales\n", nrow(df)))
## ✔ Datos disponibles: 141 observaciones mensuales
cat(sprintf("  Período: %s → %s\n",
            format(min(df$fecha), "%b %Y"),
            format(max(df$fecha), "%b %Y")))
##   Período: Sep 2014 → May 2026
cat(sprintf("  BTC rango: $%s — $%s\n",
            scales::comma(min(df$BTC, na.rm = TRUE), accuracy = 1),
            scales::comma(max(df$BTC, na.rm = TRUE), accuracy = 1)))
##   BTC rango: $217 — $115,758

2.2 Vista Previa de los Datos

df %>%
  slice(c(1:5, (n()-4):n())) %>%
  mutate(
    fecha = format(fecha, "%b %Y"),
    BTC   = scales::dollar(BTC, accuracy = 1),
    M2    = scales::comma(M2, accuracy = 1),
    DXY   = round(DXY, 2),
    FFR   = paste0(round(FFR, 2), "%")
  ) %>%
  kbl(
    caption = "Primeras y últimas 5 observaciones del panel de datos",
    col.names = c("Fecha", "BTC (USD)", "M2 (Bn USD)", "DXY", "Fed Funds Rate"),
    align = c("l", "r", "r", "r", "r")
  ) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Primeras y últimas 5 observaciones del panel de datos
Fecha BTC (USD) M2 (Bn USD) DXY Fed Funds Rate
Sep 2014 $387 11,519 85.94 0.09%
Oct 2014 $338 11,593 86.88 0.09%
Nov 2014 $378 11,634 88.36 0.09%
Dec 2014 $320 11,718 90.27 0.12%
Jan 2015 $217 11,805 94.80 0.11%
Jan 2026 $78,621 22,429 96.99 3.64%
Feb 2026 $66,996 22,627 97.61 3.64%
Mar 2026 $68,233 22,686 99.96 3.64%
Apr 2026 $76,304 22,804 98.08 3.64%
May 2026 $73,580 23,052 98.91 3.63%

3 Análisis Exploratorio

3.1 Evolución de las Series en Niveles

# BTC
p1 <- ggplot(df, aes(fecha, BTC)) +
  geom_area(fill = col_btc, alpha = 0.25) +
  geom_line(color = col_btc, linewidth = 0.8) +
  scale_y_continuous(labels = scales::dollar_format(scale = 1e-3, suffix = "k")) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(title = "Bitcoin (BTC-USD)", y = "Precio USD", x = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", color = col_dark))

# M2
p2 <- ggplot(df, aes(fecha, M2)) +
  geom_area(fill = col_m2, alpha = 0.25) +
  geom_line(color = col_m2, linewidth = 0.8) +
  scale_y_continuous(labels = scales::comma_format(scale = 1e-3, suffix = "T")) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(title = "M2 Money Supply EE.UU.", y = "Billones USD", x = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", color = col_dark))

# DXY
p3 <- ggplot(df, aes(fecha, DXY)) +
  geom_area(fill = col_dxy, alpha = 0.25) +
  geom_line(color = col_dxy, linewidth = 0.8) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(title = "Índice del Dólar (DXY)", y = "Nivel", x = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", color = col_dark))

# FFR
p4 <- ggplot(df, aes(fecha, FFR)) +
  geom_area(fill = col_ffr, alpha = 0.25) +
  geom_line(color = col_ffr, linewidth = 0.8) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(title = "Fed Funds Rate", y = "%", x = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", color = col_dark))

(p1 + p2) / (p3 + p4) +
  plot_annotation(
    title = "Series en Niveles: Bitcoin e Indicadores de Liquidez (2012–2025)",
    subtitle = "Datos mensuales • Fuentes: Yahoo Finance, FRED",
    theme = theme(plot.title = element_text(face = "bold", size = 13),
                  plot.subtitle = element_text(color = "gray50"))
  )

3.2 Estadísticas Descriptivas

stats_df <- df %>%
  dplyr::select(-fecha) %>%
  summarise(across(everything(), list(
    Media    = ~mean(.x, na.rm = TRUE),
    Mediana  = ~median(.x, na.rm = TRUE),
    Desv.Std = ~sd(.x, na.rm = TRUE),
    Min      = ~min(.x, na.rm = TRUE),
    Max      = ~max(.x, na.rm = TRUE),
    Asimetría= ~(mean(.x^3) - 3*mean(.x)*mean(.x^2) + 2*mean(.x)^3) /
                 sd(.x)^3
  ), .names = "{.col}_{.fn}")) %>%
  pivot_longer(everything(), names_to = c("Variable", "Estadístico"),
               names_sep = "_", values_to = "Valor") %>%
  pivot_wider(names_from = "Estadístico", values_from = "Valor")

stats_df %>%
  mutate(across(where(is.numeric), ~round(.x, 2))) %>%
  kbl(caption = "Estadísticas Descriptivas de las Series en Niveles") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") %>%
  row_spec(1, background = "#fff3e0")
Estadísticas Descriptivas de las Series en Niveles
Variable Media Mediana Desv.Std Min Max Asimetría
BTC 28512.19 11323.47 32107.35 217.46 115758.20 1.12
M2 17424.65 18335.40 3926.56 11519.10 23052.30 -0.09
DXY 98.07 97.48 5.04 85.94 112.12 0.30
FFR 2.01 1.51 1.91 0.05 5.33 0.55

3.3 Transformación Logarítmica y Retornos

df <- df %>%
  mutate(
    lBTC  = log(BTC),
    lM2   = log(M2),
    lDXY  = log(DXY),
    # FFR no se transforma log (puede ser 0 o negativa)
    # Usamos primera diferencia para FFR
    dFFR  = c(NA, diff(FFR)),
    # Log-retornos mensuales
    rBTC  = c(NA, diff(lBTC)),
    rM2   = c(NA, diff(lM2)),
    rDXY  = c(NA, diff(lDXY))
  )

df_ret <- df %>% filter(!is.na(rBTC))

3.4 Matriz de Correlación (Log-Niveles)

df_cor <- df %>%
  dplyr::select(lBTC, lM2, lDXY, FFR) %>%
  na.omit()

cor_mat <- cor(df_cor)
rownames(cor_mat) <- colnames(cor_mat) <- c("ln(BTC)", "ln(M2)", "ln(DXY)", "FFR")

corrplot(cor_mat,
         method    = "color",
         type      = "upper",
         addCoef.col = "black",
         tl.col    = col_dark,
         tl.srt    = 45,
         col       = colorRampPalette(c("#2980B9", "white", "#E74C3C"))(200),
         title     = "Correlación entre Variables (Log-Niveles)",
         mar       = c(0, 0, 2, 0))

3.5 Correlación Rolling de 24 Meses

ventana <- 24   # 24 meses

df_roll <- df %>%
  filter(!is.na(lBTC), !is.na(lM2), !is.na(lDXY)) %>%
  mutate(
    cor_btc_m2  = slider::slide_dbl(
      .x = seq_len(n()),
      .f = ~cor(lBTC[.x], lM2[.x]),
      .before = ventana - 1, .complete = TRUE
    ),
    cor_btc_dxy = slider::slide_dbl(
      .x = seq_len(n()),
      .f = ~cor(lBTC[.x], lDXY[.x]),
      .before = ventana - 1, .complete = TRUE
    ),
    cor_btc_ffr = slider::slide_dbl(
      .x = seq_len(n()),
      .f = ~cor(lBTC[.x], FFR[.x]),
      .before = ventana - 1, .complete = TRUE
    )
  )

df_roll_long <- df_roll %>%
  dplyr::select(fecha, cor_btc_m2, cor_btc_dxy, cor_btc_ffr) %>%
  pivot_longer(-fecha, names_to = "Par", values_to = "Correlacion") %>%
  filter(!is.na(Correlacion)) %>%
  mutate(Par = recode(Par,
    cor_btc_m2  = "BTC ~ ln(M2)",
    cor_btc_dxy = "BTC ~ ln(DXY)",
    cor_btc_ffr = "BTC ~ FFR"
  ))

ggplot(df_roll_long, aes(fecha, Correlacion, color = Par)) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray60") +
  geom_line(linewidth = 0.9, alpha = 0.85) +
  scale_color_manual(values = c(col_m2, col_dxy, col_ffr)) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  scale_y_continuous(limits = c(-1, 1), breaks = seq(-1, 1, 0.25)) +
  labs(
    title    = "Correlación Rolling (24 meses) entre BTC e Indicadores de Liquidez",
    subtitle = "Correlación de Pearson calculada sobre ventanas de 24 meses • Log-niveles",
    x = NULL, y = "Correlación", color = NULL
  ) +
  theme_minimal(base_size = 11) +
  theme(
    legend.position  = "top",
    axis.text.x      = element_text(angle = 45, hjust = 1),
    plot.title       = element_text(face = "bold"),
    plot.subtitle    = element_text(color = "gray50")
  )

4 Tests de Raíz Unitaria

Antes de cualquier regresión con series de tiempo, es imprescindible determinar el orden de integración de cada variable. Usamos el test ADF (Augmented Dickey-Fuller), PP (Phillips-Perron) y KPSS.

4.1 Tests ADF y PP en Niveles

series_niveles <- list(
  "ln(BTC)"  = df$lBTC,
  "ln(M2)"   = df$lM2,
  "ln(DXY)"  = df$lDXY,
  "FFR"      = df$FFR
)

run_adf <- function(x, nombre) {
  x <- na.omit(x)
  adf_nc <- adf.test(x, alternative = "stationary", k = trunc((length(x)-1)^(1/3)))
  pp_res  <- pp.test(x)
  kpss_r  <- kpss.test(x, null = "Level")

  data.frame(
    Variable   = nombre,
    `ADF p-val`= round(adf_nc$p.value, 4),
    `PP p-val` = round(pp_res$p.value,  4),
    `KPSS p-val`= round(kpss_r$p.value, 4),
    `I(1)?`    = ifelse(adf_nc$p.value > 0.05 & pp_res$p.value > 0.05, "✔ Sí", "✗ No"),
    check.names = FALSE
  )
}

tabla_ur <- bind_rows(lapply(names(series_niveles),
                              function(nm) run_adf(series_niveles[[nm]], nm)))

tabla_ur %>%
  kbl(caption = "Tests de Raíz Unitaria en Niveles (H₀: raíz unitaria)") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") %>%
  column_spec(5, bold = TRUE,
              color = ifelse(tabla_ur$`I(1)?` == "✔ Sí", "#27ae60", "#e74c3c"))
Tests de Raíz Unitaria en Niveles (H₀: raíz unitaria)
Variable ADF p-val PP p-val KPSS p-val I(1)?
ln(BTC) 0.5448 0.7022 0.01 ✔ Sí
ln(M2) 0.6923 0.9656 0.01 ✔ Sí
ln(DXY) 0.2897 0.0914 0.01 ✔ Sí
FFR 0.1849 0.8837 0.01 ✔ Sí

4.2 Tests en Primeras Diferencias

series_diff <- list(
  "Δln(BTC)"  = diff(na.omit(df$lBTC)),
  "Δln(M2)"   = diff(na.omit(df$lM2)),
  "Δln(DXY)"  = diff(na.omit(df$lDXY)),
  "ΔFFR"      = diff(na.omit(df$FFR))
)

tabla_ur2 <- bind_rows(lapply(names(series_diff),
                               function(nm) run_adf(series_diff[[nm]], nm)))

tabla_ur2 %>%
  kbl(caption = "Tests de Raíz Unitaria en Primeras Diferencias") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") %>%
  column_spec(5, bold = TRUE,
              color = ifelse(tabla_ur2$`I(1)?` == "✗ No", "#27ae60", "#e74c3c"))
Tests de Raíz Unitaria en Primeras Diferencias
Variable ADF p-val PP p-val KPSS p-val I(1)?
Δln(BTC) 0.0100 0.01 0.1 ✗ No
Δln(M2) 0.2498 0.01 0.1 ✗ No
Δln(DXY) 0.0100 0.01 0.1 ✗ No
ΔFFR 0.3353 0.01 0.1 ✗ No

Conclusión: Si las variables son I(1), procedemos con el test de cointegración de Johansen. Si las series son estacionarias (I(0)), usaremos un VAR en niveles o regresión con variables de control.

5 Test de Cointegración de Johansen

# Preparar matriz de series I(1) en log-niveles
mat_coint <- df %>%
  dplyr::select(lBTC, lM2, lDXY, FFR) %>%
  na.omit() %>%
  as.matrix()

# Test Johansen — traza y máximo eigenvalor
jo_traza <- ca.jo(mat_coint, type = "trace", ecdet = "const", K = 2, spec = "longrun")
jo_eigen <- ca.jo(mat_coint, type = "eigen", ecdet = "const", K = 2, spec = "longrun")

cat("═══════════════════════════════════════════════════════\n")
## ═══════════════════════════════════════════════════════
cat("  TEST DE JOHANSEN — Estadístico de Traza\n")
##   TEST DE JOHANSEN — Estadístico de Traza
cat("═══════════════════════════════════════════════════════\n")
## ═══════════════════════════════════════════════════════
summary(jo_traza)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: trace statistic , without linear trend and constant in cointegration 
## 
## Eigenvalues (lambda):
## [1] 2.581299e-01 1.688903e-01 4.844627e-02 3.026983e-02 2.736482e-16
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 3 |  4.27  7.52  9.24 12.97
## r <= 2 | 11.18 17.85 19.96 24.60
## r <= 1 | 36.89 32.00 34.91 41.07
## r = 0  | 78.39 49.65 53.12 60.16
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##              lBTC.l2      lM2.l2     lDXY.l2     FFR.l2   constant
## lBTC.l2     1.000000   1.0000000  1.00000000   1.000000   1.000000
## lM2.l2      2.448323  -7.1001546 -7.97158129   9.395797 -28.167858
## lDXY.l2   128.957452  30.6584717  0.56402519 -21.824099  32.278050
## FFR.l2     -5.758827  -0.5697243 -0.02796923  -2.143234  -1.730825
## constant -599.764483 -79.7767335 66.14164172   3.243854 119.378908
## 
## Weights W:
## (This is the loading matrix)
## 
##              lBTC.l2        lM2.l2       lDXY.l2        FFR.l2      constant
## lBTC.d  2.126619e-03 -0.0275218818 -0.0345990622 -6.130080e-03 -3.651390e-15
## lM2.d   2.271961e-04 -0.0004371179  0.0008623370 -2.752531e-05  7.627546e-17
## lDXY.d -8.765885e-05 -0.0065281794 -0.0002290602  4.820851e-04 -5.952865e-16
## FFR.d   1.827425e-03  0.0214380949 -0.0306735494  2.601253e-03 -4.492808e-16
cat("\n═══════════════════════════════════════════════════════\n")
## 
## ═══════════════════════════════════════════════════════
cat("  TEST DE JOHANSEN — Máximo Eigenvalor\n")
##   TEST DE JOHANSEN — Máximo Eigenvalor
cat("═══════════════════════════════════════════════════════\n")
## ═══════════════════════════════════════════════════════
summary(jo_eigen)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: maximal eigenvalue statistic (lambda max) , without linear trend and constant in cointegration 
## 
## Eigenvalues (lambda):
## [1] 2.581299e-01 1.688903e-01 4.844627e-02 3.026983e-02 2.736482e-16
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 3 |  4.27  7.52  9.24 12.97
## r <= 2 |  6.90 13.75 15.67 20.20
## r <= 1 | 25.71 19.77 22.00 26.81
## r = 0  | 41.50 25.56 28.14 33.24
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##              lBTC.l2      lM2.l2     lDXY.l2     FFR.l2   constant
## lBTC.l2     1.000000   1.0000000  1.00000000   1.000000   1.000000
## lM2.l2      2.448323  -7.1001546 -7.97158129   9.395797 -28.167858
## lDXY.l2   128.957452  30.6584717  0.56402519 -21.824099  32.278050
## FFR.l2     -5.758827  -0.5697243 -0.02796923  -2.143234  -1.730825
## constant -599.764483 -79.7767335 66.14164172   3.243854 119.378908
## 
## Weights W:
## (This is the loading matrix)
## 
##              lBTC.l2        lM2.l2       lDXY.l2        FFR.l2      constant
## lBTC.d  2.126619e-03 -0.0275218818 -0.0345990622 -6.130080e-03 -3.651390e-15
## lM2.d   2.271961e-04 -0.0004371179  0.0008623370 -2.752531e-05  7.627546e-17
## lDXY.d -8.765885e-05 -0.0065281794 -0.0002290602  4.820851e-04 -5.952865e-16
## FFR.d   1.827425e-03  0.0214380949 -0.0306735494  2.601253e-03 -4.492808e-16

Interpretación: Si existe al menos una relación de cointegración (r ≥ 1), las variables comparten una tendencia estocástica común de largo plazo. En ese caso, estimamos un VECM (Vector Error Correction Model). Si no hay cointegración, usamos un VAR en diferencias.

6 Detección de Cambios Estructurales (Bai-Perron)

El precio de BTC ha experimentado burbujas, crashes y halvings. El test de Bai-Perron detecta cambios estructurales en la relación BTC ~ liquidez, permitiendo identificar regímenes distintos.

6.1 Breakpoints en la Serie de BTC

btc_ts <- ts(df$lBTC, start = c(year(min(df$fecha)), month(min(df$fecha))), frequency = 12)

# Modelo OLS base: ln(BTC) ~ ln(M2) + ln(DXY) + FFR
df_bp <- df %>% dplyr::select(lBTC, lM2, lDXY, FFR) %>% na.omit()

bp_model <- breakpoints(lBTC ~ lM2 + lDXY + FFR, data = df_bp, h = 12)

cat("Número óptimo de breakpoints (BIC):\n")
## Número óptimo de breakpoints (BIC):
print(summary(bp_model))
## 
##   Optimal (m+1)-segment partition: 
## 
## Call:
## breakpoints.formula(formula = lBTC ~ lM2 + lDXY + FFR, h = 12, 
##     data = df_bp)
## 
## Breakpoints at observation number:
##                                          
## m = 1          42                        
## m = 2          37                 113    
## m = 3          37       75        113    
## m = 4          37 56    75        113    
## m = 5          37 56    75    102     125
## m = 6          37 56    75 87 110     125
## m = 7       25 39 56    75 87 110     125
## m = 8    13 29 41 56    75 87 110     125
## m = 9    13 29 41 56 68 80 94 110     125
## m = 10   13 29 41 56 68 80 93 105 117 129
## 
## Corresponding to breakdates:
##                                                                
## m = 1                                         0.297872340425532
## m = 2                                         0.26241134751773 
## m = 3                                         0.26241134751773 
## m = 4                                         0.26241134751773 
## m = 5                                         0.26241134751773 
## m = 6                                         0.26241134751773 
## m = 7                       0.177304964539007 0.276595744680851
## m = 8    0.0921985815602837 0.205673758865248 0.290780141843972
## m = 9    0.0921985815602837 0.205673758865248 0.290780141843972
## m = 10   0.0921985815602837 0.205673758865248 0.290780141843972
##                                                               
## m = 1                                                         
## m = 2                                                         
## m = 3                                        0.531914893617021
## m = 4    0.397163120567376                   0.531914893617021
## m = 5    0.397163120567376                   0.531914893617021
## m = 6    0.397163120567376                   0.531914893617021
## m = 7    0.397163120567376                   0.531914893617021
## m = 8    0.397163120567376                   0.531914893617021
## m = 9    0.397163120567376 0.482269503546099 0.567375886524823
## m = 10   0.397163120567376 0.482269503546099 0.567375886524823
##                                                               
## m = 1                                                         
## m = 2                                        0.801418439716312
## m = 3                                        0.801418439716312
## m = 4                                        0.801418439716312
## m = 5                      0.723404255319149                  
## m = 6    0.617021276595745 0.780141843971631                  
## m = 7    0.617021276595745 0.780141843971631                  
## m = 8    0.617021276595745 0.780141843971631                  
## m = 9    0.666666666666667 0.780141843971631                  
## m = 10   0.659574468085106 0.74468085106383  0.829787234042553
##                           
## m = 1                     
## m = 2                     
## m = 3                     
## m = 4                     
## m = 5    0.886524822695036
## m = 6    0.886524822695036
## m = 7    0.886524822695036
## m = 8    0.886524822695036
## m = 9    0.886524822695036
## m = 10   0.914893617021277
## 
## Fit:
##                                                                            
## m   0       1       2       3       4       5       6       7       8      
## RSS  47.838  18.191  10.232   7.479   5.345   4.043   3.252   2.650   2.131
## BIC 272.471 160.881 104.499  85.040  62.414  47.817  41.848  37.737  31.747
##                    
## m   9       10     
## RSS   1.774   1.868
## BIC  30.627  62.628
# Fechas de los breakpoints
bp_dates <- df_bp %>%
  slice(bp_model$breakpoints) %>%
  pull() %>%
  { df$fecha[bp_model$breakpoints] }

cat("\nFechas estimadas de cambios estructurales:\n")
## 
## Fechas estimadas de cambios estructurales:
print(format(bp_dates, "%B %Y"))
## [1] "September 2015" "January 2017"   "January 2018"   "April 2019"    
## [5] "April 2020"     "April 2021"     "June 2022"      "October 2023"  
## [9] "January 2025"
# Gráfico con breakpoints
plot(bp_model, main = "Cambios Estructurales: ln(BTC) ~ Liquidez")

6.2 Visualización de Regímenes

# Asignar régimen a cada observación
df_reg <- df %>% na.omit()

if (!is.null(bp_model$breakpoints) && !any(is.na(bp_model$breakpoints))) {
  bp_idx <- bp_model$breakpoints
  df_reg$Regimen <- cut(
    seq_len(nrow(df_reg)),
    breaks = c(0, bp_idx, nrow(df_reg)),
    labels = paste0("Régimen ", seq_along(c(bp_idx, nrow(df_reg))))
  )
} else {
  df_reg$Regimen <- "Régimen 1"
}

ggplot(df_reg, aes(fecha, BTC, color = Regimen, group = 1)) +
  geom_line(linewidth = 0.8) +
  geom_vline(xintercept = as.numeric(bp_dates), linetype = "dashed",
             color = "#E74C3C", linewidth = 0.7) +
  scale_y_log10(labels = scales::dollar_format()) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  scale_color_brewer(palette = "Set2") +
  labs(
    title    = "Bitcoin con Cambios Estructurales Detectados (Bai-Perron)",
    subtitle = "Escala logarítmica | Líneas rojas = breakpoints estimados",
    x = NULL, y = "Precio BTC (USD, log)", color = "Régimen"
  ) +
  theme_minimal(base_size = 11) +
  theme(
    axis.text.x    = element_text(angle = 45, hjust = 1),
    plot.title     = element_text(face = "bold"),
    legend.position = "top"
  )

7 Modelo Econométrico: Regresión con Cambios Estructurales

7.1 Modelo OLS Lineal (Serie Completa)

modelo_base <- lm(lBTC ~ lM2 + lDXY + FFR, data = df_reg)
summary(modelo_base)
## 
## Call:
## lm(formula = lBTC ~ lM2 + lDXY + FFR, data = df_reg)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.20799 -0.47584  0.01668  0.39955  1.46718 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -17.43127    6.22797  -2.799  0.00587 ** 
## lM2           7.42650    0.26723  27.791  < 2e-16 ***
## lDXY        -10.09252    1.33049  -7.586 4.69e-12 ***
## FFR           0.25773    0.03798   6.785 3.26e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5856 on 136 degrees of freedom
## Multiple R-squared:  0.9079, Adjusted R-squared:  0.9059 
## F-statistic:   447 on 3 and 136 DF,  p-value: < 2.2e-16

7.2 Coeficientes con IC y Errores Robustos (HAC)

# Errores estándar HAC (Newey-West) para corregir autocorrelación y heterocedasticidad
coef_hac <- coeftest(modelo_base, vcov = NeweyWest(modelo_base, lag = 4))

coef_df <- data.frame(
  Variable     = rownames(coef_hac),
  Coeficiente  = round(coef_hac[, 1], 4),
  `Error Std.` = round(coef_hac[, 2], 4),
  `t-stat`     = round(coef_hac[, 3], 3),
  `p-valor`    = round(coef_hac[, 4], 4),
  Significancia = ifelse(coef_hac[, 4] < 0.001, "***",
                  ifelse(coef_hac[, 4] < 0.01,  "**",
                  ifelse(coef_hac[, 4] < 0.05,  "*",
                  ifelse(coef_hac[, 4] < 0.10,  ".",  "")))),
  check.names = FALSE
)

coef_df %>%
  kbl(caption = "Modelo OLS — ln(BTC) ~ ln(M2) + ln(DXY) + FFR | Errores HAC (Newey-West, lag=4)") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") %>%
  column_spec(6, bold = TRUE)
Modelo OLS — ln(BTC) ~ ln(M2) + ln(DXY) + FFR | Errores HAC (Newey-West, lag=4)
Variable Coeficiente Error Std. t-stat p-valor Significancia
(Intercept) (Intercept) -17.4313 13.7660 -1.266 0.2076
lM2 lM2 7.4265 0.6433 11.544 0.0000 ***
lDXY lDXY -10.0925 2.5356 -3.980 0.0001 ***
FFR FFR 0.2577 0.0863 2.986 0.0033 **

7.3 Modelos por Régimen Estructural

if (length(unique(df_reg$Regimen)) > 1) {
  resultados <- df_reg %>%
    group_by(Regimen) %>%
    group_map(~ {
      if (nrow(.x) >= 10) {
        m  <- lm(lBTC ~ lM2 + lDXY + FFR, data = .x)
        ch <- coeftest(m, vcov = NeweyWest(m))
        data.frame(
          Regimen      = unique(.y$Regimen),
          N            = nrow(.x),
          R2           = round(summary(m)$r.squared, 3),
          β_lM2        = round(ch["lM2",  "Estimate"], 3),
          β_lDXY       = round(ch["lDXY", "Estimate"], 3),
          β_FFR        = round(ch["FFR",  "Estimate"], 3),
          p_lM2        = round(ch["lM2",  "Pr(>|t|)"], 4),
          p_lDXY       = round(ch["lDXY", "Pr(>|t|)"], 4),
          p_FFR        = round(ch["FFR",  "Pr(>|t|)"], 4)
        )
      }
    }) %>%
    bind_rows()

  resultados %>%
    kbl(caption = "Coeficientes por Régimen Estructural (errores HAC)") %>%
    kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
    row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
} else {
  cat("Solo se detectó un régimen. Ver modelo base arriba.")
}
Coeficientes por Régimen Estructural (errores HAC)
Regimen N R2 β_lM2 β_lDXY β_FFR p_lM2 p_lDXY p_FFR
Régimen 1 13 0.650 9.259 -4.901 -6.058 0.0008 0.0031 0.0346
Régimen 2 16 0.916 10.338 2.411 0.423 0.0069 0.0165 0.5479
Régimen 3 12 0.960 83.204 -8.161 -2.186 0.0000 0.0964 0.0449
Régimen 4 15 0.684 26.912 8.674 -2.467 0.2620 0.3994 0.1544
Régimen 5 12 0.666 6.009 -1.400 0.475 0.0000 0.4862 0.0000
Régimen 6 12 0.885 25.313 6.659 26.713 0.0484 0.6256 0.4644
Régimen 7 14 0.763 6.352 -4.519 -0.276 0.1377 0.1148 0.0229
Régimen 8 16 0.762 -19.435 0.513 -0.095 0.0099 0.7045 0.3418
Régimen 9 15 0.856 19.433 5.143 0.236 0.0002 0.0000 0.0522
Régimen 10 15 0.771 2.128 -3.152 0.640 0.3198 0.0033 0.0014

8 Modelo VAR

El modelo VAR captura las interdependencias dinámicas entre BTC y los indicadores de liquidez, permitiendo calcular funciones de impulso-respuesta (IRF) y descomposición de varianza.

8.1 Selección del Orden del VAR

df_var <- df %>%
  dplyr::select(lBTC, lM2, lDXY, FFR) %>%
  na.omit()

# Selección de rezagos
lag_sel <- VARselect(df_var, lag.max = 12, type = "const")

lag_tabla <- data.frame(
  Criterio = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)"),
  `Rezagos óptimos` = as.integer(lag_sel$selection),
  check.names = FALSE
)

lag_tabla %>%
  kbl(caption = "Selección del Número de Rezagos para el VAR") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE, position = "left") %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Selección del Número de Rezagos para el VAR
Criterio Rezagos óptimos
AIC(n) 3
HQ(n) 3
SC(n) 2
FPE(n) 3 
p_opt <- min(lag_sel$selection["SC(n)"], 4)   # BIC/SC penaliza más; máx 4 rezagos
cat(sprintf("\nRezago seleccionado: p = %d\n", p_opt))
## 
## Rezago seleccionado: p = 2

8.2 Estimación del VAR

modelo_var <- VAR(df_var, p = p_opt, type = "const")
cat("Resumen del VAR:\n")
## Resumen del VAR:
summary(modelo_var, equation = "lBTC")
## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: lBTC, lM2, lDXY, FFR 
## Deterministic variables: const 
## Sample size: 139 
## Log Likelihood: 1050.802 
## Roots of the characteristic polynomial:
## 0.9948 0.9548 0.9548 0.6881 0.5836 0.487 0.1956 0.1956
## Call:
## VAR(y = df_var, p = p_opt, type = "const")
## 
## 
## Estimation results for equation lBTC: 
## ===================================== 
## lBTC = lBTC.l1 + lM2.l1 + lDXY.l1 + FFR.l1 + lBTC.l2 + lM2.l2 + lDXY.l2 + FFR.l2 + const 
## 
##         Estimate Std. Error t value Pr(>|t|)    
## lBTC.l1  1.08148    0.08685  12.453   <2e-16 ***
## lM2.l1   1.05802    2.83231   0.374   0.7093    
## lDXY.l1 -0.35930    0.89934  -0.400   0.6902    
## FFR.l1  -0.14567    0.12840  -1.134   0.2587    
## lBTC.l2 -0.14760    0.08665  -1.704   0.0909 .  
## lM2.l2  -0.63919    2.83311  -0.226   0.8219    
## lDXY.l2 -0.09596    0.90497  -0.106   0.9157    
## FFR.l2   0.16321    0.12255   1.332   0.1853    
## const   -1.38819    2.29634  -0.605   0.5466    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.1918 on 130 degrees of freedom
## Multiple R-Squared: 0.9903,  Adjusted R-squared: 0.9897 
## F-statistic:  1666 on 8 and 130 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##            lBTC        lM2       lDXY        FFR
## lBTC  3.680e-02  2.508e-06 -5.869e-04 -3.885e-05
## lM2   2.508e-06  2.372e-05  3.267e-07 -2.240e-04
## lDXY -5.869e-04  3.267e-07  3.502e-04 -5.567e-05
## FFR  -3.885e-05 -2.240e-04 -5.567e-05  1.614e-02
## 
## Correlation matrix of residuals:
##           lBTC       lM2      lDXY       FFR
## lBTC  1.000000  0.002685 -0.163507 -0.001594
## lM2   0.002685  1.000000  0.003584 -0.361967
## lDXY -0.163507  0.003584  1.000000 -0.023418
## FFR  -0.001594 -0.361967 -0.023418  1.000000

8.3 Funciones de Impulso-Respuesta (IRF)

# IRF: impacto de M2, DXY y FFR sobre BTC
irf_m2  <- irf(modelo_var, impulse = "lM2",  response = "lBTC", n.ahead = 24, boot = TRUE)
irf_dxy <- irf(modelo_var, impulse = "lDXY", response = "lBTC", n.ahead = 24, boot = TRUE)
irf_ffr <- irf(modelo_var, impulse = "FFR",  response = "lBTC", n.ahead = 24, boot = TRUE)

# Función para extraer y graficar IRF
plot_irf <- function(irf_obj, titulo, color_line) {
  meses <- 0:24
  resp  <- as.numeric(irf_obj$irf[[1]])
  lower <- as.numeric(irf_obj$Lower[[1]])
  upper <- as.numeric(irf_obj$Upper[[1]])

  ggplot(data.frame(mes = meses, resp, lower, upper), aes(x = mes)) +
    geom_ribbon(aes(ymin = lower, ymax = upper), fill = color_line, alpha = 0.2) +
    geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
    geom_line(aes(y = resp), color = color_line, linewidth = 1) +
    labs(title = titulo, x = "Meses", y = "Respuesta ln(BTC)") +
    theme_minimal(base_size = 10) +
    theme(plot.title = element_text(face = "bold", size = 10))
}

p_irf1 <- plot_irf(irf_m2,  "Respuesta de BTC ante shock en ln(M2)",  col_m2)
p_irf2 <- plot_irf(irf_dxy, "Respuesta de BTC ante shock en ln(DXY)", col_dxy)
p_irf3 <- plot_irf(irf_ffr, "Respuesta de BTC ante shock en FFR",     col_ffr)

(p_irf1 / p_irf2 / p_irf3) +
  plot_annotation(
    title    = "Funciones de Impulso-Respuesta (IRF) — VAR",
    subtitle = "Horizonte de 24 meses | Bandas de confianza al 95% (bootstrap)",
    theme    = theme(plot.title = element_text(face = "bold"),
                     plot.subtitle = element_text(color = "gray50"))
  )

8.4 Descomposición de Varianza (FEVD)

fevd_res <- fevd(modelo_var, n.ahead = 24)
fevd_btc <- as.data.frame(fevd_res$lBTC)
fevd_btc$Horizonte <- 1:24

fevd_long <- pivot_longer(fevd_btc, -Horizonte,
                           names_to = "Variable", values_to = "Contribucion")

ggplot(fevd_long, aes(Horizonte, Contribucion, fill = Variable)) +
  geom_area(alpha = 0.85) +
  scale_fill_manual(values = c(col_btc, col_m2, col_dxy, col_ffr),
                    labels  = c("ln(BTC)", "ln(M2)", "ln(DXY)", "FFR")) +
  scale_y_continuous(labels = scales::percent_format()) +
  scale_x_continuous(breaks = c(1, 6, 12, 18, 24)) +
  labs(
    title    = "Descomposición de Varianza del Error de Pronóstico (FEVD) — ln(BTC)",
    subtitle = "Contribución de cada variable al error de pronóstico de BTC",
    x = "Horizonte (meses)", y = "% de la Varianza Explicada", fill = "Variable"
  ) +
  theme_minimal(base_size = 11) +
  theme(plot.title = element_text(face = "bold"),
        legend.position = "top")

9 Causalidad de Granger

granger_tests <- list(
  "M2  → BTC"  = grangertest(lBTC ~ lM2,  order = p_opt, data = df_var),
  "DXY → BTC"  = grangertest(lBTC ~ lDXY, order = p_opt, data = df_var),
  "FFR → BTC"  = grangertest(lBTC ~ FFR,  order = p_opt, data = df_var),
  "BTC → M2"   = grangertest(lM2  ~ lBTC, order = p_opt, data = df_var),
  "BTC → DXY"  = grangertest(lDXY ~ lBTC, order = p_opt, data = df_var),
  "BTC → FFR"  = grangertest(FFR  ~ lBTC, order = p_opt, data = df_var)
)

granger_df <- lapply(names(granger_tests), function(nm) {
  g <- granger_tests[[nm]]
  data.frame(
    `Hipótesis`    = nm,
    `F-stat`       = round(g[2, "F"], 3),
    `p-valor`      = round(g[2, "Pr(>F)"], 4),
    `Conclusión`   = ifelse(g[2, "Pr(>F)"] < 0.05, "✔ Causalidad detectada", "✗ Sin evidencia"),
    check.names    = FALSE
  )
}) %>% bind_rows()

granger_df %>%
  kbl(caption = paste0("Test de Causalidad de Granger (rezagos = ", p_opt, ")")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") %>%
  column_spec(4, bold = TRUE,
              color = ifelse(granger_df$`Conclusión` == "✔ Causalidad detectada",
                             "#27ae60", "#e74c3c"))
Test de Causalidad de Granger (rezagos = 2)
Hipótesis F-stat p-valor Conclusión
M2 → BTC 0.974 0.3803 ✗ Sin evidencia
DXY → BTC 0.036 0.9642 ✗ Sin evidencia
FFR → BTC 1.387 0.2533 ✗ Sin evidencia
BTC → M2 1.321 0.2703 ✗ Sin evidencia
BTC → DXY 0.389 0.6787 ✗ Sin evidencia
BTC → FFR 0.637 0.5303 ✗ Sin evidencia

10 Diagnóstico del Modelo

10.1 Residuales del Modelo OLS

df_reg$residuales <- residuals(modelo_base)
df_reg$fitted_val <- fitted(modelo_base)

pd1 <- ggplot(df_reg, aes(fecha, residuales)) +
  geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
  geom_line(color = col_dark, alpha = 0.7) +
  labs(title = "Residuales en el Tiempo", x = NULL, y = "Residual") +
  theme_minimal(base_size = 10)

pd2 <- ggplot(df_reg, aes(fitted_val, residuales)) +
  geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
  geom_point(alpha = 0.5, color = col_m2) +
  geom_smooth(se = FALSE, color = "red", linewidth = 0.6) +
  labs(title = "Residuales vs Valores Ajustados", x = "Valores Ajustados", y = "Residual") +
  theme_minimal(base_size = 10)

pd3 <- ggplot(df_reg, aes(sample = residuales)) +
  stat_qq(color = col_m2, alpha = 0.6) +
  stat_qq_line(color = "red") +
  labs(title = "QQ-Plot de Residuales") +
  theme_minimal(base_size = 10)

acf_data <- acf(df_reg$residuales, plot = FALSE)
acf_df   <- data.frame(lag = acf_data$lag[-1], acf = acf_data$acf[-1])
pd4 <- ggplot(acf_df, aes(lag, acf)) +
  geom_col(fill = col_m2, alpha = 0.7, width = 0.4) +
  geom_hline(yintercept = c(-1.96/sqrt(nrow(df_reg)), 1.96/sqrt(nrow(df_reg))),
             linetype = "dashed", color = "red") +
  labs(title = "ACF de Residuales", x = "Rezago", y = "Autocorrelación") +
  theme_minimal(base_size = 10)

(pd1 + pd2) / (pd3 + pd4) +
  plot_annotation(title = "Diagnóstico de Residuales — Modelo OLS Base",
                  theme = theme(plot.title = element_text(face = "bold")))

10.2 Tests Formales de Diagnóstico

# Breusch-Godfrey (autocorrelación), Breusch-Pagan (heterocedasticidad)
bg_test <- bgtest(modelo_base, order = 4)
bp_test <- bptest(modelo_base)
jb_test <- jarque.bera.test(residuals(modelo_base))

diag_df <- data.frame(
  Test         = c("Breusch-Godfrey (autocorrelación)", 
                   "Breusch-Pagan (heterocedasticidad)",
                   "Jarque-Bera (normalidad)"),
  Estadístico  = round(c(bg_test$statistic, bp_test$statistic, jb_test$statistic), 3),
  `p-valor`    = round(c(bg_test$p.value,   bp_test$p.value,  jb_test$p.value), 4),
  Resultado    = c(
    ifelse(bg_test$p.value < 0.05, "⚠ Autocorrelación presente", "✔ Sin autocorrelación"),
    ifelse(bp_test$p.value < 0.05, "⚠ Heterocedasticidad presente", "✔ Homocedástico"),
    ifelse(jb_test$p.value < 0.05, "⚠ No normalidad", "✔ Normal")
  ),
  check.names = FALSE
)

diag_df %>%
  kbl(caption = "Tests de Diagnóstico del Modelo OLS") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tests de Diagnóstico del Modelo OLS
Test Estadístico p-valor Resultado
LM test Breusch-Godfrey (autocorrelación) 110.494 0.0000 ⚠ Autocorrelación presente
BP Breusch-Pagan (heterocedasticidad) 29.011 0.0000 ⚠ Heterocedasticidad presente
X-squared Jarque-Bera (normalidad) 3.154 0.2066 ✔ Normal

11 Conclusiones

11.1 Hallazgos Principales

1. Relación M2 → BTC (Canal de Liquidez): La expansión de la oferta monetaria M2 de EE.UU. muestra una relación positiva y altamente significativa con el precio de Bitcoin (β = +7.43, p < 0.001). Un aumento del 1% en M2 se asocia con un incremento aproximado de 7.4% en el precio de BTC en el largo plazo. Este resultado es robusto a la corrección HAC y es consistente con la hipótesis de que el exceso de liquidez monetaria fluye hacia activos de mayor riesgo/retorno como Bitcoin.

2. DXY y BTC (Canal del Dólar): El índice del dólar (DXY) muestra una relación negativa y significativa con BTC (β = −10.09, p < 0.001 con errores HAC): cuando el dólar se fortalece, BTC tiende a depreciarse. Esto es consistente con el comportamiento de activos de riesgo globales bajo condiciones de risk-off, donde la fortaleza del dólar refleja contracción de liquidez internacional.

3. Fed Funds Rate — resultado contraintuitivo: El coeficiente estimado de la FFR fue positivo (β = +0.26, p = 0.003), contrario a la hipótesis inicial de efecto negativo. Este resultado refleja que, en la muestra completa (2014–2026), los períodos de tasas moderadamente altas (2015–2018) coincidieron con el primer gran ciclo alcista de BTC, impulsado por adopción tecnológica más que por liquidez. La relación negativa esperada se captura mejor dentro de regímenes específicos (ver Sección 7.3, Régimen 1 donde β_FFR = −6.06) y en las IRF del VAR, que muestran respuesta negativa de BTC ante shocks en FFR. Conclusión: el efecto de la tasa varía por régimen y no es estable en el tiempo.

4. Cambios Estructurales: El procedimiento Bai-Perron detectó 9 breakpoints con fechas económicamente coherentes: Sep-2015 (pre-halving), Ene-2017 y Ene-2018 (burbuja ICO y crash), Abr-2019, Abr-2020 (halving + QE COVID), Abr-2021 (ATH pre-crash), Jun-2022 (colapso Terra/Luna + alzas Fed), Oct-2023 y Ene-2025 (aprobación ETF spot + rally post-elecciones). Los coeficientes varían sustancialmente por régimen (β_lM2 oscila entre −19.4 y +83.2), confirmando que la relación BTC-liquidez no es estable en el tiempo y que el análisis de serie completa subestima esta heterogeneidad.

5. Causalidad de Granger — sin evidencia de causalidad de corto plazo: Los tests de Granger con 2 rezagos no detectaron causalidad estadística en ninguna dirección (todos los p-valores > 0.25). Esto significa que, a horizonte de 1-2 meses, los movimientos rezagados de M2, DXY o FFR no predicen linealmente el precio de BTC, y viceversa. Sin embargo, este resultado no contradice la cointegración de Johansen (Sección 5), que confirmó al menos 2 relaciones de largo plazo. La interpretación correcta es: la liquidez y BTC comparten tendencias de largo plazo (cointegración), pero los shocks mensuales de corto plazo no se transmiten de forma predecible en ventanas de 1-2 meses. Las IRF del VAR sugieren que el impacto de un shock en M2 sobre BTC tarda entre 6 y 12 meses en materializarse plenamente.

11.2 Limitaciones

  • Los datos de M2 y FFR son de EE.UU.; una medida de liquidez global (e.g., suma de balances de bancos centrales G4: Fed + BCE + BoJ + PBoC) podría mejorar la especificación y capturar mejor los flujos de capital hacia criptoactivos.
  • La muestra efectiva comienza en Sep-2014 (no 2012) debido a la disponibilidad de datos de BTC en Yahoo Finance, lo que limita la observación de los primeros ciclos del activo.
  • Los 9 breakpoints detectados dejan regímenes con apenas 12-16 observaciones cada uno, reduciendo la potencia estadística de las regresiones por régimen.
  • No se consideran variables de sentimiento (Google Trends, Fear & Greed Index, métricas on-chain como hash rate o direcciones activas) que también impulsan el precio independientemente de la liquidez macro.
  • La presencia de autocorrelación severa (BG = 110.49) y heterocedasticidad (BP = 29.01) en el modelo OLS, aunque corregidas con errores HAC, sugiere que un VECM (dado que existe cointegración) o un modelo GARCH-en-media serían especificaciones más eficientes como extensión de este trabajo.

12 Información de Sesión

cat(format(Sys.time(), "Análisis ejecutado: %Y-%m-%d %H:%M:%S\n"))
## Análisis ejecutado: 2026-06-30 16:25:39
sessionInfo()
## R version 4.4.2 (2024-10-31)
## Platform: x86_64-apple-darwin20
## Running under: macOS Sonoma 14.8.7
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Santo_Domingo
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] jsonlite_2.0.0             httr_1.4.8                
##  [3] slider_0.3.3               PerformanceAnalytics_2.1.0
##  [5] forecast_9.0.2             kableExtra_1.4.0          
##  [7] corrplot_0.95              scales_1.4.0              
##  [9] patchwork_1.3.2            vars_1.6-1                
## [11] lmtest_0.9-40              strucchange_1.5-4         
## [13] sandwich_3.1-1             MASS_7.3-65               
## [15] urca_1.3-4                 tseries_0.10-61           
## [17] lubridate_1.9.5            forcats_1.0.1             
## [19] stringr_1.6.0              dplyr_1.2.1               
## [21] purrr_1.2.2                readr_2.2.0               
## [23] tidyr_1.3.2                tibble_3.3.1              
## [25] ggplot2_4.0.3              tidyverse_2.0.0           
## [27] quantmod_0.4.28            TTR_0.24.4                
## [29] xts_0.14.2                 zoo_1.8-15                
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6       xfun_0.57          bslib_0.11.0       lattice_0.22-9    
##  [5] tzdb_0.5.0         quadprog_1.5-8     vctrs_0.7.3        tools_4.4.2       
##  [9] generics_0.1.4     parallel_4.4.2     curl_7.1.0         pkgconfig_2.0.3   
## [13] Matrix_1.7-5       RColorBrewer_1.1-3 S7_0.2.2           lifecycle_1.0.5   
## [17] compiler_4.4.2     farver_2.1.2       textshaping_1.0.5  htmltools_0.5.9   
## [21] sass_0.4.10        yaml_2.3.12        pillar_1.11.1      jquerylib_0.1.4   
## [25] cachem_1.1.0       nlme_3.1-169       fracdiff_1.5-4     tidyselect_1.2.1  
## [29] digest_0.6.39      stringi_1.8.7      splines_4.4.2      labeling_0.4.3    
## [33] fastmap_1.2.0      grid_4.4.2         colorspace_2.1-2   cli_3.6.6         
## [37] magrittr_2.0.5     withr_3.0.2        warp_0.2.3         timechange_0.4.0  
## [41] rmarkdown_2.31     otel_0.2.0         timeDate_4052.112  hms_1.1.4         
## [45] evaluate_1.0.5     knitr_1.51         viridisLite_0.4.3  mgcv_1.9-4        
## [49] rlang_1.2.0        Rcpp_1.1.1-1.1     glue_1.8.1         xml2_1.5.2        
## [53] svglite_2.2.2      rstudioapi_0.18.0  R6_2.6.1           systemfonts_1.3.2

Documento generado con R Markdown • Datos: Yahoo Finance & FRED (Federal Reserve Bank of St. Louis)