Este problema se extrae del libro ‘Small System Dynamics Models for Big Issues: Triple Jump towards Real-World Complexity’ de Erik Pruyt. Demuestra la dinámica entre dos grupos criminales y su almanecimiento de armas.

1. Diagrama causal del problema

2. Diagrama de flujo del problema

Escenario 1

# Cargar el paquete deSolve para utilizar funciones de resolución de ecuaciones diferenciales
library("deSolve")

# Establecer las condiciones iniciales de la variable de estado
inicial.conditions <- c(arms.stock.a = 100/100, #ES SOBRE 100 PORQUE ES PORCENTAJE
                        arms.stock.b = 100/100) #ES ASI PORQUE ES PORCENTAGE

# Definir el vector de tiempos para la simulación
times <- seq(0,100, by = 1) #EMPIEZA EN O, SON 100 MESES, Y SE VA POR CADA MES

# Definir la función del modelo
model_arms <- function(t,state, parameters){
  with(as.list(c(state, parameters)),{
    #Variables auxiliares o endogenas
    relative.armingrate.A = overassesment.factor.gangB.bygangA * arms.obsolensce.gang.A * arms.stock.b - (arms.obsolensce.gang.A * arms.stock.a)
    relative.armingrate.B = overassesment.factor.gangA.bygangB * arms.obsolensce.gang.B * arms.stock.a - (arms.obsolensce.gang.B * arms.stock.b)
    
    #Variables de flujo (modifican a las variables de estado)
    arming.gang.a = autonomos.arming.rate.A + relative.armingrate.A
    arming.gang.b = autonomos.arming.rate.A + relative.armingrate.B
    
    
    #SE empieza de aqui: variable de estado
    darm.stock.a = arming.gang.a #en este caso solo hay entrada
    darms.stock.b = arming.gang.b #en este caso solo hay entrado
    
    #Devuelve los resultados de la variable de estado
    return(list(c(darm.stock.a, darms.stock.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
parameters <- c(autonomos.arming.rate.A = 5/100,
                autonomos.arming.rate.A = 5/100,
                arms.obsolensce.gang.A = 10/100,
                arms.obsolensce.gang.B = 10/100,
                overassesment.factor.gangA.bygangB = 100/100,
                overassesment.factor.gangB.bygangA = 110/100
                 )

# 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

out <- ode(
  y = inicial.conditions,
  times = times,
  func = model_arms,
  parms = parameters,
  method = intg.method,
)
out <- as.data.frame(out)


# Graficar los resultados de la simulación
library(ggplot2)
library(ggpubr)

ggarrange(
  ggplot(out, aes(x = time, y = arms.stock.a)) + 
    geom_line() +
    labs(title = "Almacenamiento de armas grupo A"), 

  ggplot(out, aes(x = time, y = arms.stock.b)) + 
    geom_line() +
    labs(title = "Almacenamiento de armas grupo B"), 

  ncol = 2
)

Interpretación

La diferencia entre la variable de sobreestimación, la variable que varía entre los grupos, es solamente el 10%, por lo cual la diferencia entre el almanecimiento de ambos grupos es mínima. La sobreestimacipon es un factor que indirectamente afecta nuestra variable de interés, por lo cual un cambio en ella si tiene un efecto por más mínimo que sea.

Escenario 2

# Cargar el paquete deSolve para utilizar funciones de resolución de ecuaciones diferenciales
library("deSolve")

# Establecer las condiciones iniciales de la variable de estado
inicial.conditions <- c(arms.stock.a = 100/100, #ES SOBRE 100 PORQUE ES PORCENTAJE
                        arms.stock.b = 100/100) #ES ASI PORQUE ES PORCENTAGE

# Definir el vector de tiempos para la simulación
times <- seq(0,100, by = 1) #EMPIEZA EN O, SON 100 MESES, Y SE VA POR CADA MES

# Definir la función del modelo
model_arms <- function(t,state, parameters){
  with(as.list(c(state, parameters)),{
    #Variables auxiliares o endogenas
    relative.armingrate.A = overassesment.factor.gangB.bygangA * arms.obsolensce.gang.A * arms.stock.b - (arms.obsolensce.gang.A * arms.stock.a)
    relative.armingrate.B = overassesment.factor.gangA.bygangB * arms.obsolensce.gang.B * arms.stock.a - (arms.obsolensce.gang.B * arms.stock.b)
    
    #Variables de flujo (modifican a las variables de estado)
    arming.gang.a = autonomos.arming.rate.A + relative.armingrate.A
    arming.gang.b = autonomos.arming.rate.A + relative.armingrate.B
    
    
    #SE empieza de aqui: variable de estado
    darm.stock.a = arming.gang.a #en este caso solo hay entrada
    darms.stock.b = arming.gang.b #en este caso solo hay entrado
    
    #Devuelve los resultados de la variable de estado
    return(list(c(darm.stock.a, darms.stock.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
parameters <- c(autonomos.arming.rate.A = 5/100,
                autonomos.arming.rate.A = 5/100,
                arms.obsolensce.gang.A = 10/100,
                arms.obsolensce.gang.B = 10/100,
                overassesment.factor.gangA.bygangB = 100/100,
                overassesment.factor.gangB.bygangA = 50/100
                 )

# 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

out <- ode(
  y = inicial.conditions,
  times = times,
  func = model_arms,
  parms = parameters,
  method = intg.method,
)
out <- as.data.frame(out)


# Graficar los resultados de la simulación
library(ggplot2)
library(ggpubr)

ggarrange(
  ggplot(out, aes(x = time, y = arms.stock.a)) + 
    geom_line() +
    labs(title = "Almacenamiento de armas grupo A"), 

  ggplot(out, aes(x = time, y = arms.stock.b)) + 
    geom_line() +
    labs(title = "Almacenamiento de armas grupo B"), 

  ncol = 2
)

Interpretación

Como se pude observar en las gráficas, el crecimiento es más rápido con almanecimiento B ya que su factor de sobrevaloración es 50% mayor, lo cual compartamiento logarítmico más acentuado y por ende un mayor armamento. Esto se explica por el hecho que nuestra variable de interés, el almacenamiento de armas, está afectada directamente por la variable de flujo de armamento, la cual a su vez está afectada por la variable auxiliar de armamento relativo, la cual está afectada por el factor de sobrevaloración que como se mencionó anteriormente, es mayor para el grupo criminal B. Esto ilustra como en la dinámica de sistemas una variable que no esté directamente relacionada con otra puede afectarla a través de otras variables en maneras que no son necesarimente intuitivas.