¡Hola! Es un gusto tenerte por acá. En esta ocasión tendremos una inmersión en el Modelado de la Dinámica de un sistema delictivo. Para ello realizaremos el diagraba causal del caso, el Diagrama de flujo del caso y la resolución de 2 planteamientos

Caso: 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 theother gang per month.

Situaciones:

Situación A: Supongamos que la gang A sobreestima el armamento de la banda B en un 10%, es decir, que el “overassessment factor of gang B arming by gang A” es 110%, y que la banda B evalúa correctamente el armado de la banda A, es decir, el “overassessment factor of gang A arming by gang B” es 100%. Modela este sistema y simula el modelo durante un periodo de 100 meses. Describe el comportamiento que muestra la simulación y relacionalo con los ciclos de causalidad que hayas encontrado en el diagrama causal.

Situación B: Ahora supongamos que la gang A subestima el armamento de la banda B en un 50%, es decir, que el “overassessment factor of gang B arming by gang A” es 50%, y que la banda B evalúa correctamente el armado de la banda A, es decir, el “overassessment factor of gang A arming by gang B” es 100%. Haz una nueva corrida del modelo durante un periodo de 100 meses. Describe el comportamiento que muestra la simulación y relacionalo con los ciclos de causalidad que hayas encontrado en el diagrama causal.

Diagrama de causal

Sabiendo esto, modelemos el diagrama de causal.

Tenemos 3 loops, los 3 son de balanceo

Diagrama de flujo

Ahora el diagrama de flujo. Tenemos 2 variables de estado

Modelado

Ahora, hagamos el odelo del problema y comportamiento dinámico de las variables de estado

# Cargar el paquete deSolve para utilizar funciones de resolución de ecuaciones diferenciales
library("deSolve") #cada variable de estado es una ecuación diferencial
## 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_gang_a = 1.0,
                        arms_stock_gang_b = 1.0) 

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

# Definir la función del modelo. #parametros son las variables exógenas
model_arms<-function(t, state, parameters){
  with(as.list(c(state, parameters)),{
    #Variables Auxiliares o endógenas
    relative_arming_rate_a=overassesment_factor_gang_b_by_a*obsolescence_rate_a*arms_stock_gang_b-obsolescence_rate_a*arms_stock_gang_a
    relative_arming_rate_b=overassesment_factor_gang_a_by_b*obsolescence_rate_b*arms_stock_gang_a-obsolescence_rate_b*arms_stock_gang_b
    
    #Variables de flujo (son las que modifican a las variables de estado) AQUI NO VAN ds
    arming_gang_a=autonomous_arming_rate_a+relative_arming_rate_a
    arming_gang_b=autonomous_arming_rate_b+relative_arming_rate_b

    #SE EMPIEZA DE AQUI: variable de estado (se establece su ecuación diferencial de ahí viene la d SOLO AQUI SE PONE LA D para la de estado, las demas no)
    darms_stock_gang_a=arming_gang_a
    darms_stock_gang_b=arming_gang_b
    
    
#Devuelve los resultados de la variable de estado
    return(list(c(darms_stock_gang_a, darms_stock_gang_b), 
               arming_gang_a = arming_gang_a, #variables de flujo
               arming_gang_b = arming_gang_b)) #variables de flujo
  })
}

# Definir los parámetros del modelo. Estan por fuera del sistema
parameters <- c(autonomous_arming_rate_a= 0.05,
                autonomous_arming_rate_b =0.05 ,
                overassesment_factor_gang_b_by_a =1.1 ,
                overassesment_factor_gang_a_by_b =1.0 ,
                obsolescence_rate_a=0.10,
                obsolescence_rate_b=0.10)

parameters2 <- c(autonomous_arming_rate_a= 0.05,
                autonomous_arming_rate_b =0.05 ,
                overassesment_factor_gang_b_by_a =0.50 ,
                overassesment_factor_gang_a_by_b =1.00 ,
                obsolescence_rate_a=0.10,
                obsolescence_rate_b=0.10)


# Seleccionar el método de integración a utilizar en la simulación, en este caso 'rk4' (Runge-Kutta de 4to orden)
intg.method = c("rk4")

# Realizar la simulación utilizando la función 'ode' del paquete deSolve

#Outs de situación A
out1 <- ode(
  y = inicial.conditions,  #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters,
  method = intg.method
)

out2 <- ode(
  y = inicial.conditions,  #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters,
  method = intg.method
)

out1 <- as.data.frame(out1)
out2 <- as.data.frame(out2)


#Outs de situación B
out3 <- ode(
  y = inicial.conditions,  #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters2,
  method = intg.method
)


out4 <- ode(
  y = inicial.conditions,  #condiciones iniciales
  times = times, #tiempo de simulación
  func = model_arms, #función del modelo
  parms = parameters2,
  method = intg.method
)

out3 <- as.data.frame(out3)
out4 <- as.data.frame(out4)

# Graficar los resultados de la simulación

#Gráficas situación A
ggplot(out1, aes(x=time, y=arms_stock_gang_a )) + geom_line()

ggplot(out2, aes(x=time, y= arms_stock_gang_b)) + geom_line()

#Gráficas situación B
ggplot(out3, aes(x=time, y=arms_stock_gang_a )) + geom_line()

ggplot(out4, aes(x=time, y= arms_stock_gang_b)) + geom_line()

A continuación te muestro el código para plantear estas 4 gráficas en un mismo espacio.

library(gridExtra)
## Warning: package 'gridExtra' was built under R version 4.3.3
# Para la primera gráfica
plot1 <- ggplot(out1, aes(x = time, y = arms_stock_gang_a)) +
  geom_line() +
  labs(title = "Arms Stock of Gang A - Simulation 1", x = "Time", y = "Arms Stock") +
  theme_minimal()

# Para la segunda gráfica
plot2 <- ggplot(out2, aes(x = time, y = arms_stock_gang_b)) +
  geom_line() +
  labs(title = "Arms Stock of Gang B - Simulation 1", x = "Time", y = "Arms Stock") +
  theme_minimal()

# Para la tercera gráfica
plot3 <- ggplot(out3, aes(x = time, y = arms_stock_gang_a)) +
  geom_line() +
  labs(title = "Arms Stock of Gang A - Simulation 2", x = "Time", y = "Arms Stock") +
  theme_minimal()

# Para la cuarta gráfica
plot4 <- ggplot(out4, aes(x = time, y = arms_stock_gang_b)) +
  geom_line() +
  labs(title = "Arms Stock of Gang B - Simulation 2", x = "Time", y = "Arms Stock") +
  theme_minimal()

# Mostrar todas las gráficas juntas
print(grid.arrange(plot1, plot2, plot3, plot4, ncol = 2))

## TableGrob (2 x 2) "arrange": 4 grobs
##   z     cells    name           grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (1-1,2-2) arrange gtable[layout]
## 3 3 (2-2,1-1) arrange gtable[layout]
## 4 4 (2-2,2-2) arrange gtable[layout]

Interpretaciones

En cada situación, sus 2 gráficas correspondientes (de arms stock of gang a y arm stock of gang b), son muy similares entre sí mismas. Aunado a esto, entre ambas situaciones, cambiar el procentaje de overassessment factor of gang A arming by gang B y overassessment factor of gang B arming by gang A, en una reducción de aproximadamente 50% provoca que la línea de tendencia de Arms Stock de amabs gangs ya no sea casi lineal, sino que en los primeros meses en la segunda sitación aumenta mucho más rápido que en la situación A

Referencia bibliográfica: El caso planteado proviene del ejerccio 6.6 del casebook Small System Dynamics Models for Big Issues de Erik Pruyt