Problema 6.6 del libro Small System Dynamics Models for Big Issues: Triple Jump towards Real-World Complexity de Erik Pruyt.

  1. Diagrama causal del problema

  1. Diagrama de flujo del problema

  1. Modelo 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
library(ggplot2)
library(gridExtra)


# Establecer las condiciones iniciales de la variable de estado. En este caso 1
inicial.conditions <- c(arms_stock_gang_a = 1.0,
                        arms_stock_gang_b = 1.0) #porcentaje de arms en decimal

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

# 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
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
)
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
)


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



ggplot() +
  geom_line(data = out1, aes(x = time, y = arms_stock_gang_a, color = "arms_stock_gang_a"), show.legend = TRUE) +
  geom_line(data = out2, aes(x = time, y = arms_stock_gang_b, color = "arms_stock_gang_b"), show.legend = TRUE) +
  scale_color_manual(name = "Legend", 
                     values = c("arms_stock_gang_a" = "blue", "arms_stock_gang_b" = "red"),
                     labels = c("arms_stock_gang_a" = "Blue: Arms stock of gang A", "arms_stock_gang_b" = "Red: Arms stock of gang B")) +
  labs(title = "Sobreestimación del armamento de la banda B \n y evaluación correcta del armado de la banda A",
       y = "Arms stock of gangs")

ggplot() +
  geom_line(data = out3, aes(x = time, y = arms_stock_gang_a, color = "arms_stock_gang_a"), show.legend = TRUE) +
  geom_line(data = out4, aes(x = time, y = arms_stock_gang_b, color = "arms_stock_gang_b"), show.legend = TRUE) +
  scale_color_manual(name = "Legend", 
                     values = c("arms_stock_gang_a" = "blue", "arms_stock_gang_b" = "red"),
                     labels = c("arms_stock_gang_a" = "Blue: Arms stock of gang A", "arms_stock_gang_b" = "Red: Arms stock of gang B")) +
  labs(title = "Subestimación del armamento de la banda B \n y evaluación correcta del armado de la banda A",
       y = "Arms stock of gangs")

Corriendo la primera simulación donde hay una sobreestimación del armamento de la banda B y una evaluación correcta del armado de la banda A, ambos stocks de armas de la banda A y de la banda B tienen un crecimiento lineal. Esto se debe a la sobreestimación de armas que tiene la banda A, ya que siempre que la sobreestime, el armado de la banda A crecerá como se ve en el diagrama causal, más específicamente en el “Arming loop of gang A”. Y mientras que la banda B siga estimando bien el stock de la banda A, o sea mientras siga notando correctamente que su stock está subiendo, su armado también incrementará como se ve en el diagrama causal. Si bien, ambos crecen de una manera lineal, poco a poco el arms stock de la banda A supera los de la banda B por su sobreestimación.

Ahora bien, corriendo la segunda simulación donde hay una subestimación del armamento de la banda B y una evaluación correcta del armado de la banda A, podemos ver que ahora las lineas tienen un comportamiento logarítmico. Esto se debe a que al subestimar el armamento de la banda B, el armado de la banda A no incrementa a la tasa en la que debería para poder detruir a la banda B teniendo la misma cantidad de arms stock que la B; mientras que el armamento de la banda B excede el de la A por esta subestimación de parte de la banfda A y la evaluación correcta por parte de la banda B. Eventualmente ambos empiezan a crecer más lentamente debido a la subestimación del armamento de la banda B.