M1. Actividad 5. Modelado de la Dinámica del Envejecimiento Social

library(deSolve)
library(ggplot2)
library(tidyr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggpubr)

PARÁMETROS DEL MODELO

parameters <- c(
  avg_birth_rate_per_adult  = 0.02,   # 20 niños / 1000 adultos / año = 0.02
  avg_childhood_period      = 22,     # años promedio en etapa infantil
  avg_adult_period          = 40,     # años promedio en etapa adulta
  avg_retiree_period        = 20,     # años promedio en etapa de retiro
  adult_participation_ratio = 0.50    # 50% de adultos en mercado laboral
)

CONDICIONES INICIALES (stocks)

initial_state <- c(
  Children = 4,   # millones
  Adults   = 9,   # millones
  Retirees = 3    # millones
)

ECUACIONES DIFERENCIALES (modelo)

aging_model <- function(time, state, parameters) {
  with(as.list(c(state, parameters)), {
 
    # ---- FLUJOS (Rates / Flows) ----
 
    # Births: generados por adultos
    births <- avg_birth_rate_per_adult * Adults
 
    # Maturing: niños que se convierten en adultos
    maturing <- Children / avg_childhood_period
 
    # Retirement: adultos que se jubilan
    retirement <- Adults / avg_adult_period
 
    # Death: sólo jubilados fallecen
    death <- Retirees / avg_retiree_period
 
    # ---- VARIABLES AUXILIARES ----
 
    # Mercado laboral (depende de adult_participation_ratio)
    adults_on_labor_mkt     <- Adults * adult_participation_ratio
    adults_not_on_labor_mkt <- Adults * (1 - adult_participation_ratio)
 
    # Población inactiva = children + adultos fuera del mercado + retirees
    inactive_population <- Children + adults_not_on_labor_mkt + Retirees
 
    # Carga por adulto activo = inactivos / activos en mercado
    burden_per_active_adult <- if (adults_on_labor_mkt > 0)
      inactive_population / adults_on_labor_mkt
    else NA
 
    # Presión gris = fracción de retirees sobre adults (Pruyt, p. 93)
    grey_pressure <- if (Adults > 0)
      Retirees / Adults
    else NA
 
    # ---- ECUACIONES DIFERENCIALES (dStock/dt) ----
 
    dChildren <- births   - maturing      # mortalidad infantil = 0
    dAdults   <- maturing - retirement    # mortalidad adultos   = 0
    dRetirees <- retirement - death
 
    # ---- SALIDA ----
    list(
      c(dChildren, dAdults, dRetirees),
 
      # Flujos
      births                  = births,
      maturing                = maturing,
      retirement              = retirement,
      death                   = death,
 
      # Auxiliares
      adults_on_labor_mkt     = adults_on_labor_mkt,
      adults_not_on_labor_mkt = adults_not_on_labor_mkt,
      inactive_population     = inactive_population,
      burden_per_active_adult = burden_per_active_adult,
      grey_pressure           = grey_pressure
    )
  })
}

HORIZONTE DE SIMULACIÓN

START <- 2010
END   <- 2210
STEP  <- 0.5
 
time_seq <- seq(from = START, to = END, by = STEP)

SOLUCIÓN NUMÉRICA (método RK4 por defecto en ode())

output <- ode(
  y      = initial_state,
  times  = time_seq,
  func   = aging_model,
  parms  = parameters,
  method = "rk4"
)
 
results <- as.data.frame(output)
names(results)[1] <- "Year"   # renombrar "time" → "Year"

VISUALIZACIÓN

pal <- c(Children = "#1565C0", Adults = "#2E7D32", Retirees = "#C62828")
 
# 6a — Stocks
p_stocks <- results %>%
  select(Year, Children, Adults, Retirees) %>%
  pivot_longer(-Year, names_to = "Stock", values_to = "Millones") %>%
  ggplot(aes(Year, Millones, color = Stock)) +
  geom_line(linewidth = 1.2) +
  scale_color_manual(values = pal) +
  labs(title    = "Stocks: Children · Adults · Retirees",
       subtitle = "Mortalidad cero para Children y Adults | Pruyt (2013)",
       x = "Año", y = "Población (millones)", color = NULL) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")
 

# Paleta de colores
col_children  <- "#1565C0"
col_adults    <- "#2E7D32"
col_retirees  <- "#C62828"
col_burden    <- "#6A1B9A"
col_grey      <- "#E65100"
 
# --- 6a. Stocks a lo largo del tiempo ---
stocks_long <- results %>%
  select(Year, Children, Adults, Retirees) %>%
  pivot_longer(-Year, names_to = "Stock", values_to = "Population_M")
 
p1 <- ggplot(stocks_long, aes(x = Year, y = Population_M, color = Stock)) +
  geom_line(linewidth = 1.2) +
  scale_color_manual(values = c(
    Children = col_children,
    Adults   = col_adults,
    Retirees = col_retirees
  )) +
  labs(
    title    = "Cadena de Envejecimiento Poblacional (2010–2210)",
    subtitle = "Stocks: Children, Adults, Retirees | Mortalidad cero para Children y Adults",
    x        = "Año",
    y        = "Población (millones)",
    color    = "Stock"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")
 
print(p1)

# --- 6b. Indicadores de presión ---
p2 <- results %>%
  select(Year, burden_per_active_adult, grey_pressure) %>%
  pivot_longer(-Year, names_to = "Indicator", values_to = "Value") %>%
  ggplot(aes(x = Year, y = Value, color = Indicator)) +
  geom_line(linewidth = 1.2) +
  scale_color_manual(
    values = c(
      burden_per_active_adult = col_burden,
      grey_pressure           = col_grey
    ),
    labels = c(
      burden_per_active_adult = "Carga por adulto activo (inactivos/activos)",
      grey_pressure           = "Presión gris (Retirees/Adults)"
    )
  ) +
  labs(
    title    = "Indicadores de Presión Demográfica",
    x        = "Año",
    y        = "Ratio",
    color    = "Indicador"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")
 
print(p2)

# --- 6c. Flujos ---
p3 <- results %>%
  select(Year, births, maturing, retirement, death) %>%
  pivot_longer(-Year, names_to = "Flow", values_to = "Rate_M") %>%
  ggplot(aes(x = Year, y = Rate_M, color = Flow)) +
  geom_line(linewidth = 1) +
  scale_color_manual(values = c(
    births     = col_children,
    maturing   = col_adults,
    retirement = col_grey,
    death      = col_retirees
  )) +
  labs(
    title  = "Flujos del Sistema (millones de personas/año)",
    x      = "Año",
    y      = "Tasa (millones/año)",
    color  = "Flujo"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")
 
print(p3)

RESUMEN ESTADÍSTICO

# ggsave("stocks.png",   plot = p1, width = 10, height = 6, dpi = 300)
# ggsave("pressure.png", plot = p2, width = 10, height = 6, dpi = 300)
# ggsave("flows.png",    plot = p3, width = 10, height = 6, dpi = 300)

RESUMEN ESTADÍSTICO

cat("\n=== Condiciones iniciales (2010) ===\n")

## 
## === Condiciones iniciales (2010) ===

init_row <- head(results, 1)
cat(sprintf("  Children              : %.2f M\n", init_row$Children))

##   Children              : 4.00 M

cat(sprintf("  Adults                : %.2f M\n", init_row$Adults))

##   Adults                : 9.00 M

cat(sprintf("  Retirees              : %.2f M\n", init_row$Retirees))

##   Retirees              : 3.00 M

cat(sprintf("  Presión gris          : %.3f  (%.1f%%)\n",
            init_row$grey_pressure, init_row$grey_pressure * 100))

##   Presión gris          : 0.333  (33.3%)

cat(sprintf("  Carga por activo      : %.3f\n", init_row$burden_per_active_adult))

##   Carga por activo      : 2.556

cat("\n=== Estado final (2210) ===\n")

## 
## === Estado final (2210) ===

final <- tail(results, 1)
cat(sprintf("  Children              : %.2f M\n", final$Children))

##   Children              : 2.12 M

cat(sprintf("  Adults                : %.2f M\n", final$Adults))

##   Adults                : 4.47 M

cat(sprintf("  Retirees              : %.2f M\n", final$Retirees))

##   Retirees              : 2.40 M

cat(sprintf("  Población total       : %.2f M\n",
            final$Children + final$Adults + final$Retirees))

##   Población total       : 8.99 M

cat(sprintf("  Carga por activo      : %.3f\n", final$burden_per_active_adult))

##   Carga por activo      : 3.024

cat(sprintf("  Presión gris          : %.3f  (%.1f%%)\n",
            final$grey_pressure, final$grey_pressure * 100))

##   Presión gris          : 0.536  (53.6%)

ANEXOS

CONCLUSIONES

Los delays en este sistema funcionan como un “freno”: el tiempo que tarda un niño en crecer (22 años) y un adulto en jubilarse (40 años) impide que el sistema responda de inmediato a los cambios. Esto significa que si hoy hay una baja en la natalidad, la falta de trabajadores no se notará mañana, sino dentro de dos décadas. Para esta problemática, el efecto de los delays es negativo porque oculta las crisis en formación; cuando la “grey pressure” o la carga por adulto activo se vuelven críticas, las soluciones que se tomen hoy tardarán otros 20 años en surtir efecto, dejando al sistema atrapado en una crisis de sostenibilidad difícil de corregir a corto plazo.

Para suavizar este efecto, una política efectiva sería la promoción de la inmigración selectiva de jóvenes profesionales. Esta medida permite “saltarse” el delay del crecimiento natural, inyectando adultos directamente en el mercado laboral y equilibrando la proporción entre trabajadores y dependientes de forma casi inmediata. Otra opción es la inversión en automatización y productividad tecnológica, lo cual permite que, aunque haya menos adultos trabajando debido a los retrasos demográficos, cada uno de ellos genere la riqueza suficiente para sostener a la población inactiva sin que la “burden per active adult” colapse la economía.

M1. Actividad 5. Modelado de la Dinámica del Envejecimiento Social

Ana Camila Norzagaray Garcia

2026-04-07