Modelado de la dinámica de un sistema delictivo por Ximena Flores

Problema: 6.6 Gangs and Arms Races:

Dentro de esta publicacion, se demostrará como elaborar el ejercicio 6.6 Gangs and Arms Races del libro de Small System Dynamics Models for Big Issues de Erik Pruyt.

El ejercicio establece lo siguiente:

“Suppose there are two gangs, gang A and gang B. Initially, the arms stock of gang A amounts to 100% of the weapons needed to destroy gang B, and the arms stock of gang B amounts to 100% of the weapons needed to destroy gang A. The arms stock of gang A only in/decreases via the arming of gang A and the arms stock of gang B only in/decreases via the arming of gang B. Suppose that the arming of both gangs depends on an autonomous arming rate due to their intrinsic interest in arms and arming –the autonomous arming rate A and autonomous arming rate B respectively– and on an arming rate relative to the expected first order arming of the adversary, that is, the arming of gang B from the point of view of gang A without consideration of the arming of gang A and vice versa. This relative arming rate of gang A –in terms of the weapons needed to destroy gang B– then equals the product of the overassessment factor of gang B arming by gang A, the arms obsolescence rate of gang A, and this arms stock of gang B minus the arms obsolescence rate of gang A times the arms stock of gang A. The same applies to gang B: the relative arming rate of gang B –in terms of the weapons needed to destroy gang A– equals the product of the overassessment factor of gang A arming by gang B, the arms obsolescence rate of gang B and the arms stock of gang A minus the arms obsolescence rate of gang B times the arms stock of gang B. Assume that the autonomous arming rate of gang A and the autonomous arming rate of gang B are both equal to 5% of the weapons needed to destroy the other gang per month and that both arms obsolescence rates equal 10% of the weapons needed to destroy the other gang per month”. (Pruyt,2013)

Obtenemos los siguientes diagramas para dichos ejercicios:

1. Diagrama causal del problema

2. Diagrama de flujo del problema

3. Modelo del problema y comportamiento dinámico de las variables de estado:

Ya teniendo los diagramas, proseguiremos a definir las condiciones iniciales, el tiempo de simulación, las variables (estado, flujo y endógenas)

# Cargar los paquetes necesarios
library("deSolve")

## Warning: package 'deSolve' was built under R version 4.3.3

library(ggplot2)

# Establecer las condiciones iniciales de la variable de estado
inicial.conditions <- c(arms_stock_a = 1.0,
                        arms_stock_b = 1.0)

# Definir el vector de tiempos para la simulación
times <- seq(0, 100, by = 1) #simulación mensual durante 100 meses

# Definir la función del modelo
model_arms <- function(t, state, parameters) {
  with(as.list(c(state, parameters)), {
    
    #Variables auxiliares o endógenas
    relative_arming_rate_of_gang_a <- overassesment_factor_of_gang_b_arming_by_gang_a * arms_obsolescence_rate_of_gang_a * arms_stock_b - arms_obsolescence_rate_of_gang_a * arms_stock_a
    
    relative_arming_rate_of_gang_b <- overassesment_factor_of_gang_a_arming_by_gang_b * arms_obsolescence_rate_of_gang_b * arms_stock_a - arms_obsolescence_rate_of_gang_b * arms_stock_b
    
    #Variables de flujo (son las que modifican a las variables de estado)
    arming_of_gang_a <- autonomous_arming_rate_a + relative_arming_rate_of_gang_a
    arming_of_gang_b <- autonomous_arming_rate_b + relative_arming_rate_of_gang_b

    #Variable de estado (se establece su ecuación diferencial de ahí viene la "d") 
    darms_stock_gang_a <- arming_of_gang_a
    darms_stock_gang_b <- arming_of_gang_b
    
    #Devuelve los resultados de la variable de estado
    return(list(c(darms_stock_gang_a, darms_stock_gang_b), 
                 arming_of_gang_a = arming_of_gang_a,
                arming_of_gang_b = arming_of_gang_b))
  })
}

Dentro de los parametros, contemplemos estos casos:

Caso 1: El gang A sobreestima el armamento de la banda B en un 10% y la banda B evalúa correctamente el armado de la banda A. Por ende: overassessment factor of gang B arming by gang A = 110% overassessment factor of gang A arming by gang B = 100%

Caso 2: El gang A subestima el armamento de la banda B en un 50% y la banda B evalúa correctamente el armado de la banda A. Por ende: overassessment factor of gang B arming by gang A = 50% overassessment factor of gang A arming by gang B = 100%

# Definir los parámetros del modelo para el caso 1
parameters1 <- c(autonomous_arming_rate_a = 0.05,
                 autonomous_arming_rate_b = 0.05,
                 overassesment_factor_of_gang_b_arming_by_gang_a = 1.1,
                 overassesment_factor_of_gang_a_arming_by_gang_b = 1.0,
                 arms_obsolescence_rate_of_gang_a = 0.10,
                 arms_obsolescence_rate_of_gang_b = 0.10)

# Definir los parámetros del modelo para el caso 2
parameters2 <- c(autonomous_arming_rate_a = 0.05,
                 autonomous_arming_rate_b = 0.05,
                 overassesment_factor_of_gang_b_arming_by_gang_a = 0.50,
                 overassesment_factor_of_gang_a_arming_by_gang_b = 1.00,
                 arms_obsolescence_rate_of_gang_a = 0.10,
                 arms_obsolescence_rate_of_gang_b = 0.10)

# Realizar la simulación para el caso 1
out1 <- ode(
  y = inicial.conditions, #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters1,
  method = "rk4" # # Seleccionar el método de integración a utilizar en la simulación, en este caso 'rk4' (Runge-Kutta de 4to orden)
)

# Realizar la simulación para el caso 2
out2 <- ode(
  y = inicial.conditions, #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters2, #parametros
  method = "rk4" # Seleccionar el método de integración a utilizar en la simulación, en este caso 'rk4' (Runge-Kutta de 4to orden)
)

# Convertir los resultados en data frames para posteriormente graficar
out1 <- as.data.frame(out1)
out2 <- as.data.frame(out2)

# Graficar los resultados de la simulación para el caso 1
ggplot(out1, aes(x = time, y = arms_stock_a)) + geom_line() +
  labs(x = "Time", y = "Arms Stock Gang A")

ggplot(out1, aes(x = time, y = arms_stock_b)) + geom_line() +
  labs(x = "Time", y = "Arms Stock Gang B")

# Graficar los resultados de la simulación para el caso 2
ggplot(out2, aes(x = time, y = arms_stock_a)) + geom_line() +
  labs(x = "Time", y = "Arms Stock Gang A")

ggplot(out2, aes(x = time, y = arms_stock_b)) + geom_line() +
  labs(x = "Time", y = "Arms Stock Gang B")

# Combinar los resultados de ambas simulaciones en un solo dataframe
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

combined_results <- bind_rows(
  mutate(out1, Caso = "Caso 1", Gang = "Gang A"),
  mutate(out2, Caso = "Caso 2", Gang = "Gang A"),
  mutate(out1, Caso = "Caso 1", Gang = "Gang B"),
  mutate(out2, Caso = "Caso 2", Gang = "Gang B")
)

# Graficar los resultados para cada gang
ggplot(combined_results, aes(x = time, y = arms_stock_a, color = Caso, linetype = Caso)) +
  geom_line() +
  labs(x = "Tiempo", y = "Arms Stock", color = "Caso", linetype = "Caso") +
  scale_color_manual(values = c("Caso 1" = "red", "Caso 2" = "blue"), labels = c("Caso 1", "Caso 2")) +
  scale_linetype_manual(values = c("Caso 1" = "solid", "Caso 2" = "dashed"), labels = c("Caso 1", "Caso 2")) +
  facet_grid(Gang ~ .) +
  labs(title = "Resultados de la Simulación", linetype = "Caso", color = "Caso") +
  theme_minimal()

# Combinar los resultados de ambas simulaciones en un solo dataframe
library(dplyr)
combined_results <- bind_rows(
  mutate(out1, Case = "Caso 1"),
  mutate(out2, Case = "Caso 2")
)

# Graficar todos los resultados juntos
ggplot(combined_results, aes(x = time, y = arms_stock_a, color = Case, title = "Stock of gang A")) +
  geom_line() +
  labs(x = "Time", y = "Arms Stock", color = "Case", title = "Combined Simulation Results") +
  geom_line(data = combined_results, aes(x = time, y = arms_stock_b, color = Case,  title = "Stock of gang B"), linetype = "dashed") +
  labs(y = "Arms Stock")

## Warning in geom_line(data = combined_results, aes(x = time, y = arms_stock_b, :
## Ignoring unknown aesthetics: title

Explicaciones finales En este ejercicio nos encontramos con dos casos de dos pandillas armadas, gang A y gang B. En este caso, podemos observar que dependiendo de la percepción que se tenga de la otra pandilla respecto a su armameto, será la respuesta que la pandilla evaluadora tendrá. Para el primer caso, nos encontramos con que la pandilla A sobreestima el stock de armamento de la pandilla B (en un 10% concretamente), lo que por resultado cuando modelamos, nos da una gráfica creciente. Por otro lado, cuando esta misma pandilla subestima a la otra pandilla, nos encontramos con un comportamiento de la gráfica creciente como el primer caso. Sin embargo, es importante aclarar que pese a que ambas sean crecientes, presentan comportamientos diferentes derivados de la situación, por lo que a continuación se clasificarán los arquetipos que se observaron para cada gráfica:

Tipos de arquetipos que se ven dentro de la simulación

• Gang A caso 1: crecimiento exponencial - A pesar de que pareciera una recta, categorizamos como exponencial a esta gráfica debido a que presenta una de las cualidades más importantes de esta categoría, la cuál es tender hacia el infinito.

• Gang B caso 1: crecimiento exponencial - Al igual que la gráfica del Gang, presenta las mismas características.

• Gang A caso 2: crecimiento logístico - Esta presenta un comportamiento exponencial inicialmente, sin embargo, la diferncia radica que cuando nos encontramos con crecimiento logístico, nuestra gráfica llega a un punto de estabilización hasta alcanzar el nivel de equilibrio

• Gang B caso 2: estabilización por objetivo - Este es un proceso de auto-regulación debido a la interferencia de una variable auxiliar dentro del módelo

Referencia: Pruyt, E. (2013). Small System Dynamics Models for Big Issues (1.0 ed.). TU Delft Library. ISBN 978-94-6186-195-5.