Instrucciones y recomendaciones
Descripción del caso:
The board of directors of a university would like to know whether it is a good idea to start a “traditional” online distance learning programme in addition to the regular on-site programme. The members of the board would like to gain an understanding of the likely dynamics of the number of online students and on-site students over time. Similar programmes elsewhere show that:
Students enroll when entering the programme, and unenroll when finishing the programme or when quitting. The annual number of students that passes the programme is equal to a percentage of the total number of online students, which is lower than the percentage of on-site students passing. Students unenroll due to dissatisfaction with the programme. Dissatisfaction is mainly caused by the perceived quality of the teaching. Enrollment is directly proportional to the tuition fee, the perceived quality of the programme, and is highly dependent on word of mouth advertisement by current and former students. The more students there are in the online programme, the lower the costs per student.
The quality of the teaching/professors depends on experience, expertise, and motivation. Motivation is inversely proportional to their workload and the number of complaints. Complaints are the direct result of the deterioration of the quality. Improving the educational quality raises the cost per online student. And long term teaching overload results in loss of expertise.
A traditional online programme may attract students that would otherwise enroll in the onsite programme, and hence, cannibalize the on-site programme. The work related to the online programme would have to be done by the professors that teach the on-site programme, in addition to their high workload for the on-site programme.
But what if (i) new online courses would not cost professors any additional time after the materials have been developed, (ii) there would be no limit to the number of students that could follow the online course, (iii) there would almost be no costs per student, (iv) these cases would generate a lot of attention, and they would result in attracting brighter students in more advanced and fun courses to teach? Those are the promises of Massive Online Learning Courses or MOOCs.
Preguntas del caso:
1.1. Desarrolla el diagrama causal del caso (10 punto, producto: diagrama causal)
1.2. Formula la hipótesis dinámica del comportamiento del sistema. Enfócate en el comportamiento de las variables que consideres son más relevantes. Describe gráficamente tu hipótesis dinámica (7 puntos, productos: hipótesis dinámica y gráfico que la respalde)
Si se introduce un programa tradicional en línea, es probable que la universidad experimente un crecimiento inicial en el número de estudiantes en línea, impulsado por el boca a boca y el valor percibido. Sin embargo, sin cambios estructurales para manejar la calidad y la carga de trabajo de los profesores y la insatisfacción estudiantil aumentará, lo que provocará una reducción de la calidad, más quejas, un aumento en las tasas de deserción y, finalmente, un estancamiento o disminución de los estudiantes en línea.
En este escenario, habrá una fase inicial de crecimiento, donde gracias a la difusión de boca en boca y un bajo costo por estudiante, aumentará la cantidad de estudiantes en línea. Sin embargo, en una segunda fase, habrá un estancamiento o declive debido a la insatisfacción, el agotamiento del profesorado y la disminución de la calidad.
Estas tendencias pueden estabilizarse si el modelo se transforma en una estructura similar a la de los MOOC con una impartición escalable, un coste marginal reducido y mecanismos que mejoren la motivación del profesorado y la calidad de la docencia.
1.3. ¿Qué aconsejarías hacer a la junta directiva?, ¿deben invertir en estos cursos?, justifica tu respuesta (3 puntos, producto: justificación de la recomendación solicitada)
Basándonos en nuestra hipótesis dinámica, la junta directiva debería invertir en educación en línea, pero no en un programa en línea tradicional. En su lugar, la inversión debería centrarse en cursos de estilo MOOC que deslinden el crecimiento de la carga de trabajo de los profesores y eviten el ciclo de deterioro de la calidad y agotamiento que los formatos tradicionales tienden a desencadenar.
Los programas tradicionales en línea corren el riesgo de obtener beneficios a corto plazo seguidos de un estancamiento a largo plazo, la desmotivación de los profesores y el daño a la reputación debido al creciente descontento de los estudiantes. También conllevan el riesgo de canibalizar el programa presencial sin ampliar el alcance general de los estudiantes.
En resumen, la junta solo debería avanzar si la universidad se compromete con un modelo escalable, de bajo costo por estudiante, desarrollado por equipos especializados y respaldado por mecanismos de retroalimentación claros (por ejemplo, satisfacción estudiantil, tasas de deserción escolar, etc.).
Descripción del caso:
Suppose that burglaries are mainly committed by members of the organized crime (OC) and by occasional thieves. Burglaries by members of the OC and burglaries by occasional burglars then largely determine the total number of burglaries.
The Netherlands is such a small country and organized crime so well organized that the amount of burglaries by members of the OC depends largely on the effective chance of being caught for burglary in the Netherlands versus the chance of being caught for burglary in neighboring countries. The effective chance of being caught for burglary is proportional to the well-spent police man-hours available for burglaries and inversely proportional to the total police man-hours required for burglaries. Assume the police system is flexible but also rather inert: if total police man-hours required for burglaries increases/decreases, then so do the police man-hours available for burglaries, but with a delay.
Burglaries by occasional thieves mainly depend on the percentage of houses with opportunities for burglaries, which is seasonal (more in winter less in summer) and influenced by the relative media attention with regard to burglaries. The latter is proportional to the total number of burglaries divided by the acceptable number of burglaries.
Preguntas del caso:
2.1. Desarrolla el diagrama causal del caso (10 punto, producto: diagrama causal)
2.2. Formula la hipótesis dinámica del comportamiento del sistema. Enfócate en el comportamiento de las variables que consideres son más relevantes. Describe gráficamente tu hipótesis dinámica (7 puntos, productos: hipótesis dinámica y gráfico que la respalde)
Si los robos aumentan, el número total de robos provocará una mayor atención de los medios de comunicación, lo que puede reducir los robos cometidos por delincuentes ocasionales a través de la disuasión social, formando un ciclo de equilibrio. Sin embargo, los robos cometidos por miembros de la delincuencia organizada se ven influenciados principalmente por la probabilidad efectiva de ser capturado en los Países Bajos en comparación con los países vecinos.
A medida que aumentan los robos, se necesitan más horas de trabajo de la policía y, con el tiempo, se asignan más horas de trabajo. Esto mejora la probabilidad efectiva de ser descubierto, sin embargo, esta reacción se produce con retraso. Los factores estacionales también aumentan las oportunidades de robo, afectando especialmente a los ladrones ocasionales.
Este modelo muestra cómo un ciclo de equilibrio (disuasión social + aplicación de la ley) estabiliza gradualmente lo que comienza como una tendencia creciente, mientras que la variación estacional crea un comportamiento cíclico. El modelo refleja tanto los shocks a corto plazo (como las olas de oportunidad de robo) como las dinámicas estructurales a largo plazo (como el rezago en la aplicación de la ley y el desplazamiento de la delincuencia)
2.3. Diseña una política que ayude a reducir el número de burglaries, gráfica el nuevo comportamiento del sistema al incluir tu política y comparalo con tu hipótesis dinámica sin política (3 puntos, producto: gráfico contrastando el comportamiento de la hipótesis dinámica con la política propuesta)
Para poder reducir la cantidad de robos, se recomienda una política que combine la intervención policial temprana con una mayor disuasión pública. Al aumentar el despliegue policial en cuanto los niveles de robos empiezan a aumentar, el sistema puede combatir la delincuencia organizada. Al mismo tiempo, las campañas mediáticas dirigidas pueden promover la disuasión social entre los delincuentes ocasionales, especialmente durante los picos estacionales. Los resultados podrían mostrar que este enfoque puede reducir el número total de robos, acorta la duración de los períodos de alta delincuencia y atenúa los picos estacionales (que seguirán estando presentes), lo que conduce a una estabilización más temprana de los niveles de delincuencia y a una mejora de la seguridad pública a largo plazo.
Este problema tiene como objetivo guiarte en el desarrollo y análisis de un modelo dinámico empleando el lenguaje de programación R. El objetivo es que te familiarices con las herramientas de análisis en R y que inicies el desarrollo de tus propios modelos dinámicos. Para este efecto tomaremos como referencia el caso de la epidemia COVID-19, basándonos en el modelo básico de SARS descrito por Sterman (2013).
Descripción del caso:
Para iniciar tomaremos como referencia el diagrama “stock-flow” de Sterman (2013) mostrado en la siguiente figura.
Como primer paso haremos un listado del tipo de variables en el modelo:
Variables de Estado (Stock variables)
Variables de flujo (flow variables)
Variables auxiliares endógenas (endogenous auxiliary variables)
Parámetros de simulación (variables en la frontera del sistema o exogenous auxiliary variables)
Esta clasificación es útil para organizar el espacio de trabajo en Rstudio.
Tutorial de modelado del caso en R:
Iniciaremos por definir este modelo dinámico como una función definida por el usuario siguiendo los siguientes pasos.
#Carga la librería deSolve empleando la función library()
library("deSolve")
Declara el espacio de trabajo como una función definida por el usuario. En este caso sólo tienes que cambiar el nombre de la función, manteniendo el template que hemos usado en otros modelos
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
#Flow variables
#State (stock) variables
list(c())
})
}
Ahora agregaremos las variables de estado y los flujos asociadas a ellas. Iniciaremos con la variable de estado “Population Susceptible to COVID” como se muestra en el chunk siguiente.
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
#Flow variables
#State (stock) variables
dpopulation.susceptible.to.COVID<-
list(c())
})
}
Nota que en R las variables no pueden ser nombradas con espacios. De manera que esta variable de estado es nombrada como: “population.susceptible.to.COVID” nota también que las variables de estado son precedidas por el símbolo diferencial “d” para indicar que esta es una variable de estado, la sintaxis completa es: “dpopulation.susceptible.to.COVID”. Después de este paso habrás creado exitosamente la primera variable de estado del modelo.
Una práctica muy recomendable es documentar tus modelos. En R puedes hacer esto empleando el símbolo “#” y escribiendo delante de éste una breve descripción de la variable que estas representando. Además de describir la variable que estas creando es muy recomendable escribir también las unidades de medición de tu variable. El siguiente chunk muestra un ejemplo:
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
#Flow variables
#State (stock) variables
#The population susceptible to COVID is equal to the
#population susceptible prior to the onset of the disease
#less all of those that have contracted it
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
#Esta linea indica que variables se imprimen como
#resultado de la integración del modelo, todas las
#variables de estado deben estar listadas
list(c())
})
}
Como se muestra en el stock-flow diagram, la variable “Infection.Rate” está conectada a la variable de estado como un flujo de salida (i.e. outflow variable), esta estructura se modela como se muestra en el chunk anterior. Nota que esta variable de flujo afecta con signo negativo a la variable de estado. Este signo negativo específica a esta variable de flujo como un flujo de salida.
Podemos seguir un proceso similar para modelar y documentar la segunda variable de estado “population.infected.with.COVID” como se muestra en la siguiente figura. Nota que en este caso la variable de flujo “Infection.Rate” es modelada como un flujo de entrada (i.e. inflow variable) y por esta razón no se incluye un signo negativo y nota también que la variable de estado “population.infected.with.COVID” es especificada precedida del signo diferencial “d”.
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
#Flow variables
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c())
})
}
Como se muestra en el stock-flow diagram, en este modelo solo existe una sola variable de flujo que está conectada a las variables de estado. Esta variable de flujo es determinada por dos variables auxiliares: “Contacts between Infected and Uninfected People” e “Infectivity”. Para este caso especificamos la variable de flujo “Infection.Rate” como la multiplicación simple de estas dos variables auxiliares tal como se muestra en la siguiente figura. Nota que al agregar esta nueva variable también hemos incluido la documentación que describe esta variable y sus unidades de medición.
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
#Flow variables
Infection.Rate<-Infectivity*Contacts.bt.Infected.and.Uninfected.People #[people/time]
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c())
})
}
Al definir la variable de flujo “Infection.Rate” hemos agregado dos nuevas variables que debemos especificar. La variable “Contacts between Infected and Uninfected People” es una variable auxiliar endógena que es determinada por la variable “Susceptible Contacts” y la variable “Probability of Contact with Infected Person” esta interacción es especificada de la siguiente manera:
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
Contacts.bt.Infected.and.Uninfected.People<-Susceptible.Contacts*Probability.of.Contact.with.Infected #[people/time]
#Flow variables
Infection.Rate<-Infectivity*Contacts.bt.Infected.and.Uninfected.People #[people/time]
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c())
})
}
Al definir esta nueva variable hemos agregado dos nuevas variables auxiliares endógenas que debemos definir. La primera variable “Susceptible Contacts” es determinada por la variable de estado “Population Susceptible to COVID” y por la variable “Contact Frequency” y es especificada como se muestra en la figura siguiente. Nota que en esta ocasión al emplear la variable de estado para definir otra variable endógena auxiliar no es necesario usar el símbolo diferencial antes de la variable de estado.
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
Susceptible.Contacts<-population.susceptible.to.COVID*Contact.Frequency #[people/time]
Contacts.bt.Infected.and.Uninfected.People<-Susceptible.Contacts*Probability.of.Contact.with.Infected #[people/time]
#Flow variables
Infection.Rate<-Infectivity*Contacts.bt.Infected.and.Uninfected.People #[people/time]
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c())
})
}
La última variable endógena auxiliar por modelar es la variable “Probability of Contact with Infected Person”. De manera similar al caso anterior, esta variable es determinada por la variable de estado “population infected with COVID” dividida por la variable exógena auxiliar “Total Population”
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
Probability.of.Contact.with.Infected<-population.infected.with.COVID/Total.Population #dimensionless
Susceptible.Contacts<-population.susceptible.to.COVID*Contact.Frequency #[people/time]
Contacts.bt.Infected.and.Uninfected.People<-Susceptible.Contacts*Probability.of.Contact.with.Infected #[people/time]
#Flow variables
Infection.Rate<-Infectivity*Contacts.bt.Infected.and.Uninfected.People #[people/time]
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c())
})
}
Esto concluye la especificación de todos los elementos endógenos del modelo. El siguiente paso es especificar los valores de los parámetros (i.e. variables auxiliares exógenas), las condiciones iniciales de las variables de estado, el horizonte temporal de análisis y el método de integración para la simulación.
En nuestro modelo hemos especificado tres parámetros: “Contact Frequency”, “Total Population” e “Infectivity”.
En R podemos especificar los parámetros del modelo empleando un vector como se muestra en la siguiente figura. Nota que el nombre de los parámetros es idéntico al nombre empleando en la especificación descrita en los pasos anteriores. También nota que cada parámetro está asociado a un valor numérico único para el cual correremos el modelo de simulación. Finalmente nota que para cada parámetro se especifican sus unidades de medición.
parameters<-c(Infectivity = 0.1, # [1] dimmensionless
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
De igual manera podemos emplear un vector en R para definir las condiciones iniciales de cada variable de estado, esto se muestra en la siguiente figura. Nuevamente el nombre de las variables de estado es idéntico al empleado en la especificación de la modelo y cada variable de estado es inicializada a un valor único.
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1)
Ahora es necesario especificar el vector de tiempo que será usado para simular el modelo. Esta especificación se lleva a cabo como se muestra en la siguiente figura. Nota que para especificar este vector de tiempo empleamos la función seq(). Esta función crea una secuencia numérica y requiere tres parámetros: valor inicial, valor final e intervalo de crecimiento. En nuestro modelo dinámico estos tres parámetros representan el tiempo inicial de la simulación, el tiempo final de la simulación y la resolución temporal de la simulación. Nota que para cada parámetro hemos indicado la unidad de tiempo correspondiente.
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
Aún no discutimos con detalle las propiedades de los diferentes métodos de integración que podemos emplear para simular nuestro modelo. Por lo pronto, para este ejercicio, elegiremos el método Runge-Kutta de Orden 4, en clases subsecuentes estudiaremos las propiedades de otros métodos de integración. La figura siguiente muestra la forma de especificar este método de integración.
intg.method<-c("rk4")
El último paso en el proceso de especificación del modelo es elegir las variables que serán “impresas” por la simulación. Este es un paso muy importante ya que nos permite elegir las variables que deseamos analizar. La figura siguiente muestra la forma de especificar las variables a imprimir por el modelo. Nota que esto es especificado en la última línea de código de la función contiene nuestro modelo dinámico. Nota también que en este caso hemos elegido imprimir sólo las variables de estado y que ambas están precedidas por el signo diferencial “d” y son concatenadas empleando la función c().
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
Probability.of.Contact.with.Infected<-population.infected.with.COVID/Total.Population #dimensionless
Susceptible.Contacts<-population.susceptible.to.COVID*Contact.Frequency #[people/time]
Contacts.bt.Infected.and.Uninfected.People<-Susceptible.Contacts*Probability.of.Contact.with.Infected #[people/time]
#Flow variables
Infection.Rate<-Infectivity*Contacts.bt.Infected.and.Uninfected.People #[people/time]
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate #Stock units: People/time
list(c(dpopulation.susceptible.to.COVID,
dpopulation.infected.with.COVID))
})
}
Esto concluye la especificación del modelo de simulación. El siguiente paso es ejecutar este código y llevar a cabo la simulación. Corre los chunks que contienen la librería deSolve, los vectores que guardamos como parameters, InitialConditions, times e intg.method, y también corre el chunk de la función covid.epidemic.
Una vez realizado esto, en la consola de R ya están cargados tanto el modelo como todos los parámetros necesarios para llevar a cabo la simulación, pero aún no hemos generado datos de la simulación. Para hacer esto, crearemos una base de datos “out” que contiene los resultados de la simulación empleando la función “ode”. Nota que la función “ode” emplea como parámetros de entrada condiciones iniciales de las variables de estado del modelo, el vector de tiempo, la función covid.epidemic que describe nuestro modelo, las variables exógenas (i.e. parámetros) y el método de integración. Todos estos elementos los hemos definido ya en los pasos anteriores.
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
Si has hecho esto correctamente verás un nuevo objeto llamado “out” listado en el panel superior derecho.
El paso final es analizar gráficamente los resultados para esto emplea la función “plot”
plot(out,
col=c("blue"))
Preguntas del caso:
3.1. Incluye tu modelo en un sólo chunk de código en el que se utilice la función plot para ver el comportamiento de las variables de estado. Toma en cuenta que el modelo que envíes será revisado en términos de las sintaxis del código, pero fundamentalmente en términos de su funcionalidad. Un modelo que no funcione al ser ejecutado será penalizado notablemente (2 puntos, productos: chunk con el modelo).
R. Modelo
# Cargar librería necesaria
library(deSolve)
# Modelo SI: COVID
covid.epidemic <- function(t, state, parameters) {
with(as.list(c(state, parameters)), {
# Variables auxiliares endógenas
Probability.of.Contact.with.Infected <- population.infected.with.COVID / Total.Population
Susceptible.Contacts <- population.susceptible.to.COVID * Contact.Frequency
Contacts.bt.Infected.and.Uninfected.People <- Susceptible.Contacts * Probability.of.Contact.with.Infected
# Flujo de infección
Infection.Rate <- Infectivity * Contacts.bt.Infected.and.Uninfected.People
# Cambios en stocks
dS <- -Infection.Rate
dI <- Infection.Rate
list(c(dS, dI))
})
}
# Parámetros
parameters <- c(
Infectivity = 0.1,
Contact.Frequency = 2,
Total.Population = 350
)
# Condiciones iniciales
InitialConditions <- c(
population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1
)
# Vector de tiempo
times <- seq(0, 120, by = 0.25)
# Simulación
out <- ode(
y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method = "rk4"
)
# Graficar resultado
matplot(out[, "time"], out[, 2:3], type = "l", lty = 1, lwd = 2,
col = c("blue", "red"), xlab = "Tiempo (días)", ylab = "Población",
main = "Modelo SI: Dinámica del COVID")
legend("right", legend = c("Susceptibles", "Infectados"), col = c("blue", "red"), lty = 1)
3.2. ¿Qué sucede cuando inicializas la variable de estado “Population Infected with COVID” en cero? Explica brevemente que origina el comportamiento que observas, emplea la estructura del modelo para cimentar tu argumentación (2 puntos, productos: grafico de simulación y breve descripción).
R. Modelo
# Reutilizamos la misma función 'covid.epidemic' definida previamente
# Nuevas condiciones iniciales (infectados = 0)
InitialConditions_zero <- c(
population.susceptible.to.COVID = 350,
population.infected.with.COVID = 0
)
# Simulación con infectados en cero
out_zero <- ode(
y = InitialConditions_zero,
times = times,
func = covid.epidemic,
parms = parameters,
method = "rk4"
)
# Graficar resultado
matplot(out_zero[, "time"], out_zero[, 2:3], type = "l", lty = 1, lwd = 2,
col = c("blue", "red"), xlab = "Tiempo (días)", ylab = "Población",
main = "COVID SI - Sin infectados iniciales")
legend("right", legend = c("Susceptibles", "Infectados"), col = c("blue", "red"), lty = 1)
R. Cuando la población infectada inicial se establece en cero, el modelo
muestra que no ocurre ninguna infección durante toda la simulación. La
población susceptible permanece constante en 350 personas y la población
infectada se queda en 0. Esto se debe a la estructura interna del
modelo, en la que la tasa de infección (
Infection.Rate)
depende directamente de la interacción entre personas infectadas y
susceptibles.
Como no hay personas infectadas al inicio, la probabilidad de contacto con personas infectadas es cero, ya que no existe efecto aqui dado esa condicion inicial, y por lo tanto el modelo genera una tasa de infección cero. En consecuencia, no se activa ningún contagio ni se genera ninguna dinámica epidémica.
Esto refleja un comportamiento realista: en un sistema cerrado sin infectados iniciales, una epidemia no puede comenzar espontáneamente bajo este tipo de modelo determinista ya que se muestra lo siguiente en el grafico.
El gráfico muestra dos líneas planas:
- Línea azul (Susceptibles): constante en 350.
- Línea roja (Infectados): constante en 0.
3.3. ¿Cómo cambia la dinámica de comportamiento del modelo si inicializas esta variable de estado a un valor positivo diferente de cero? (2 puntos, productos: gráfico de simulación y breve descripción).
R. Modelo.
# Nuevas condiciones iniciales con 5 infectados
InitialConditions_alt <- c(
population.susceptible.to.COVID = 345,
population.infected.with.COVID = 5
)
# Simulación
out_alt <- ode(
y = InitialConditions_alt,
times = times,
func = covid.epidemic,
parms = parameters,
method = "rk4"
)
# Gráfico
matplot(out_alt[, "time"], out_alt[, 2:3], type = "l", lty = 1, lwd = 2,
col = c("blue", "red"), xlab = "Tiempo (días)", ylab = "Población",
main = "Modelo SI: Infección inicial = 5")
legend("right", legend = c("Susceptibles", "Infectados"), col = c("blue", "red"), lty = 1)
R. Explicacion de los resultados
Cuando la simulación inicia con una población infectada mayor a cero, como 5 personas, se activa el proceso de contagio. A diferencia del escenario anterior (3.2), ahora sí hay contacto entre personas infectadas y susceptibles, lo que genera una tasa de infección positiva desde el primer momento.
El resultado es una curva epidémica típica: los infectados crecen rápidamente, mientras que la población susceptible disminuye hasta agotarse. Eventualmente, toda la población se vuelve infectada, ya que el modelo SI no contempla recuperación.
El gráfico generado muestra este comportamiento claro: una curva en forma de “S” para los infectados (crecimiento acelerado) y una curva descendente simétrica para los susceptibles.
Esto confirma que la epidemia solo puede iniciarse si hay al menos una persona infectada al inicio.
3.4. ¿Cómo cambia la dinámica del sistema si aumenta el valor del parámetro “Contact Frequency”? ¿El valor de este parámetro modifica el valor final de la variable de estado “Population Infected with COVID”? Explica porque sí o porque no haciendo referencia a la estructura del modelo y a los resultados de la simulación (4 puntos, productos: gráfico con resultados de simulación y descripción de resultados).
R. Modelo
# Función y tiempos ya definidos previamente
# Definir modelo SIR con recuperación
covid.epidemic.sir <- function(t, state, parameters) {
with(as.list(c(state, parameters)), {
Probability.of.Contact.with.Infected <- population.infected.with.COVID / Total.Population
Susceptible.Contacts <- population.susceptible.to.COVID * Contact.Frequency
Contacts.bt.Infected.and.Uninfected.People <- Susceptible.Contacts * Probability.of.Contact.with.Infected
Infection.Rate <- Infectivity * Contacts.bt.Infected.and.Uninfected.People
Recovery.Rate <- population.infected.with.COVID / Average.Duration.of.Infection
dpopulation.susceptible.to.COVID <- -Infection.Rate
dpopulation.infected.with.COVID <- Infection.Rate - Recovery.Rate
dpopulation.recovered.from.COVID <- Recovery.Rate
list(c(dpopulation.susceptible.to.COVID,
dpopulation.infected.with.COVID,
dpopulation.recovered.from.COVID))
})
}
# Simular modelo base (Contact Frequency = 2)
out_cf_base <- ode(
y = c(population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0),
times = seq(0, 120, 0.25),
func = covid.epidemic.sir,
parms = c(Infectivity = 0.1, Contact.Frequency = 2, Total.Population = 350, Average.Duration.of.Infection = 14),
method = "rk4"
)
# Simular modelo con Contact Frequency alto (por ejemplo, 4)
out_cf_high <- ode(
y = c(population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0),
times = seq(0, 120, 0.25),
func = covid.epidemic.sir,
parms = c(Infectivity = 0.1, Contact.Frequency = 4, Total.Population = 350, Average.Duration.of.Infection = 14),
method = "rk4"
)
# Gráfico comparando ambos escenarios
plot(out_cf_base[, "time"], out_cf_base[, "population.infected.with.COVID"],
type = "l", col = "red", lty = 2, lwd = 2,
xlab = "Tiempo (días)", ylab = "Infectados",
main = "Comparación: Contact Frequency Base vs. Alto")
lines(out_cf_high[, "time"], out_cf_high[, "population.infected.with.COVID"],
col = "green", lty = 1, lwd = 2)
legend("topright", legend = c("Base (2)", "Alto (4)"),
col = c("red", "green"), lty = c(2, 1), lwd = 2)
R. Cual es el efecto de aumentar el parámetro “Contact Frequency”
Cuando se incrementa el valor del parámetro
Contact Frequency, el modelo muestra que el contagio se
acelera considerablemente: el número de infectados crece más rápido, el
pico de la epidemia ocurre antes y es más alto, y la población
susceptible disminuye con mayor velocidad.
Sin embargo hay que considerar que el valor final de la variable de
estado Population Infected with COVID no cambia
significativamente a largo plazo, ya que el modelo base SIR asume una
población cerrada y homogénea: todos los susceptibles eventualmente se
infectan o recuperan, sin nuevas entradas ni salidas del sistema.
Lo que sí cambia es la forma y el momento de la curva: con mayor contacto entre personas, el brote ocurre más abruptamente, lo que podría saturar sistemas de salud en el mundo real.
Por lo tanto, aunque el valor final total de infectados no se modifica mucho, la dinámica del sistema sí cambia drásticamente, y eso es clave para decisiones de política pública.
3.5. ¿Cómo cambia el comportamiento del modelo si la variable de flujo “Infection Rate” cambia? Sigue los siguientes lineamientos para dar tu respuesta: Responde a esta pregunta describiendo brevemente los cambios que identificas al cambiar el valor de esta variable. Emplea un par de gráficos de comportamiento del modelo para dar soporte a tu respuesta (6 puntos, productos: gráfico con resultados de simulación y descripción de resultados).
# Función y estructura del modelo ya deben estar cargadas
# Simulación con Infectivity baja
out_inf_low <- ode(
y = c(population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0),
times = seq(0, 120, 0.25),
func = covid.epidemic.sir,
parms = c(Infectivity = 0.05, Contact.Frequency = 2, Total.Population = 350, Average.Duration.of.Infection = 14),
method = "rk4"
)
# Simulación con Infectivity alta
out_inf_high <- ode(
y = c(population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0),
times = seq(0, 120, 0.25),
func = covid.epidemic.sir,
parms = c(Infectivity = 0.2, Contact.Frequency = 2, Total.Population = 350, Average.Duration.of.Infection = 14),
method = "rk4"
)
# Gráfico comparativo
plot(out_inf_low[, "time"], out_inf_low[, "population.infected.with.COVID"],
type = "l", col = "blue", lty = 2, lwd = 2,
xlab = "Tiempo (días)", ylab = "Infectados",
main = "Efecto de cambiar la Infection Rate (Infectivity)")
lines(out_inf_high[, "time"], out_inf_high[, "population.infected.with.COVID"],
col = "green", lty = 1, lwd = 2)
legend("topright", legend = c("Infectivity = 0.05", "Infectivity = 0.2"),
col = c("blue", "green"), lty = c(2, 1), lwd = 2)
R. Explicacion cambio en infection rate
La Infection Rate se calcula en el modelo como el
resultado de multiplicar la probabilidad de contagio
(Infectivity) por la cantidad de contactos entre infectados
y susceptibles. Para ver su efecto, hicimos dos simulaciones: una con
Infectivity = 0.05 (baja) y otra con
Infectivity = 0.2 (alta).
Los resultados son claros: con alta infectividad, el brote se dispara de forma acelerada y el número de infectados crece muy rápido. En cambio, con baja infectividad, la epidemia avanza lentamente y nunca explota.
Esto muestra que la Infection Rate no solo determina si hay contagios, sino qué tan rápido se propaga la enfermedad. Cambiarla tiene un efecto directo sobre la forma de la curva de infectados.
3.6. El modelo que has desarrollado siguiendo el tutorial anterior es demasiado simple. Brevemente critica la formulación y estructura del modelo y lista las suposiciones del modelo que consideras son irrealistas. Uno o dos párrafos son más que suficientes para responder este punto (2 puntos, productos: respuesta textual).
En el punto anterior identificaste algunas suposiciones irrealistas. Las siguientes preguntas tienen como objetivo que explores que sucede cuando se expanda el modelo para atender sus limitaciones.
Hasta el momento hemos asumido que la población se mantiene infectada con el virus COVID de manera indefinida. En epidemiologia esto se conoce como el modelo SI (i.e. Susceptible-Infectious). El modelo SI es apropiado para representar enfermedades crónicas para las que no existe una cura. Sin embargo, en el caso de muchas enfermedades infecciosas, incluyendo COVID, SARS, viruela o influenza, las personas infectadas pueden recuperarse o en los casos más lamentables morir.
El siguiente diagrama stock-flow expande la estructura del modelo base para describir el proceso de recuperación de la población infectada con COVID. Esta expansión del modelo en epidemiología es conocida como el modelo SIR (i.e. la “R” indica “Recovery”). Sigue las instrucciones siguientes para expandir el modelo del tutorial.
El diagrama stock-flow muestra que debes agregar tres variables nuevas: una nueva variable de estado “Population Recovered from COVID”, una nueva variable de flujo “Recovery Rate” (por simplicidad no distinguiremos entre los pacientes que se recuperan y aquellos que mueren) y un nuevo parámetro “Average Duraction of Infection”.
El parámetro “Average Duraction of Infection” indica el tiempo promedio (i.e. en días) que una persona permanece infectada con el virus COVID. Los epidemiólogos estiman que la fase de infección del COVID tiene una duración promedio de 7 a 21 días. Emplea tu criterio para elegir el valor de este parámetro.
Existen muchas formas de modelar la variable de flujo “Recovery Rate” pero la especificación empleada con mayor frecuencia es la siguiente: Recovery Rate=Population Infected with COVID/Average Duration of Infectivity
Para implementar exitosamente esta estructura en el modelo es necesario que especifiques que esta nueva variable de flujo afecta también a la variable de estado existente “Population Infected with COVID” de la siguiente manera (i.e. sintaxis en R):
dpopulation.infected.with.COVID<-Infection.Rate - Recovery.Rate
También es necesario agregar nueva variable de estado “Population Recovered from COVID”, esto lo puedes lograr empleando la siguiente especificación:
dpopulation.recovered.from.COVID<- Recovery.Rate
Recuerda que al agregar una nueva variable de estado es necesario que indiques en el vector de condiciones iniciales el valor inicial de esta variable y también indicar en la última línea de código de la función “covid.epidemic” que esta nueva variable de estado será impresa por la simulación:
list(c(dpopulation.susceptible.to.COVID, dpopulation.infected.with.COVID, dpopulation.recovered.from.COVID))
Emplea esta nueva versión del modelo para responder a las siguientes preguntas:
R. 3.6 Crítica a la formulación y estructura del modelo SI
El modelo SI desarrollado es útil como una primera aproximación para representar enfermedades contagiosas, pero su estructura es excesivamente simple y presenta varias suposiciones poco realistas. La más importante es que las personas infectadas nunca se recuperan ni mueren, lo cual implica que, con el tiempo, toda la población terminará infectada, sin posibilidad de remisión. Esto no representa con precisión el comportamiento de enfermedades como COVID-19, donde existe recuperación y mortalidad.
Otra limitación es que el modelo no contempla la movilidad o el contacto heterogéneo entre personas, ni considera intervenciones externas (vacunación, confinamientos, campañas). Además, la tasa de infección es lineal y no incorpora saturación de servicios de salud ni cambios de comportamiento a lo largo del tiempo. Por último, la población total se mantiene constante, lo cual impide modelar efectos demográficos o migratorios que son relevantes en epidemias reales.
R 3.6 Modelo
library(deSolve)
# Definimos el modelo SI (sin recuperación)
covid.si <- function(t, state, parameters) {
with(as.list(c(state, parameters)), {
# Variables auxiliares
prob_contact <- infected / total_pop
sus_contacts <- susceptible * contact_freq
effective_contacts <- sus_contacts * prob_contact
# Tasa de infección
infection_rate <- infectivity * effective_contacts
# Ecuaciones diferenciales
dS <- -infection_rate
dI <- infection_rate
list(c(dS, dI))
})
}
# Parámetros
params <- c(
infectivity = 0.1,
contact_freq = 2,
total_pop = 350
)
# Condiciones iniciales
init <- c(
susceptible = 349,
infected = 1
)
# Tiempo de simulación
time <- seq(0, 120, 0.25)
# Simulación
out_si <- ode(
y = init,
times = time,
func = covid.si,
parms = params,
method = "rk4"
)
# Graficar
matplot(out_si[, "time"], out_si[, 2:3], type = "l", lty = 1, lwd = 2,
col = c("blue", "red"),
xlab = "Tiempo (días)", ylab = "Población",
main = "Modelo SI: Sin recuperación")
legend("right", legend = c("Susceptibles", "Infectados"),
col = c("blue", "red"), lty = 1)
3.7. ¿De qué manera cambia el comportamiento de la epidemia una vez que agregas estas nuevas variables al modelo? (10 puntos, productos: nueva versión del modelo, gráficos con comportamiento de las tres variables de estado).
# Ya debe estar definida la función covid.epidemic.sir
# Parámetros y condiciones iniciales
parameters.sir <- c(
Infectivity = 0.1,
Contact.Frequency = 2,
Total.Population = 350,
Average.Duration.of.Infection = 14
)
InitialConditions.sir <- c(
population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0
)
# Simulación
out_sir <- ode(
y = InitialConditions.sir,
times = seq(0, 120, 0.25),
func = covid.epidemic.sir,
parms = parameters.sir,
method = "rk4"
)
# Gráfico
matplot(out_sir[, "time"], out_sir[, 2:4], type = "l", lty = 1, lwd = 2,
col = c("blue", "red", "green"),
xlab = "Tiempo (días)", ylab = "Población",
main = "Modelo SIR: Dinámica del COVID")
legend("right", legend = c("Susceptibles", "Infectados", "Recuperados"),
col = c("blue", "red", "green"), lty = 1)
R. La expansión del modelo SI a SIR introduce una dinámica más
realista. Al agregar la variable de recuperación
(Population Recovered from COVID) y el flujo asociado
(Recovery Rate), se observa un cambio fundamental en el
comportamiento del sistema.
En lugar de que todos los individuos terminen infectados como en el modelo SI, ahora:
Este comportamiento en forma de campana para los infectados y en S para los recuperados es característico del modelo SIR y refleja mejor lo que sucede en epidemias reales, donde los individuos eventualmente dejan de ser infecciosos.
3.8. ¿Describe gráficamente y con un breve texto el efecto en el sistema de cambios (i.e. incremento y decremento) de las siguientes variables: “contact frequency” y “infectivity”? Enfatiza en las diferencias que percibes con respecto del comportamiento del modelo base. Usa una concisa y breve descripción textual y gráfica (2 puntos, productos: descripción de comportamiento, gráficos describiendo el comportamiento del modelo).
R. Modelo
# Función para simular con distintos parámetros
simulate_sir <- function(contact_freq, infectivity) {
parameters_mod <- c(
Infectivity = infectivity,
Contact.Frequency = contact_freq,
Total.Population = 350,
Average.Duration.of.Infection = 14
)
InitialConditions.sir <- c(
population.susceptible.to.COVID = 349,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0
)
ode(y = InitialConditions.sir,
times = times,
func = covid.epidemic.sir,
parms = parameters_mod,
method = "rk4")
}
# Simulaciones con diferentes Contact Frequencies
out_cf_low <- simulate_sir(contact_freq = 1, infectivity = 0.1)
out_cf_base <- simulate_sir(contact_freq = 2, infectivity = 0.1)
out_cf_high <- simulate_sir(contact_freq = 4, infectivity = 0.1)
# Gráfico: Contact Frequency
matplot(out_cf_low[, "time"], out_cf_low[, "population.infected.with.COVID"],
type = "l", col = "blue", lty = 1, lwd = 2,
xlab = "Tiempo (días)", ylab = "Infectados", ylim = c(0, 180),
main = "Efecto de Contact Frequency en Infectados")
lines(out_cf_base[, "time"], out_cf_base[, "population.infected.with.COVID"], col = "red", lty = 2, lwd = 2)
lines(out_cf_high[, "time"], out_cf_high[, "population.infected.with.COVID"], col = "green", lty = 3, lwd = 2)
legend("topright", legend = c("Bajo (1)", "Base (2)", "Alto (4)"),
col = c("blue", "red", "green"), lty = 1:3, lwd = 2)
# Simulaciones con diferentes Infectivities
out_inf_low <- simulate_sir(contact_freq = 2, infectivity = 0.05)
out_inf_base <- simulate_sir(contact_freq = 2, infectivity = 0.1)
out_inf_high <- simulate_sir(contact_freq = 2, infectivity = 0.2)
# Gráfico: Infectivity
matplot(out_inf_low[, "time"], out_inf_low[, "population.infected.with.COVID"],
type = "l", col = "blue", lty = 1, lwd = 2,
xlab = "Tiempo (días)", ylab = "Infectados", ylim = c(0, 180),
main = "Efecto de Infectivity en Infectados")
lines(out_inf_base[, "time"], out_inf_base[, "population.infected.with.COVID"], col = "red", lty = 2, lwd = 2)
lines(out_inf_high[, "time"], out_inf_high[, "population.infected.with.COVID"], col = "green", lty = 3, lwd = 2)
legend("topright", legend = c("Bajo (0.05)", "Base (0.1)", "Alto (0.2)"),
col = c("blue", "red", "green"), lty = 1:3, lwd = 2)
R. Análisis de sensibilidad: Contact Frequency e Infectivity
Hicimos dos pruebas: primero, subimos y bajamos la cantidad de
contactos diarios que tiene una persona
(Contact Frequency). Después, hicimos lo mismo con la
probabilidad de que una persona se contagie al tener contacto con un
infectado (Infectivity).
En ambos casos, se observa que: - Mientras más contacto o más contagioso sea el virus, más rápido crece el número de infectados y el brote es más fuerte. - Cuando el contacto o la infectividad son bajos, la epidemia avanza muy lentamente y el número de infectados es mucho menor.
Los gráficos resaltan estos puntos: subir cualquiera de estos dos parámetros hace que el brote explote más rápido y afecte a más personas. Por eso, medidas como reducir contactos o usar protección son clave para controlar este tipo de epidemias.
Descripción del caso:
Arms races are escalation processes between two (or more) nations or parties in a conflict that ‘watch each other and [both] respond to [uncertain] arming activities of their opponent with [relatively greater] arming activities of their own’ (Bossel 2007c, p36). The amount of weapons held by one party may actually deter the other party from attacking and vice versa, resulting in a situation of escalating armed peace. This exercise is based on the escalation model described in (Bossel 2007c, Z507).
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.
Preguntas del caso:
4.1. Desarrolla el diagrama causal del caso (10 puntos, producto: diagrama causal)
4.2. Construye un modelo de dinámica de sistemas de este caso de estudio, suponiendo que la banda A sobreestima el armamento de la banda B en un 10%, es decir, overassessment factor of gang A arming by gang B es 110%, y que la banda B estima correctamente el armamento de la banda A, es decir, overassessment factor of gang A arming by gang B es 100%. Simula el modelo durante un periodo de 100 meses. (15 puntos, producto: modelo en R mostrando el ‘plot’ del comportamiento de las variables de estado)
4.3. Describe textualmente tu hipótesis dinámica de este caso. ¿Qué comportamientos identficas? (2 puntos, producto: descripción de la hipótesis dinámica)
Este sistema representa una estructura de retroalimentación equilibrada que puede generar la apariencia de una escalada debido a la sobrerreacción mutua y a la estabilización retrasada. Aunque cada banda intenta igualar o superar ligeramente la amenaza percibida por la otra, sus sobrevaloraciones y tendencias autónomas a armarse provocan aumentos persistentes de sus reservas de armas a lo largo del tiempo.
El comportamiento que identifico es que si ambas bandas reaccionan a las amenazas percibidas por la otra aumentando sus propias reservas de armas, y si no se introduce ningún límite máximo o mecanismo de confianza, el resultado será una escalada armamentística, una dinámica de “paz armada” impulsada por el miedo mutuo, una percepción errónea y el retraso estructural, aunque cada parte actúe a la defensiva.
4.4. Ahora supongamos que la banda A subestima el armamento de la banda B en un 50%, es decir, que overassessment factor of gang B arming by gang A es del 100%-50% o del 50%, y que la banda B evalúa correctamente el armamento de la banda A, es decir, que overassessment factor of gang A arming by gang B es del 100%. Cambia el o los parámetros correspondientes y vuelve a simular el modelo durante un período de 100 meses. ¿Qué comportamiento muestra la simulación?, ¿por qué? (3 puntos, producto: descripción textual y gráfica del nuevo comportamiento del sistema)
library("deSolve") #cargar libreria
InitialConditions <- c(armsstockofgangA = 100/100,
armsstockofgangB = 100/100)
times <- seq(0 , #initial time, months
100 , #end time, months
1 ) #time step, month
arms <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
relativearmingrateA <- (overassessmentfactorofgangBarmingbygangA * armsobsolescencerateofgangA * armsstockofgangB) - (armsobsolescencerateofgangA * armsstockofgangA)
relativearmingrateB <- (overassessmentfactorofgangAarmingbygangB * armsobsolescencerateofgangB * armsstockofgangA) - (armsobsolescencerateofgangB * armsstockofgangB)
#Flow variables
armingofgangA <- autonomousarmingrateA + relativearmingrateA
armingofgangB <- autonomousarmingrateB + relativearmingrateB
#State (stock) variables
darmsstockofgangA <- armingofgangA
darmsstockofgangB <- armingofgangB
#Esta linea indica que variables se imprimen como
#resultado de la integración del modelo, todas las
#variables de estado deben estar listadas
list(c(darmsstockofgangA,darmsstockofgangB))
})
}
parameters<-c(autonomousarmingrateA = 5/100,
autonomousarmingrateB = 5/100,
overassessmentfactorofgangBarmingbygangA = 50/100,
overassessmentfactorofgangAarmingbygangB = 100/100,
armsobsolescencerateofgangA = 10/100,
armsobsolescencerateofgangB = 10/100
)
intg.method<-c("rk4") #siempre es el mismo
out <- ode(y = InitialConditions,
times = times,
func = arms,
parms = parameters,
method =intg.method )
plot(out)
En esta simulación, la banda A subestima el armamento de la banda B en un 50%, mientras que la banda B evalúa correctamente a A. Como resultado, se observa una dinámica asimétrica: la banda B incrementa su arsenal de forma más acelerada, mientras que la banda A lo hace con mayor lentitud.
Esto ocurre porque A no percibe adecuadamente la amenaza de su oponente y, por tanto, no intensifica su carrera armamentista. En contraste, B sí responde proporcionalmente al crecimiento del arsenal de A. Esta diferencia genera un desequilibrio creciente en los niveles de armamento a lo largo del tiempo en el periodo evaluado.
El gráfico confirma este comportamiento: la curva de armamento de la banda B crece con mayor pendiente, alcanzando un nivel significativamente más alto que el de A al final del período simulado, ya que estos no subestiman la capacidad de A para obtener mayor armamento.