Modelación de Sistemas
Tarea 2 - Solución propuesta
7 de Marzo de 2020
Profesor: Dr. Edmundo Molina
Problema 1: Preguntas de Opción Múltiple (120 puntos)
Revisa el libro de Pruyt (2013). Responde a las preguntas de opción múltiple listadas a continuación.
Capítulo 3:
*Multiple Choice Question 1, página 69 (5 puntos) Respuesta: D
*Multiple Choice Question 2, página 69 (5 puntos) Respuesta: B
*Multiple Choice Question 3, página 70 (5 puntos) Respuesta: C
*Multiple Choice Question 4, página 70 (5 puntos) Respuesta: D
*Multiple Choice Question 5, página 71 (5 puntos) Respuesta: C
*Multiple Choice Question 6, página 71 (5 puntos) Respuesta: D
*Multiple Choice Question 7, página 72 (5 puntos) Respuesta: B
*Multiple Choice Question 8, página 72 (5 puntos) Respuesta: A
*Multiple Choice Question 9, página 72 (5 puntos) Respuesta: B
*Multiple Choice Question 10, página 72 (5 puntos) Respuesta: A
*Multiple Choice Question 11, página 73 (5 puntos) Respuesta: B
*Multiple Choice Question 12, página 74 (5 puntos) Respuesta: C
*Multiple Choice Question 13, página 74 (5 puntos) Respuesta: C
*Multiple Choice Question 14, página 75 (5 puntos) Respuesta: A
*Multiple Choice Question 16, página 76 (5 puntos) Respuesta: C
*Multiple Choice Question 19, página 78 (5 puntos) Respuesta: D
Capítulo 7:
*Multiple Choice Question 1, página 104 (5 puntos) Respuesta: D
*Multiple Choice Question 2, página 104 (5 puntos) Respuesta: C
*Multiple Choice Question 3, página 104 (5 puntos) Respuesta: D
*Multiple Choice Question 6, página 106 (5 puntos) Respuesta: D
*Multiple Choice Question 8, página 107 (5 puntos) Respuesta: A
*Multiple Choice Question 11, página 108 (5 puntos) Respuesta: C
*Multiple Choice Question 12, página 109 (5 puntos) Respuesta: A
*Multiple Choice Question 14, página 110 (5 puntos) Respuesta: B
Problema 2: Política de Crimen y Planificación Familiar (90 puntos)
Preguntas de caso:
2.1 Construye un modelo de dinámica de sistemas de este caso de estudio. Corre el caso base por un período de 50 años. Nota, las variables del modelo se indican en itálicas. Emplea esta ayuda para construir tu modelo (30 puntos, productos: modelo en R, envía tu modelo con la versión final de tu tarea)
library("deSolve")
crimes.and.family <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
criminal.kids<-kids*percentage.of.kids.with.criminal.behavior
criminal.youngsters<-youngsters*percentage.of.youngsters.with.criminal.behavior
criminal.adults<-adults*percentage.of.adults.with.criminal.behavior
criminal.retirees<-retirees*percentage.of.retirees.with.criminal.behavior
crimes<-crime.by.others + criminal.kids*criminal.acts.per.criminal.kid + criminal.youngsters*criminal.acts.per.criminal.youngster + criminal.adults*criminal.acts.per.criminal.adult + criminal.retirees*criminal.acts.per.criminal.retiree
#Flow variables
deaths<-retirees/average.time.as.retiree
adults.to.retirees<-adults/average.time.as.adult
youngsters.to.adults<-youngsters/average.time.as.youngster
kids.to.youngsters<-kids/average.time.as.kid
births<-successful.voluntary.family.planning.measures*(adults*fertility.rate.of.adults + youngsters*fertility.rate.of.youngsters)
#State (stock) variables
dkids<-births-kids.to.youngsters
dyoungsters<-kids.to.youngsters-youngsters.to.adults
dadults<-youngsters.to.adults-adults.to.retirees
dretirees<-adults.to.retirees-deaths
list(c(dkids,dyoungsters,dadults,dretirees),
crimes=crimes)
})
}
parameters<-c(successful.voluntary.family.planning.measures= 1, #dæ¼ã¸³nde 1 es un programa donde no existe planificaciæ¼ã¸³n familiar y 0 es dæ¼ã¸³nde las parejas dejan de tener hijos
fertility.rate.of.adults=.03, #dimensionless
fertility.rate.of.youngsters=.003, #dimensionless
crime.by.others=6000000, #crimes/year
criminal.acts.per.criminal.kid= 2, #crimes/year
criminal.acts.per.criminal.youngster= 4, #crimes/year
criminal.acts.per.criminal.adult= 12, #crimes/year
criminal.acts.per.criminal.retiree= 4, #crimes/year
average.time.as.retiree= 15, #years
average.time.as.adult= 40, #years
average.time.as.youngster= 12, #years
average.time.as.kid= 12, #years
percentage.of.kids.with.criminal.behavior= .05,
percentage.of.youngsters.with.criminal.behavior= .5,
percentage.of.adults.with.criminal.behavior= .6,
percentage.of.retirees.with.criminal.behavior= .1
)
InitialConditions <- c(kids= 1000000, #people
youngsters= 1000000, #people
adults= 3000000, #people
retirees= 750000) #people
ini.time<-0 #Years
end.time<-50 # Years
time.step<-1 # Years
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = crimes.and.family,
parms = parameters,
method =intg.method )
plot(out)
2.2 Ahora asume que debido al éxito de la planificación familiar (successful voluntary family planning measures) la variable birth flow es 75% menor, eso es: 25% de la suma de las variables adultsanual fertility rate of adults y youngters + youngters*anual fertility rate of youngters. Expande tu modelo y grafica los nuevos resultados (30 puntos, productos: modelo en R, envía tu modelo con la versión final de tu tarea)
library("deSolve")
crimes.and.family <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
criminal.kids<-kids*percentage.of.kids.with.criminal.behavior
criminal.youngsters<-youngsters*percentage.of.youngsters.with.criminal.behavior
criminal.adults<-adults*percentage.of.adults.with.criminal.behavior
criminal.retirees<-retirees*percentage.of.retirees.with.criminal.behavior
crimes<-crime.by.others + criminal.kids*criminal.acts.per.criminal.kid + criminal.youngsters*criminal.acts.per.criminal.youngster + criminal.adults*criminal.acts.per.criminal.adult + criminal.retirees*criminal.acts.per.criminal.retiree
#Flow variables
deaths<-retirees/average.time.as.retiree
adults.to.retirees<-adults/average.time.as.adult
youngsters.to.adults<-youngsters/average.time.as.youngster
kids.to.youngsters<-kids/average.time.as.kid
births<-successful.voluntary.family.planning.measures*(adults*fertility.rate.of.adults + youngsters*fertility.rate.of.youngsters)
#State (stock) variables
dkids<-births-kids.to.youngsters
dyoungsters<-kids.to.youngsters-youngsters.to.adults
dadults<-youngsters.to.adults-adults.to.retirees
dretirees<-adults.to.retirees-deaths
list(c(dkids,dyoungsters,dadults,dretirees))
})
}
parameters<-c(successful.voluntary.family.planning.measures=.25, #dæ¼ã¸³nde 1 es un programa donde no existe planificaciæ¼ã¸³n familiar y 0 es dæ¼ã¸³nde las parejas dejan de tener hijos
fertility.rate.of.adults=.03, #dimensionless
fertility.rate.of.youngsters=.003, #dimensionless
crime.by.others=6000000, #crimes/year
criminal.acts.per.criminal.kid= 2, #crimes/year
criminal.acts.per.criminal.youngster= 4, #crimes/year
criminal.acts.per.criminal.adult= 12, #crimes/year
criminal.acts.per.criminal.retiree= 4, #crimes/year
average.time.as.retiree= 15, #years
average.time.as.adult= 40, #years
average.time.as.youngster= 12, #years
average.time.as.kid= 12, #years
percentage.of.kids.with.criminal.behavior= .05,
percentage.of.youngsters.with.criminal.behavior= .5,
percentage.of.adults.with.criminal.behavior= .6,
percentage.of.retirees.with.criminal.behavior= .1
)
InitialConditions <- c(kids= 1000000, #people
youngsters= 1000000, #people
adults= 3000000, #people
retirees= 750000) #people
ini.time<-0 #Years
end.time<-50 # Years
time.step<-1 # Years
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = crimes.and.family,
parms = parameters,
method =intg.method )
plot(out, xlab = "aæ¼ã¸±os", ylab =c("personas"))
2.3 Compara el comportamiento de esta modificación con respecto del caso base ¿Qué diferencias encuentras?, explica por qué estas diferencias son relevantes en este sistema (30, gráficos comparando el comportamiento de los dos modelos de manera simultánea, explicación de comportamiento)
Como se puede observar en la gráfica, la linea roja representa a la población luego de haber aplicado la medida de planificación familiar que redujo en un 75% el nacimiento de nuevos niños, lo que causó un abatimiento en el comportamiento que se modeló inicialmente en el que la población crecía en sus cuatro sectores de edad. Al modificarse tan drásticamente el número de nacimientos, la variable de estado “kids” se vio disminuida y cómo las demás variables de estado dependen directa o indirectamente de ésta, el decremento que se ve en el período de tiempo es muy relevante.
Problema 3: Administración de Cadena de Suministro (180 puntos)
Preguntas Iniciales del caso:
- Construye un modelo de dinámica de sistemas basado en el caso anterior, simula el modelo por un período de 100 meses. Asegúrate que el modelo este en equilibrio (30 puntos, productos: modelo en R, envía tu modelo con la versión final de tu tarea)
library("deSolve")
sports.cars <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables
dinventory<-production-sales
dworkforce<-net.hire.rate
list(c(dinventory,dworkforce))
})
}
parameters<-c(sales=100, #cars per month
productivity.of.average.worker= 1, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce= 10 #months
)
InitialConditions <- c(inventory= 300, #cars
workforce= 100) #people
ini.time<-0 #months
end.time<-100 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars,
parms = parameters,
method =intg.method )
plot(out,
xlab = "meses",
ylab =c(""))
- Ahora corre el modelo haciendo que la variable ‘sales’ cambie de 100 cars per month a 150 cars per month. Muestra y describe el comportamiento del modelo para las siguientes variables: sales, inventory y workforce (30 puntos, productos: gráficos describiendo el comportamiento del sistema, comentarios que describan el comportamiento del sistema)
library("deSolve")
sports.cars <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables
dinventory<-production-sales
dworkforce<-net.hire.rate
list(c(dinventory,dworkforce))
})
}
parameters<-c(sales=150, #cars per month
productivity.of.average.worker= 1, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce= 10 #months
)
InitialConditions <- c(inventory= 300, #cars
workforce= 100) #people
ini.time<-0 #months
end.time<-100 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars,
parms = parameters,
method =intg.method )
plot(out,
xlab = "meses",
ylab =c(""))
Al venderse más de lo que se está produciendo se observa una caída en el número de coches existentes en inventario, por lo que el modelo lo compensa incrementando la tasa de contrataciones, misma que incrementa la fuerza de trabajo, esto oscilatoriamente hasta que el sistema logre el equilibrio.
- ¿Cuánto tiempo toma para que el sistema vuelva al equilibrio dinámico? (10 puntos, productos: gráfico con anotaciones describiendo el tiempo que tarda el sistema en volver al equilibrio)
library("deSolve")
sports.cars <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables
dinventory<-production-sales
dworkforce<-net.hire.rate
list(c(dinventory,dworkforce))
})
}
parameters<-c(sales=150, #cars per month
productivity.of.average.worker= 1, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce= 10 #months
)
InitialConditions <- c(inventory= 300, #cars
workforce= 100) #people
ini.time<-0 #months
end.time<-100 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars,
parms = parameters,
method =intg.method )
plot(out,
xlab = "meses",
ylab =c(""))
En el gráfico puede observarse que teniendo una venta de 150 coches por mes el equilibrio del modelo se alcanza a los 100 meses, aproximadamente.
- Construye el diagrama de fase del sistema y describe el comportamiento esperado empleando este diagrama de fase (20 puntos, productos: diagrama de fase y explicación del comportamiento)
sports.cars <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables
dinventory<-production-sales
dworkforce<-net.hire.rate
list(c(dinventory,dworkforce), sales=sales, net.hire.rate=net.hire.rate)
})
}
parameters<-c(sales=150, #cars per month
productivity.of.average.worker= 1, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce= 10 #months
)
InitialConditions <- c(inventory= 300, #cars
workforce= 100) #people
ini.time<-0 #months
end.time<-100 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars,
parms = parameters,
method =intg.method )
plot(out[,"workforce"], out[,"net.hire.rate"], xlab="workforce", ylab = "net.hire.rate", type = "l", lwd = 2)
Se ilustra claramente un comportamiento cíclico debido a que la variable de flujo “net.hire.rate” depende de la variable de estado “workforce”, por lo que, en este modelo, el equilibrio en la fuerza de trabajo siempre será igual al número de coches vendidos, se debería aplicar una medida que evitara que la variable de flujo tendiera a ser negativa para evitar que existan despidos de personal.
Preguntas adicionales del caso:
- Asume que la producción del ensamblador (i.e. assembler) constituye la demanda de la firma en el primer nivel de suministro (i.e. tier 1 supplier), y que la producción de la firma en la primera línea de suministro constituye la demanda de la firma en el segundo nivel de suministro (i.e. tier 2 supplier). Expande tu modelo original, asume que la estructura interna de estas firmas adicionales es idéntica a la estructura de la firma ensambladora (30 puntos, productos: modelo en R, envía tu modelo con la versión final de tu tarea)
library("deSolve")
sports.cars.supply.chain <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables Assembler
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables Assembler
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables Assembler
dinventory<-production-sales
dworkforce<-net.hire.rate
#Endogenous auxiliary variables Tier 1 supplier
target.inventory1<-production*inventory.coverage
inventory.correction1<-(target.inventory1-inventory1)/time.to.correct.inventory
target.production1<-production+inventory.correction1
target.workforce1<-target.production1/productivity.of.average.worker
sales1<-production
#Flow variables Tier 1 supplier
production1<-workforce1*productivity.of.average.worker
net.hire.rate1<-(target.workforce1-workforce1)/time.to.adjust.workforce
#State (stock) variables Tier 1 supplier
dinventory1<-production1-production
dworkforce1<-net.hire.rate1
#Endogenous auxiliary variables Tier 2 supplier
target.inventory2<-production1*inventory.coverage
inventory.correction2<-(target.inventory2-inventory2)/time.to.correct.inventory
target.production2<-production1+inventory.correction2
target.workforce2<-target.production2/productivity.of.average.worker
sales2<-production1
#Flow variables Tier 2 supplier
production2<-workforce2*productivity.of.average.worker
net.hire.rate2<-(target.workforce2-workforce2)/time.to.adjust.workforce
#State (stock) variables Tier 2 supplier
dinventory2<-production2-production1
dworkforce2<-net.hire.rate2
list(c(dinventory, dinventory1, dinventory2, dworkforce, dworkforce1, dworkforce2), sales=sales, sales1=sales1, sales2=sales2)
})
}
parameters<-c(sales=150, #cars per month
productivity.of.average.worker= 1, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce= 10 #months
)
InitialConditions <- c(inventory= 300, #cars
inventory1= 300, #cars
inventory2= 300, #cars
workforce= 100, #people
workforce1= 100, #people
workforce2= 100) #people
ini.time<-0 #months
end.time<-180 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars.supply.chain,
parms = parameters,
method =intg.method )
plot(out,
xlab = "meses",
ylab =c(""))
- Describe la dinámica de comportamiento que resulta de integrar estas nuevas firmas al modelo para las siguientes variables: sales, inventory y workforce (30 puntos, productos: gráficos describiendo el comportamiento del sistema para las tres firmas, comentarios que describan el comportamiento del sistema)
Los gráficos pueden observarse en el punto anterior. Para la ensambladora el comportamiento no se ve modificado ya que ésta es la que define la demanda del proveedor nivel 1, que a su vez, con su producción define la demanda del proveedor nivel 2. En el caso de los proveedores nivel 1 y 2, tienen un comportamiento oscilatorio en las variables sales, inventory y workforce, que luego tiende al equilibrio. El proveedor nivel 2 presenta un comportamiento preocupante por los picos y valles en sus ventas y fuerza de trabajo. Estos comportamientos en el modelo responden a retrasos en la producción, cuya relevancia se eleva ya que de ella dependen las ventas del nivel inferior siguiente.
- Describe e implementa una política que ayude a disminuir la inestabilidad de la cadena de suministro. Compara en un mismo gráfico el comportamiento del sistema con y sin política (30 puntos, productos: gráficos describiendo el comportamiento del sistema para las tres formas con y sin política, comentarios que describan el comportamiento del sistema)
library("deSolve")
sports.cars.supply.chain <- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous auxiliary variables Assembler
target.inventory<-sales*inventory.coverage
inventory.correction<-(target.inventory-inventory)/time.to.correct.inventory
target.production<-sales+inventory.correction
target.workforce<-target.production/productivity.of.average.worker
#Flow variables Assembler
production<-workforce*productivity.of.average.worker
net.hire.rate<-(target.workforce-workforce)/time.to.adjust.workforce
#State (stock) variables Assembler
dinventory<-production-sales
dworkforce<-net.hire.rate
#Endogenous auxiliary variables Tier 1 supplier
target.inventory1<-production*inventory.coverage
inventory.correction1<-(target.inventory1-inventory1)/time.to.correct.inventory
target.production1<-production+inventory.correction1
target.workforce1<-target.production1/productivity.of.average.worker
sales1<-production
#Flow variables Tier 1 supplier
production1<-workforce1*productivity.of.average.worker
net.hire.rate1<-(target.workforce1-workforce1)/time.to.adjust.workforce
#State (stock) variables Tier 1 supplier
dinventory1<-production1-production
dworkforce1<-net.hire.rate1
#Endogenous auxiliary variables Tier 2 supplier
target.inventory2<-production1*inventory.coverage
inventory.correction2<-(target.inventory2-inventory2)/time.to.correct.inventory
target.production2<-production1+inventory.correction2
target.workforce2<-target.production2/productivity.of.average.worker
sales2<-production1
#Flow variables Tier 2 supplier
production2<-workforce2*productivity.of.average.worker
net.hire.rate2<-(target.workforce2-workforce2)/time.to.adjust.workforce
#State (stock) variables Tier 2 supplier
dinventory2<-production2-production1
dworkforce2<-net.hire.rate2
list(c(dinventory, dinventory1, dinventory2, dworkforce, dworkforce1, dworkforce2), sales=sales, sales1=sales1, sales2=sales2)
})
}
parameters<-c(sales=150, #cars per month
productivity.of.average.worker=2, #car pero person per month
inventory.coverage= 3, #months
time.to.correct.inventory= 2, #months
time.to.adjust.workforce=3#months
)
InitialConditions <- c(inventory= 300, #cars
inventory1= 300, #cars
inventory2= 300, #cars
workforce= 100, #people
workforce1= 100, #people
workforce2= 100) #people
ini.time<-0 #months
end.time<-60 #months
time.step<-1 #months
times <- seq(ini.time,
end.time,
time.step)
intg.method<-c("rk4")
out <- ode(y = InitialConditions,
times = times,
func = sports.cars.supply.chain,
parms = parameters,
method =intg.method )
plot(out,
xlab = "meses",
ylab =c(""))
Para lograr que las empresas en la cadena de suministro logren el equilibrio más rápido se proponen 2 políticas:
Programa de premios e incentivos económicos a los trabajadores que logren aumentar su productividad a 2 coches por persona por mes.
Reestructuración de los tiempos en los que las empresas realizan ajustes de personal (contrataciones/despidos), recomendación: 3 meses.
Con estas políticas, en aproximadamente 40 meses las 3 empresas estarían en equilibrio.