Este modelo explora cómo una caída en la natalidad en familias con múltiples problemas —por aborto legal o planificación familiar— podría impactar en las tasas de crimen. Parte de lo que plantean Levitt y Dubner en Freakonomics. Simula el paso de niñxs a jóvenes, adultxs y jubiladxs, y cómo cada grupo aporta al total de crímenes según su proporción y comportamiento.

Este modelo se basa en un caso del libro de Pruyt (2013) sobre simulación en dinámica de sistemas.

A continuación se muestra el diagrama causal del modelo, donde se representan las relaciones entre las variables que determinan el comportamiento del sistema.

Este es el diagrama de stock y flujo, que muestra cómo evoluciona la población entre etapas de vida y cómo se genera el total de crímenes a lo largo del tiempo:

A continuación se presenta el modelo de dinámica de sistemas desarrollado a partir de las variables y relaciones descritas anteriormente.

install.packages("deSolve")  # si no lo tienes
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
library(deSolve)
# Parámetros
params <- list(
  t_kid = 12,         # tiempo promedio como kid
  t_young = 12,       # tiempo promedio como youngster
  t_adult = 40,       # tiempo promedio como adult
  t_retired = 15,     # tiempo promedio como retiree
  f_adult = 0.03,     # tasa de fertilidad de adultos
  f_young = 0.003,    # tasa de fertilidad de jóvenes
  c_kid = 2,          # crímenes por kid criminal
  c_young = 4,        # crímenes por youngster criminal
  c_adult = 12,       # crímenes por adult criminal
  c_retired = 4,      # crímenes por retiree criminal
  p_crime_kid = 0.05,     # % criminales en kids
  p_crime_young = 0.50,   # % criminales en youngsters
  p_crime_adult = 0.60,   # % criminales en adults
  p_crime_retired = 0.10, # % criminales en retirees
  external_crimes = 6000000  # crímenes por otros
)

# Condiciones iniciales
state <- c(
  kids = 1000000,
  young = 1000000,
  adult = 3000000,
  retired = 750000
)

# Función del modelo
model <- function(t, state, params) {
  with(as.list(c(state, params)), {
    
    # Flujos
    from_kid_to_young <- kids / t_kid
    from_young_to_adult <- young / t_young
    from_adult_to_retired <- adult / t_adult
    deaths <- retired / t_retired
    births <- adult * f_adult + young * f_young

    # Cambio en stocks
    d_kids <- births - from_kid_to_young
    d_young <- from_kid_to_young - from_young_to_adult
    d_adult <- from_young_to_adult - from_adult_to_retired
    d_retired <- from_adult_to_retired - deaths

    # Cálculo de crímenes
    crimes_by_families <- (kids * p_crime_kid * c_kid +
                           young * p_crime_young * c_young +
                           adult * p_crime_adult * c_adult +
                           retired * p_crime_retired * c_retired)

    total_crimes <- crimes_by_families + external_crimes

    return(list(c(d_kids, d_young, d_adult, d_retired),
                crimes_families = crimes_by_families,
                total_crimes = total_crimes))
  })
}
# Tiempo (en años)
times <- seq(0, 50, by = 1)

# Simulación
out <- ode(y = state, times = times, func = model, parms = params)
out <- as.data.frame(out)

# Mostrar resultados
head(out)
##   time    kids   young   adult  retired crimes_families total_crimes
## 1    0 1000000 1000000 3000000 750000.0        24000000     30000000
## 2    1 1009396 1000384 3008241 774286.8        24070759     30070759
## 3    2 1018278 1001469 3016339 797202.9        24141287     30141287
## 4    3 1026685 1003157 3024352 818836.7        24211852     30211852
## 5    4 1034656 1005364 3032328 839268.5        24282666     30282666
## 6    5 1042226 1008015 3040309 858575.6        24353905     30353905
library(ggplot2)

# Poblaciones
out_long <- reshape2::melt(out[, c("time", "kids", "young", "adult", "retired")], id.vars = "time")
ggplot(out_long, aes(x = time, y = value, color = variable)) +
  geom_line(size = 1.2) +
  labs(title = "Población por grupo de edad", y = "Población", x = "Año") +
  theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# Crímenes
ggplot(out, aes(x = time)) +
  geom_line(aes(y = total_crimes, color = "Total")) +
  geom_line(aes(y = crimes_families, color = "Familias con múltiples problemas")) +
  labs(title = "Crímenes totales vs. crímenes de familias con múltiples problemas",
       y = "Número de crímenes", x = "Año") +
  theme_minimal() +
  scale_color_manual(values = c("Total" = "red", "Familias con múltiples problemas" = "blue"))