El siguiente modelo expone el problema 18.12 “Managing an orchastreted Bank Run” del libro Small System Dynamics Models for Big Issues: Triple Jump towards Real-World Complexity de Erik Pruyt.

¿De que trata el problema?

El problema 18.12 es la caída del banco DSB (Dirk Scheringa Bank) en los Países Bajos, que se declaró en bancarrota debido a una huida de depósitos orquestada por clientes enojados. Esta situación es particularmente interesante porque fue causada por una huida de depósitos coordinada, lo que es diferente a una huida de depósitos espontánea.

El modelo se enfoca en los siguientes aspectos clave:

  1. Pérdida de activos líquidos y préstamos: La huida de depósitos puede causar una pérdida significativa de activos líquidos y préstamos, lo que puede llevar a una situación crítica para el banco.

  2. Liquidación de activos fijos: El banco puede liquidar activos fijos, como inmuebles o bienes raíces, para convertirlos en activos líquidos. Sin embargo, esta liquidación puede ser costosa y puede generar pérdidas para el banco.

  3. Factores que amplifican la huida: El enojo de los clientes y la percepción del riesgo de quiebra pueden amplificar la huida de depósitos, lo que puede llevar a una situación crítica para el banco.

  4. Probabilidad percibida de quiebra: El modelo también incluye el cálculo de la probabilidad percibida de quiebra en función de la credibilidad del banco y las ratios de liquidez y solvencia.

  5. Condiciones para la quiebra: El modelo establece condiciones para que el banco central declare la quiebra del banco, como la caída de las ratios de liquidez y solvencia por debajo de ciertos límites.

En el siguiente modelo se observarán cómo los cambios en los parámetros de enojo, credibilidad del banco, percepción de que este pueda entrar en bancarrota, así como cambios en el tiempo permitido para retirar activos, cambiarían la situación del banco y el monto de activos que estos pierden. Esto permitirá analizar cómo diferentes factores pueden influir en la estabilidad del banco y en la magnitud de la pérdida de activos durante una huida de depósitos orquestada.

En la figura 1 se observa como estas interacciones dan lugar a la huida y perdida de activos

1. Diagrama de flujo del problema

Figura.1
Figura.1
Codigo del problema

El modelo base establece que la organización de una huida y el enojo de los individuos es del 0%. Lo que implica que en el tiempo establecido, no habrá pérdidas.

library("deSolve")
library(ggplot2)



#Condiciones iniciales del modelo. Poblacion trans por grupo de edad
initial.conditions <- c(liquid_deposits_loans = 4500000000,
                        liquid_assets = 115000000,
                        fixed_assets = 4600000000,
                        fixed_deposits_loans = 1000000000
) 

times <- seq(0,60, by = 1)  #dias


parameters <- c(liquid_liability_target = 20/100,
                liquidation_premium = 10/100,
                withdrawal_time = 1,
                liquidation_time = 1,
                anger = 0, 
                hindrance_bank_failures = 1,
                orchestrated_liquid_fraction_running_away = 0/100,
                credibility_denials = 90/100
                

                
  
)

#Se llena de abajo hacia arriba (primero variable de estado)
# Definir la función del modelo
model_exam <-function(t, state, parameters){
  with(as.list(c(state, parameters)),{
    
    
#VARIABLES ENDOJENAS
    
    liquid_asset_liquid_liability_ratio = liquid_assets / liquid_deposits_loans
    
    total_asset_total_liability_ratio = (fixed_assets + liquid_assets) / (liquid_deposits_loans + fixed_deposits_loans)

    
    bank_failure_declaration = ifelse((liquid_asset_liquid_liability_ratio < 0.05 | total_asset_total_liability_ratio < 0.9),"bank failure declaration","no bank failure declaration")
    
     
    
    
    perceived_likelihood_liquidity_failure = approx(c(-1,0,0.1,0.2,0.3,0.4,0.5,1), #x = liquid_asset_liquid liability_ratio
                                                    c(100/100,100/100,80/100,40/100,10/100,1/100,0/100,0/100) , # y = perceived_likelihood_liquidity_failure
                                                    xout = liquid_asset_liquid_liability_ratio)$y
    
    perceived_likelihood_solvency_failure = approx(c(0,0.8,0.9,1,1.1,1.2,2), #total_asset_total_liability_ratio
                                                   c(100/100,100/100,90/100,50/100,10/100,0/100,0/100), #perceived_likelihood_solvency_failure
                                                   xout = total_asset_total_liability_ratio)$y
    
        perceived_likelihood_bank_failure = (100/100 - credibility_denials) * ifelse(perceived_likelihood_liquidity_failure > perceived_likelihood_solvency_failure,perceived_likelihood_liquidity_failure, perceived_likelihood_solvency_failure) 
        
        liquid_fraction_running_away = approx(c(0/100,25/100,50/100,75/100,100/100), #x = perceived_likelihood_bank_failure
                                          c(0/100,0/100,1/100,10/100,50/100),# y = liquid_fraction_running_away
                                         xout = perceived_likelihood_bank_failure)$y
  
#VARIABLES FLUJO 
    
liquid_deposit_loans_lost = liquid_deposit_loans_lost <- min(
  (liquid_fraction_running_away * liquid_deposits_loans / withdrawal_time) * (1 + hindrance_bank_failures) * (1 + anger) + 
      (orchestrated_liquid_fraction_running_away * liquid_deposits_loans / 1),
      liquid_deposits_loans / withdrawal_time)
    
liquidation <- ifelse(liquidation_time == liquidation_time, 
                      liquid_deposits_loans * liquid_liability_target - liquid_assets, 
                      ((liquid_deposits_loans * liquid_liability_target - liquid_assets) / (1 - liquidation_premium)))

liquid_assets_lost =  liquid_deposit_loans_lost

liquidation_losses = liquidation * liquidation_premium
   
    
#VARIABLES ESTADO
    dliquid_deposits_loans =   - liquid_deposit_loans_lost
    dliquid_assets = liquidation - liquid_assets_lost
    dfixed_assets =  - liquidation_losses - liquidation
    dfixed_deposits_loans = fixed_deposits_loans

    #Devuelve los resultados de la variable de estado
    return(list(c( dliquid_deposits_loans,
                   dliquid_assets,
                   dfixed_assets,
                   dfixed_deposits_loans ) ,
                liquid_deposit_loans_lost = liquid_deposit_loans_lost,
                liquidation_losses = liquidation_losses,
                liquid_assets_lost = liquid_assets_lost,
                perceived_likelihood_bank_failure = perceived_likelihood_bank_failure,
                liquidation = liquidation))
    
  })
}


# 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 = initial.conditions, 
  times = times,
  func = model_exam, 
  parms = parameters,
  method = intg.method
)

out <- as.data.frame(out)

# Graficar los resultados de la simulación

library(ggplot2)

ggplot(out, aes(x = time, y = liquid_deposits_loans)) +geom_line()

ggplot(out, aes(x = time, y = liquid_assets)) +geom_line()

ggplot(out, aes(x = time, y = fixed_assets)) +geom_line()

ggplot(out, aes(x = time, y = fixed_deposits_loans)) +geom_line()

ggplot(out, aes(x = time, y = liquidation)) +geom_line()

ggplot(out, aes(x = time, y = liquid_assets_lost)) +geom_line()

ggplot(out, aes(x = time, y = liquid_deposit_loans_lost)) +geom_line()

ggplot(out, aes(x = time, y = liquidation_losses)) +geom_line()

Es posible observar que en las gráficas de las variables de estado y las variables de flujo, no se experimenta un cambio relativo al establecido en las condiciones iniciales. Esto se debe a que, según el modelo, la organización de una huida y el enojo de los individuos es del 0%, lo cual da como resultado que el banco no experimente pérdidas por las variables de estado y se mantenga estable en el tiempo establecido.

Variables de incertidumbre

Ahora, nos interesa modelar cómo los diferentes niveles de enojo y el porcentaje de personas interesadas en organizar una huida de activos pueden influir en las pérdidas y el tiempo en el que estas se llevarían. Además, también consideraremos la credibilidad del banco, es decir, cómo influye que las personas crean que el banco no está en peligro de bancarrota. También tomaremos en cuenta el tiempo de liquidación, es decir, el tiempo que tienen para sacar su dinero al 100% si se cumplen las condiciones, y el porcentaje de pérdida que tendrán si no cumplen el plazo de tiempo.

x1 <- seq(5/100, 15/100, 10/100) # liquidation_premium
x2 <- seq(1, 10, 1) # liquidation_time
x3 <- seq(1, 10, 1) # anger
x4 <- seq(1/100, 50/100, 10/100) # orchestrated_liquid_fraction_running_away
x5 <- seq(45/100, 90/100, 10/100 ) # credibility_denials

# combine all stressors
Xs <- expand.grid(list(
  liquidation_premium = x1,
  liquidation_time = x2,
  anger = x3,
  orchestrated_liquid_fraction_running_away = x4,
  credibility_denials = x5
))
Xs$Run.ID <- 1:nrow(Xs)
#map all Xs into the model 
out_all <- list()
#Establecemos el loop
for (i in 1:nrow(Xs))
{
  #Variables exógenas o parámetros
  parameters.xs <- c(liquidation_premium = Xs$liquidation_premium[i], # 10%
                hindrance_bank_failures = 0.5, #
                withdrawal_time = 1,
                liquidation_time = Xs$liquidation_time[i], #day
                anger = Xs$anger[i],
                orchestrated_liquid_fraction_running_away = Xs$orchestrated_liquid_fraction_running_away[i],
                credibility_denials =Xs$credibility_denials[i],
                liquid_liability_target = 20/100
  )
  
  #Simulación del modelo
    out <- ode(
  y = initial.conditions, 
  times = times,
  func = model_exam, 
  parms = parameters.xs,
  method = intg.method
  )

out <- data.frame(out)
out$Run.ID <- Xs$Run.ID[i]
out_all <- append(out_all, list(out))
#print(Xs$Run.ID[i])

} 

out_all <- do.call("rbind", out_all)
dim(out_all)
## [1] 305000     11
out_all <- merge(out_all, Xs, by="Run.ID")
dim(out_all)
## [1] 305000     16

Comportamiento de variables de estado.

Liquid Assets
p1<- ggplot(out_all,aes(x=time,y=liquid_assets ,group=Run.ID, colour=liquidation_premium))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "orange")

p2<- ggplot(out_all,aes(x=time,y=liquid_assets,group=Run.ID, colour=liquidation_time))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "green")
  
p3<- ggplot(out_all,aes(x=time,y=liquid_assets,group=Run.ID, colour=anger))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p4<- ggplot(out_all,aes(x=time,y=liquid_assets,group=Run.ID, colour=orchestrated_liquid_fraction_running_away))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p5<- ggplot(out_all,aes(x=time,y=liquid_assets,group=Run.ID, colour=credibility_denials))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p1
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p5
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

# Para ver las gráficas juntas, se puede usar gridExtra
library(gridExtra)
grid.arrange(p1, p2, p3,p4,p5, ncol = 1)
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

En estas graficas observamos como se comportan los activos liquidos bajo las 5 diferentes condiciones de incertidumbre, en cuanto a variables de estado esta es la unica que se modela debido a que las otras no son afectadas directamente.

Variable de flujo.

Liquid Deposits and Loans lost

Ahora, observemos como se comportan las variables de flujo de pérdidas, estas son las mas importantes del modelo

p1.2<- ggplot(out_all,aes(x=time,y=liquid_deposit_loans_lost ,group=Run.ID, colour=liquidation_premium))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "orange")

p2.2<- ggplot(out_all,aes(x=time,y=liquid_deposit_loans_lost,group=Run.ID, colour=liquidation_time))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "green")
  
p3.2<- ggplot(out_all,aes(x=time,y=liquid_deposit_loans_lost,group=Run.ID, colour=anger))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p4.2<- ggplot(out_all,aes(x=time,y=liquid_deposit_loans_lost,group=Run.ID, colour=orchestrated_liquid_fraction_running_away))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p5.2<- ggplot(out_all,aes(x=time,y=liquid_deposit_loans_lost,group=Run.ID, colour=credibility_denials))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p1.2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p2.2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p3.2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p4.2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p5.2
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

# Para ver las gráficas juntas, se puede usar gridExtra
library(gridExtra)
grid.arrange(p1.2, p2.2, p3.2,p4.2,p5.2, ncol = 1)
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

En el caso de las perdidas que sufren los depósitos y prestamos estan presentan muchas mas perdidas cuando el enojo esta alto

Liquid Assets Lost
p1.3<- ggplot(out_all,aes(x=time,y= liquid_assets_lost ,group=Run.ID, colour=liquidation_premium))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "orange")


p2.3<- ggplot(out_all,aes(x=time,y=liquid_assets_lost,group=Run.ID, colour=liquidation_time))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "green")
  
p3.3<- ggplot(out_all,aes(x=time,y=liquid_assets_lost,group=Run.ID, colour=anger))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p4.3<- ggplot(out_all,aes(x=time,y=liquid_assets_lost,group=Run.ID, colour=orchestrated_liquid_fraction_running_away))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p5.3<- ggplot(out_all,aes(x=time,y=liquid_assets_lost,group=Run.ID, colour=credibility_denials))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")
p1.3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p2.3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p3.3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p4.3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p5.3
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

# Para ver las gráficas juntas, se puede usar gridExtra
library(gridExtra)
grid.arrange(p1.3, p2.3, p3.3,p4.3,p5.3, ncol = 1)
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

Liquid Assets Lost es la variable afectada directamente por la liquidacion de activos fijos, pero esta tambien se ve afectada por el enojo debido a que es igual a la perdida de prestamos

Liquidation_losses
p1.4<- ggplot(out_all,aes(x=time,y=liquidation_losses ,group=Run.ID, colour=liquidation_premium))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "orange")

p2.4<- ggplot(out_all,aes(x=time,y=liquidation_losses,group=Run.ID, colour=liquidation_time))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "green")
  
p3.4<- ggplot(out_all,aes(x=time,y=liquidation_losses,group=Run.ID, colour=anger))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p4.4<- ggplot(out_all,aes(x=time,y=liquidation_losses,group=Run.ID, colour=orchestrated_liquid_fraction_running_away))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p5.4<- ggplot(out_all,aes(x=time,y=liquidation_losses,group=Run.ID, colour=credibility_denials))+
  geom_line()+
  scale_color_gradient(low = "blue", high = "red")

p1.4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p2.4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p3.4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p4.4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

p5.4
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

# Para ver las gráficas juntas, se puede usar gridExtra
library(gridExtra)
grid.arrange(p1.4, p2.4, p3.4 ,p4.4 ,p5.4, ncol = 1)
## Warning: Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 182670 rows containing missing values or values outside the scale range
## (`geom_line()`).

Por ultimo observamos que las perdidas de liquidacion tienen un comportamiento diferente, a esta variable no le afecta tanto la accion de la huida organizada, le afecta mas el tiempo de liquidacion