Guía rápida: Los chunks marcados con (GRÁFICO) generan figuras. El resto prepara datos/funciones/tablas.

Objetivo

Comparar el desempeño del índice Laspeyres de base fija y del Laspeyres encadenado bajo distintos escenarios de inflación y cambios en precios/cantidades.
El benchmark es un “volumen verdadero” construido solo con cantidades.
La métrica de comparación es el RMSE de crecimientos logarítmicos.

Setup

Funciones rápidas (matriciales)

# Índices sobre matrices Q (cantidades) y P (precios)

idx_volumen_verdadero <- function(Q){
  base <- sum(Q[,1]); 100 * colSums(Q) / base
}

idx_laspeyres_fijo <- function(Q, P){
  p0 <- P[,1]; base <- sum(Q[,1] * p0); 100 * colSums(Q * p0) / base
}

idx_laspeyres_encadenado <- function(Q, P){
  Tt <- ncol(Q); idx <- numeric(Tt); idx[1] <- 100
  for(t in 2:Tt){
    num <- sum(Q[,t]   * P[,t-1])   # V_t a precios t-1
    den <- sum(Q[,t-1] * P[,t-1])   # V_{t-1} a precios t-1
    idx[t] <- idx[t-1] * (num/den)
  }
  idx
}

rmse_diff_log_growth <- function(idxA, idxB){
  gA <- diff(log(idxA)); gB <- diff(log(idxB)); sqrt(mean((gA - gB)^2))
}

# Simulador de cantidades y precios (rápido y liviano)
simular_QP_mat <- function(
  S=5, years=2022:2030,
  qty0=c(100,200,400,120,180),
  price0=c(1000,50,30,80,20),
  mu_qty=c(0.03,0.02,0.025,0.015,0.02),
  sd_qty=c(0.05,0.04,0.04,0.03,0.04),
  mu_inflacion=0.10,
  rel_price_drift=c(0.05,-0.03,0,0.02,-0.01),
  sd_price=c(0.05,0.04,0.04,0.04,0.04),
  shock_prob=0.10, shock_mean=-0.10, shock_sd=0.06
){
  Tt <- length(years)
  Q <- matrix(NA_real_, S, Tt); P <- matrix(NA_real_, S, Tt)
  Q[,1] <- qty0; P[,1] <- price0
  for(t in 2:Tt){
    gq <- rnorm(S, mu_qty, sd_qty)
    shocks <- rbinom(S, 1, shock_prob)
    gq <- gq + shocks * rnorm(S, shock_mean, shock_sd)
    Q[,t] <- pmax(Q[,t-1]*(1+gq), .Machine$double.eps)

    gp <- rnorm(S, mu_inflacion + rel_price_drift, sd_price)
    P[,t] <- pmax(P[,t-1]*(1+gp), .Machine$double.eps)
  }
  list(Q=Q, P=P, years=years)
}

# Evaluación Monte Carlo en grid de inflaciones
evaluar_corte_fast <- function(
  inflaciones=c(seq(0,0.5,0.05),0.75,1,1.5,2,3,5),
  R=200, years=2022:2030, rel_price_drift, seed=123
){
  set.seed(seed)
  out <- matrix(NA_real_, length(inflaciones), 3)
  colnames(out) <- c("inflacion","rmse_fix","rmse_ch")
  out[,1] <- inflaciones

  for(i in seq_along(inflaciones)){
    mu_inf <- inflaciones[i]; err_fix <- err_ch <- 0
    for(r in 1:R){
      sim <- simular_QP_mat(years=years, mu_inflacion=mu_inf,
                            rel_price_drift=rel_price_drift)
      V <- idx_volumen_verdadero(sim$Q)
      Lf<- idx_laspeyres_fijo(sim$Q, sim$P)
      Lc<- idx_laspeyres_encadenado(sim$Q, sim$P)
      err_fix <- err_fix + rmse_diff_log_growth(Lf, V)
      err_ch  <- err_ch  + rmse_diff_log_growth(Lc, V)
    }
    out[i,2] <- err_fix/R; out[i,3] <- err_ch/R
  }
  tab <- as.data.frame(out)
  tab$mejor <- ifelse(tab$rmse_ch < tab$rmse_fix, "Encadenado","Laspeyres fijo")
  tab$inflacion_pct <- 100*tab$inflacion
  tab
}

Escenario A — Inflación con drift de precios relativos (encadenado suele perder)

tabla <- evaluar_corte_fast(
  inflaciones = c(seq(0,0.50,0.05), 0.75, 1.00, 1.50, 2.00, 3.00, 5.00),
  R = 200, years = 2022:2030,
  rel_price_drift = c(0.08,-0.05,0.00,0.03,-0.02)
)
# Solo mostramos columnas numéricas redondeadas
tabla_print <- within(tabla, {
  inflacion     <- round(inflacion, 3)
  inflacion_pct <- round(inflacion_pct, 1)
  rmse_fix      <- round(rmse_fix, 4)
  rmse_ch       <- round(rmse_ch, 4)
})
tabla_print
# (GRÁFICO) RMSE vs Inflación
plot(tabla$inflacion_pct, tabla$rmse_ch, type="b", pch=19,
     ylim=range(c(tabla$rmse_ch, tabla$rmse_fix)),
     xlab="Inflación anual (%)", ylab="RMSE de crecimientos log",
     main="Error vs Inflación — con drift de precios relativos")
lines(tabla$inflacion_pct, tabla$rmse_fix, type="b", pch=17)
legend("topleft", legend=c("Encadenado","Laspeyres fijo"),
       pch=c(19,17), lty=1, bty="n")

# (GRÁFICO) Diferencia de error: Encadenado - Fijo (negativo = mejor Encadenado)
plot(tabla$inflacion_pct, tabla$rmse_ch - tabla$rmse_fix, type="b", pch=19,
     xlab="Inflación anual (%)", ylab="ΔRMSE (Encadenado - Fijo)",
     main="Diferencia de error (negativo = mejor Encadenado)")
abline(h=0, lty=2)

# Punto de corte donde conviene Fijo (si existe)
candidatas <- subset(tabla, rmse_fix <= rmse_ch)
if(nrow(candidatas)==0){
  corte_txt_a <- "En todo el rango, el Encadenado tuvo menor error."
} else {
  corte <- candidatas[which.min(candidatas$inflacion), ]
  corte_txt_a <- sprintf("Corte ≈ %.0f%% anual: desde ahí conviene Laspeyres fijo.",
                         100*corte$inflacion)
}
corte_txt_a
## [1] "Corte ≈ 0% anual: desde ahí conviene Laspeyres fijo."

Escenario B — Inflación sin drift (precios suben parejo por sector)

tabla_no_drift <- evaluar_corte_fast(
  inflaciones = c(seq(0,0.50,0.05), 0.75, 1.00, 1.50, 2.00, 3.00, 5.00),
  R = 200, years = 2022:2030,
  rel_price_drift = c(0,0,0,0,0)
)
# Resumen de quién gana
table(tabla_no_drift$mejor)
## 
##     Encadenado Laspeyres fijo 
##             10              7
# (GRÁFICO) ΔRMSE (Encadenado - Fijo): negativo = mejor Encadenado
plot(tabla_no_drift$inflacion_pct, tabla_no_drift$rmse_ch - tabla_no_drift$rmse_fix,
     type="b", pch=19, xlab="Inflación anual (%)",
     ylab="ΔRMSE (negativo = mejor Encadenado)",
     main="Sin drift de precios relativos")
abline(h=0, lty=2)

Escenario C — Quiebre estructural en cantidades (encadenado se adapta mejor)

set.seed(1)
years <- 2022:2031; Tt <- length(years); S <- 3
Q <- matrix(NA_real_, S, Tt); P <- matrix(NA_real_, S, Tt)
colnames(Q) <- colnames(P) <- years; rownames(Q) <- rownames(P) <- c("Comp","Mesas","Sillas")

# Precios: suben 40% anual parejo (sin drift)
P[,1] <- c(1000, 50, 30)
for(t in 2:Tt) P[,t] <- P[,t-1] * 1.40

# Cantidades: "Comp" acelera desde 2027
Q[,1] <- c(100, 200, 300)
for(t in 2:Tt){
  g <- c(0.02, 0.01, 0.015)
  if (years[t] >= 2027) g[1] <- 0.15
  Q[,t] <- Q[,t-1] * (1 + g)
}

V <- idx_volumen_verdadero(Q)
Lf<- idx_laspeyres_fijo(Q, P)
Lc<- idx_laspeyres_encadenado(Q, P)

c(RMSE_fijo=rmse_diff_log_growth(Lf, V),
  RMSE_enc=rmse_diff_log_growth(Lc, V))
##  RMSE_fijo   RMSE_enc 
## 0.06228775 0.06228775
# (GRÁFICO) Índices
plot(years, V, type="l", lwd=2, xlab="Año", ylab="Índice (base=100)",
     main="Quiebre en cantidades, precios sin drift")
lines(years, Lf, lwd=2, lty=2)
lines(years, Lc, lwd=2, lty=3)
legend("topleft", c("Volumen verdadero","Laspeyres fijo","Encadenado"),
       lty=c(1,2,3), lwd=2, bty="n")

Conclusiones

Guía práctica:
- Hiperinflación + drift → preferir Laspeyres fijo y rebases más frecuentes.
- Inflación baja/moderada o precios relativos estables con cambios de cantidades → encadenado.