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)
Hipotesis DinÔmica - ¿Ya no habrÔ mas estudiantes presenciales?
Revisando nuestro diagrama causal, podemos observar un ciclo de reforzamiento con los alumnos que se encuentran inscritos en el modo online, ya que al haber mĆ”s estudiantes los costos de tuition por estudiante disminuyen. Esto podrĆa implicar una tendencia a la alza dejando atrĆ”s la modalidad presencial sin embargo, esto aumenta la carga de trabajo de los profesores y al sentirse sobrepasados puede afectar su motiviacion generando descontento entre los estudiantes y que el nĆŗmero de quejas aumente. Una de las variables mĆ”s importantes para este diagrama es el nĆŗmero de estudiantes que se inscriben, por lo que el nĆŗmero de quejas y la falta de motivación de los profesores puede afectar como se percibe la calidad de la enseƱanza y por ende que el nĆŗmero de estudiantes inscritos (tanto presencial como onlie) disminuya.
Por lo que si el crecimiento del programa online continua, sin tener algun cambio en el workload de los profesores, y se mantiene sostenible la cantidad de estudiantes presenciales continuarĆ” siendo reducida, y eventualmente podrĆa estabilizarse en un nĆŗmero mucho mĆ”s bajo que el de los estudiantes online.
## Loading required package: shape
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ā¹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
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)
El tener una modalidad online para estudiantes puede abrir las puertas para un mercado desatendido al ser flexible y mĆ”s economico para los estudiantes, lo crucial serĆ” el cómo para que no implique una ācanibalizaciónā a los estudiantes presenciales. Uno de los puntos que nos da una pista de las decisiones que se tienen que explorar es: But what if (i) new online courses would not cost professors any additional time after the materials have been developed,
Con inversión en infraestructura en la escula, se pueden adaptar las aulas para que las clases se puedan llevar tanto de manera presencial como de manera virtual. Esto para los profesores supondrĆa no tener que preparar material para dos clases e incluiria a los alumnos que se encuentran de manera virtual a interactuar tambiĆ©n con los alumnos que se encuentran de forma presencial.
Las quejas de los estudiantes por baja calidad pueden ser un factor limitante, por lo que es fundamental asegurar que los recursos docentes sean adecuados y esten calificados y familiarizados con recursos tecnologicos para poder garantizar la calidad y experiencia educativa en ambos formatos. Adicional, la universidad debe asegurarse de mantener un equilibrio en la oferta y establecer un nĆŗmero limite de estudiantes por materia / profesor.
Recomendación final: La inversión es programa online es una decisicion estrategica de crecimiento, esta debe ser implementada de manera gradual y controlada asegurando que se invierten recursos para que pueda tener exito.
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)
Hipotesis DinƔmica
En este diagrama podemos observar que el nĆŗmero de burglaries by OC members depende de las horas disponibles por policia dedicadas a robos y de la efectividad / probabilidad de ser atrapado, esto sugiere que si hay mĆ”s robos se necesitarĆ”n mĆ”s recursos policiales lo que eventualmente disminuira la probabilidad de ser atrapado ya que los recursos policiales disponibles tendrĆ”n mĆ”s casos. MĆ”s recursos pueden ser asignados, sin embargo se tiene un delay en el proceso. Esto podrĆa llevarnos a un aumento de robos si la probabilidad de sere atrapado se percibe como baja.
Por otro lado, tenemos un ciclo de balanceo con los burglaries by burglars ya que entre mÔs robos, llamarÔ la atención de los medios de comunicación y amplificarÔ la percepción de inseguridad llevando a que la gente sea mÔs consiente de ello.
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)
Politica propuesta
Reducir el nĆŗmero de burglaries totales al disminuir el porcentaje de casas con oportunidades de ser robada a travĆ©s de campaƱas aumentando la percepción de ser victima de run robo. Un aumento en la percepción de riesgo de ser vĆctima de algun robo reduce el nĆŗmero de robos cometidos por ladrones ocasionales, ya que genera una mayor conciencia y prevención tanto entre las vĆctimas como en la comunidad. Esta es una forma de retroalimentación negativa: mayor seguridad percibida genera menos robos.
Con la politica propuesta queremos que el número de robo disminuya gradualmente hasta estabilizarse en números bajos. En comparación con el grafico anterior, este no muestra picos ya se pretende tener una tendencia mÔs plana y controlada.
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).
library("deSolve")
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))
})
}
parameters<-c(Infectivity = 0.1, # [1] dimmensionless
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out_COVID <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("blue"))
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).
Con la variable āPopulation Infected with COVIDā en cero obtenemos una lĆnea recta en sin cambios ya que al no haber ningun infectado por el cual comenzar le propagación, no habrĆa población expuesta y por ende no tendrĆamos contagiados.
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))
})
}
parameters<-c(Infectivity = 0.1, # [1] dimmensionless
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 0)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("blue"))
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).
Para este ejemplo cambiamos el valor a 5 - haciendo la comparación con el primero ejemplo con una población inicial infectada de 1) no se ve un cambio tan drĆ”stico. Podemos notar que el nĆŗmero de población suceptible a COVID aumenta mĆ”s rĆ”pido pasando de 108 dĆas a 43 dĆas para llegar al 100% de la población infectada. El valor final pasa de 350 a 354 lo que me hace suponer que hay personas que se vuelven a contagiar.
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))
})
}
parameters<-c(Infectivity = 0.1, # [1] dimmensionless
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 5)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("purple"))
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).
Modificando el valor de āContact Frequencyā a 9, el valor final no se modifica, siendo este 350 que es el nĆŗmero total de nuestra población sin embargo este llega a un 100% de población infectada en solo 29 dĆas.
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))
})
}
parameters<-c(Infectivity = 0.1, # [1] dimmensionless
Contact.Frequency = 9, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("green"))
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).
En este caso podemos ver como el āInfection Rateā tiene un impacto exponencial en relación al nĆŗmero de población infectada y el tiempo en el que este logra alcanzar el 100% de población, En el ejemplo 1 utilizamos 0.7 de āInfection Rateā el cual en solo 18 dĆas alcanzamos el 100% de la población y en el ejemplo 2 utilizamos 0.2 llegando al 100% en 54 dĆas. Esta variable es externa y dificil de controlar, por lo que la iniciativa que se tomo de mantenerse aislado y reducir el nĆŗmero de eventos sociales fue una de las medidas principales para evitar que aumentara la propagacion.
library("deSolve")
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))
})
}
# Ejemplo 1
parameters<-c(Infectivity = 0.7, # [1] Aumentamos el valor de infection rate
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("orange"))
# Ejemplo 2
parameters<-c(Infectivity = 0.2, # [1] dimmensionless # increase this value
Contact.Frequency = 2, # people/day
Total.Population = 350 ) #people)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1)
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
plot(out,
col=c("orange"))
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).
Este modelo, aunque muy util, no logra capturar toda la complejidad que supuso la pandemia por COVID19. Por ejemplo, no tiene en cuenta la mortalidad de la población o factores importantes como la vacunación o las variantes del virus que se tuvieron. TambiĆ©n asume que las personas susceptibles e infectadas siguen un proceso muy lineal, cuando en la realidad podrĆan influir muchos otros factores como el comportamiento social o los cambios en el virus. Algunas suposiciones del modelo que ecuentro un tanto irrealistas son:
Caracteristicas de la Población ya que no toma en cuenta las diferencias como edad, salud, o la frecuencia de contacto entre las personas.
No considera la recuperación ni la mortalidad
Inmunidad / Vacunación - el modelo ignora factores como las vacunas, las personas inmunes o que ni se enteraron que tuvieron el virus y las variantes del virus unas mÔs contagiosas que otras.
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:
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).
Al agregar las variables de āRecovery Rateā y āPopulation Recovered from COVIDā, el modelo se vuelve mĆ”s realista. La población infectada disminuye a medida que las personas se recuperan, lo que reduce la propagación de la enfermedad y la población recuperada aumenta con el tiempo haciendo un poco mĆ”s estable el sistema. El modelo ahora muestra oscilaciones en el nĆŗmero de infectados, con algunos picos y despuĆ©s una estabilización.
library("deSolve")
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]
Recovery.Rate <- population.infected.with.COVID / Average.Duration.of.Infection # [people/time] (nueva variable de flujo)
#State (stock) variables
dpopulation.susceptible.to.COVID<-(-1)*Infection.Rate #Stock units: People/time
dpopulation.infected.with.COVID<-Infection.Rate-Recovery.Rate #Stock units: People/time
dpopulation.recovered.from.COVID<- Recovery.Rate #Stock units: People/time
list(c(dpopulation.susceptible.to.COVID,
dpopulation.infected.with.COVID,
dpopulation.recovered.from.COVID))
})
}
parameters <- c(Infectivity = 0.1, # [1] dimensionless
Contact.Frequency = 2, # [people/day]
Total.Population = 350, # [people]
Average.Duration.of.Infection = 14) # dĆas (suponiendo un promedio de 14 dĆas de infección)
InitialConditions <- c(population.susceptible.to.COVID = 349 ,
population.infected.with.COVID = 1,
population.recovered.from.COVID = 0) # 0 personas recuperadas inicialmente
times <- seq(0 , #initial time, days
120 , #end time, days
0.25 ) #time step, days
intg.method<-c("rk4")
out_COVIDFULL <- ode(y = InitialConditions,
times = times,
func = covid.epidemic,
parms = parameters,
method =intg.method )
# Graficar los resultados
plot(out_COVIDFULL[, "time"], out_COVIDFULL[, "population.susceptible.to.COVID"],
type = "l", col = "blue", xlab = "Tiempo (dĆas)", ylab = "NĆŗmero de Personas",
main = "Evolución de la Población Susceptible, Infectada y Recuperada con COVID")
lines(out_COVIDFULL[, "time"], out_COVIDFULL[, "population.infected.with.COVID"], col = "red")
lines(out_COVIDFULL[, "time"], out_COVIDFULL[, "population.recovered.from.COVID"], col = "green")
# Agregar la leyenda
legend("topright", legend = c("Susceptibles", "Infectados", "Recuperados"),
col = c("blue", "red", "green"), lty = 1)
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).
Para el ejemplo 1 se utilizo Contact.Frequency = 2 y Infectivity = 0.7 con este cambio lo que antes era una campana para la variable de personas infectadas, ahora se vuelve un pico en los primeros 20 dĆas el cual va disminuyendo conforme las persoans infectadas se van recuperando.
Para el ejemplo 2 se utilizo Contact.Frequency = 7 y Infectivity = 0.1, el comportamiento es bastante similar a lo que observamos en el ejemplo 1, el cambio mas significativo es la variable de personas susceptibles, alargando el tiempo en el que logra estabilizarse.
Los dos ejemplos alcanzan el 100% de la población en 120 dĆas.
EJEMPLO 1
EJEMPLO 2
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)
#Carga la librerĆa deSolve empleando la función library()
library("deSolve")
InitialConditions <- c(armsstockofgangA = 100/100 ,
armsstockofgangB = 100/100)
times <- seq(0 , #initial time, months
100 , #end time, months
1 ) #time step, months
arms <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
relativearmingrateofgangA <- (overassessmentfactorofgangBarmingbygangA * armsobsolescenserateofgangA * armsstockofgangB) - (armsobsolescenserateofgangA * armsstockofgangA)
relativearmingrateofgangB <- (overassessmentfactorofgangAarmingbygangB * armsobsolescenserateofgangB * armsstockofgangA) - (armsobsolescenserateofgangB * armsstockofgangB)
#Flow variables
armingofgangA <- autonomousarmingrateA + relativearmingrateofgangA
armingofgangB <- autonomousarmingrateB + relativearmingrateofgangB
#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 = 100/100,
overassessmentfactorofgangAarmingbygangB = 110/100,
armsobsolescenserateofgangA = 10/100,
armsobsolescenserateofgangB = 10/100)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = arms,
parms = parameters,
method =intg.method )
plot(out,
col=c("purple"))
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)
Al observar la grÔfica, parece que tanto Gang A como Gang B estÔn aumentando su stock de armas de manera similar a lo largo del tiempo con una tendencia al alza, teniendo como resultado final 7.8 para Gang A y 8.2 para Gang B. Ambas se arman de manera autónoma a una tasa fija, pero también ajustan sus tasas de armamento en función de las armas que posee la otra pandilla. Esto crea un ciclo de retroalimentación mutua, donde el aumento de armas en una pandilla genera una respuesta proporcional en la otra.
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)
De acuerdo con la grĆ”fica, se observa que la Gang A muestra un crecimiento mĆ”s lento en su stock de armas en comparación con la Gang B, lo que refleja la subestimación del armamento. La Gang B, al evaluar correctamente la amenaza, responde de manera mĆ”s rĆ”pida causando un aceleración pronunciada al inicio en su arsenal pero siguiendo la tendencia del Gang A. Al final del dĆa el resultado del armamento total se mantiene igual para ambos.
library("deSolve")
# Modelo de las pandillas
arms <- function(t, state, parameters) {
with(as.list(c(state, parameters)), {
# Variables auxiliares
relativearmingrateofgangA <- (overassessmentfactorofgangBarmingbygangA * armsobsolescenserateofgangA * armsstockofgangB) - (armsobsolescenserateofgangA * armsstockofgangA)
relativearmingrateofgangB <- (overassessmentfactorofgangAarmingbygangB * armsobsolescenserateofgangB * armsstockofgangA) - (armsobsolescenserateofgangB * armsstockofgangB)
# Variables de flujo
armingofgangA <- autonomousarmingrateA + relativearmingrateofgangA
armingofgangB <- autonomousarmingrateB + relativearmingrateofgangB
# Variables de estado (stocks)
darmsstockofgangA <- armingofgangA
darmsstockofgangB <- armingofgangB
list(c(darmsstockofgangA, darmsstockofgangB))
})
}
# ParƔmetros modificados
parameters <- c(autonomousarmingrateA = 5 / 100, # 5% al mes
autonomousarmingrateB = 5 / 100, # 5% al mes
overassessmentfactorofgangBarmingbygangA = 0.5, # Subestimación del 50% de la Pandilla A hacia la Pandilla B
overassessmentfactorofgangAarmingbygangB = 1.0, # Evaluación correcta de la Pandilla B hacia la Pandilla A
armsobsolescenserateofgangA = 10 / 100, # 10% de obsolescencia al mes
armsobsolescenserateofgangB = 10 / 100, # 10% de obsolescencia al mes
Total.Population = 350) # Tamaño total de la población (suma de ambas pandillas)
# Condiciones iniciales
InitialConditions <- c(armsstockofgangA = 100 / 100, # 100% del armamento necesario para destruir a la otra pandilla
armsstockofgangB = 100 / 100) # 100% del armamento necesario para destruir a la otra pandilla
# Tiempo de simulación (100 meses)
times <- seq(0, 100, 1)
# Método de integración
intg.method <- c("rk4")
# Ejecutar la simulación
out_COVID5 <- ode(y = InitialConditions,
times = times,
func = arms,
parms = parameters,
method = intg.method)
# Graficar los resultados
plot(out_COVID5[, "time"], out_COVID5[, "armsstockofgangA"],
type = "l", col = "purple", xlab = "Tiempo (meses)", ylab = "Stock de Armas de la Pandilla A",
main = "Evolución del Stock de Armas de las Pandillas A y B")
lines(out_COVID5[, "time"], out_COVID5[, "armsstockofgangB"], col = "orange")
legend("topright", legend = c("Pandilla A", "Pandilla B"),
col = c("purple", "orange"), lty = 1)