Modelación de Sistemas
Tarea 3 - Solución propuesta
25 de Marzo de 2020
Profesor: Dr. Edmundo Molina
Problema 1: Globalización y liberalización (100 puntos)
Considera la descripción del caso 18.19 de Pruyt (2003)
Responde a las siguientes preguntas
- Construye un modelo de dinámica de sistemas basado en el caso anterior, simula el modelo por un período de 50 años. Asegúrate que el modelo esté en equilibrio. (Envía tu modelo con la versión final de tu tarea)
library("deSolve")
parameters<-c(depreciation.rate.cI=0.05,
investment.rate.cI=0.1,
production.rate.cI=1.0,
market.volume.cI=1.0,
market.volume.cII=1.0,
tax.rate.cI=0.2,
resource.costs.cI= 1.0,
standard.factor.cI= 1.0,
deterioration.rate.cI=0.05,
reference.price.cI=5.0,
depreciation.rate.cII=0.05,
investment.rate.cII=0.1,
production.rate.cII=1.0,
market.volume.cII=1.0,
market.volume.cIII=1.0,
tax.rate.cII=0.2,
resource.costs.cII= 1.0,
standard.factor.cII= 1.0,
deterioration.rate.cII=0.05,
reference.price.cII=5.0
)
Initial.Conditions <- c(production.capacity.cI = 1.0,
standards.of.cI=1.0,
production.capacity.cII = 0.1,
standards.of.cII=0.1
)
globalization.and.liberalization<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#COUNTRY 1
#Endogenous variables
production.costs.cI<-standards.of.cI*standard.factor.cI
product.costs.cI<-resource.costs.cI+production.costs.cI
production.costs.cII<-standards.of.cII*standard.factor.cII
product.costs.cII<-resource.costs.cII+production.costs.cII
product.price.cI<-product.costs.cI*(1+tax.rate.cI)
product.price.cII<-product.costs.cII*(1+tax.rate.cII)
customs.duties.raised.by.cI<-ifelse(t<10,0.5,0)
subsidy.cII<-ifelse(t<10,0,0)
customs.duties.raised.by.cII<-ifelse(t<10,0,0)
subsidy.cI<-ifelse(t<10,0.75,0)
price.of.cII.products.in.cI<-product.price.cII*(1-subsidy.cII+customs.duties.raised.by.cI)
price.of.cI.products.in.cII<-product.price.cI*(1-subsidy.cI+customs.duties.raised.by.cII)
supply.cI<-production.capacity.cI*1*production.rate.cI
price.ratio.of.domestic.versus.imported.products.in.cI<-product.price.cI/price.of.cII.products.in.cI
price.ratio.of.domestic.versus.imported.products.in.cII<-product.price.cII/price.of.cI.products.in.cII
percentage.purchased.by.cI.from.cI<-approx(c(0.0,0.5,1.0,1.5,2.0,5.0),
c(1.0,1.0,0.5,0.0,0.0,0.0),
xout=price.ratio.of.domestic.versus.imported.products.in.cI)$y
percentage.purchased.by.cII.from.cII<- approx(c(0.0,0.5,1.0,1.5,2.0,5.0),
c(1.0,1.0,0.5,0.0,0.0,0.0),
xout=price.ratio.of.domestic.versus.imported.products.in.cII)$y
demand.for.products.from.cI<-percentage.purchased.by.cI.from.cI*market.volume.cI+market.volume.cII*(1-percentage.purchased.by.cII.from.cII)
surplus.cI<-supply.cI-demand.for.products.from.cI
investment.factor.cI<-2
investment.function.cI<-ifelse(t<10,2,investment.factor.cI)
investments.cI<-ifelse(surplus.cI<=0, investment.rate.cI*production.capacity.cI*investment.function.cI, 0)
progress.factor.cI<-2
progress.function.cI<-ifelse(t<10,2,progress.factor.cI)
investments.in.progress.cI<-investments.cI*progress.function.cI
progress.cI<-standards.of.cI*investments.in.progress.cI*(1-product.price.cI/reference.price.cI)
#Flow variables
depreciation.cI<-depreciation.rate.cI*production.capacity.cI
deterioration.cI<-standards.of.cI*deterioration.rate.cI
#State variables
dproduction.capacity.cI<-investments.cI-depreciation.cI #porcentaje
dstandards.of.cI<-progress.cI-deterioration.cI
#COUNTRY 2
#Endogenous variables
supply.cII<-production.capacity.cII*1*production.rate.cII
product.price.cII<-product.costs.cII*(1+tax.rate.cII)
demand.for.products.from.cII<-percentage.purchased.by.cII.from.cII*market.volume.cII+market.volume.cI*(1-percentage.purchased.by.cI.from.cI)
surplus.cII<-supply.cII-demand.for.products.from.cII
investment.factor.cII<-2
investment.function.cII<-ifelse(t<10,0.2,2)
investments.cII<-ifelse(surplus.cII<=0, investment.rate.cII*production.capacity.cII*investment.function.cII, 0)
progress.factor.cII<-2
progress.function.cII<-ifelse(t<10,1,2)
investments.in.progress.cII<-investments.cII*progress.function.cII
progress.cII<-standards.of.cII*investments.in.progress.cII*(1-product.price.cII/reference.price.cII)
#Flow variables
depreciation.cII<-depreciation.rate.cII*production.capacity.cII
deterioration.cII<-standards.of.cII*deterioration.rate.cII
#State variables
dproduction.capacity.cII<-investments.cII-depreciation.cII #porcentaje
dstandards.of.cII<-progress.cII-deterioration.cII
list(c(dproduction.capacity.cI,dstandards.of.cI,dproduction.capacity.cII,dstandards.of.cII), investments.cI=investments.cI, investments.cII=investments.cII)
})
}
times<-seq(0, #initialtime
50, #tiempo final
1)#número de repetición de puntos)
intg.method<-c("rk4")
out <- ode(y = Initial.Conditions,
times = times,
func = globalization.and.liberalization,
parms = parameters,
method =intg.method)- Gráfica los efectos sobre production capacity y standards para los dos países.
plot(out, mfrow = c(1, 2), col = c("blue"))
- Asume que el t=10 el comercio se liberaliza. ¿Qué sucede en los dos países? Explica
Como puede observarse en la capacidad de producción del país I se desploma tras la liberación del mercado. Esto se debe al incremento de las inversiones en el país II, variable que incentiva directamente el crecimiento de la capacidad de producción del país II.
La capacidad de producción y los estandares del país 2 estan a la baja debido a que la globalización es necesaria para detonar un cambio en las funciones de inversión y progreso, ambas variables de estado estan en funcion de inversión y progreso respectivamente, por tanto la globalizacion es determinante para que el país 2 alcance estabilidad.
Respecto al país 1, la globalizacion no tiene ningún efecto en los factores de inversión y progreso, sin embargo, a raiz de la liberación del mercado, el subsidio del producto del país 1 en el país dos se elimina (pasa de 50% a 0), lo que incrementa su precio, afectando finalmente la decision de compra del país 2, asimismo, el impuesto aduanal del país 1 pasa de 75% a 0, lo que repercute en el precio del producto del país 2 en el país 1, el precio se reduce lo que a su ves tiene un fuerte impacto en la decision de compra del pais 1.
En resumen, estas afectaciones se reflejan en variaciones en la diferencia entre oferta y demanda de cada país, lo que posteriormente condiciona los factores de inversión y progreso, mismos de los que depende el comportamiento en el tiempo de la capacidad de producción y estandares para ambos países.
- Construye un diagrama causal del modelo o un diagrama stock-and-flow simplificado. Emplea este diagrama para describir el comportamiento que observas.
- Construye un diagrama de fase que englobe los principales elementos dinámicos del modelo. ¿Qué trayectoria sigue el sistema si inicia bajo diferentes condiciones iniciales?, ¿cuántos puntos de equilibrio identificas?, ¿son estables o inestables?
plot(out[,"production.capacity.cI"], out[,"investments.cI"], xlab="production.capacity.cI", ylab = "investments.cI", type = "p", lwd = 2, main="Diagrama de fase, paæ¼ã¹¤s I")
plot(out[,"production.capacity.cII"], out[,"investments.cII"], xlab="production.capacity.cII", ylab = "investments.cII", type = "p", lwd = 2, main="Diagrama de fase, paæ¼ã¹¤s II")
Los sistemas tienen una trayectoria lineal, en el caso del país I existen varios puntos de equilibrio que se alcanzan cuando su capacidad de producción llega al 75% y 115%, teniendo una inestabilidad. Para el caso del país II se puede identificar plenamente que el equilibrio se alcanza hasta que la capacidad de producción llega hasta aproximadamente 135%, presentando un comportamiento estable.
Problema 2: Colapso de Civilizaciones (100 puntos)
Considera la descripción del caso 18.22 de Pruyt (2003)
Responde a las siguientes preguntas
- Construye un modelo de dinámica de sistemas basado en el caso anterior. Calcula el valor de los exponentes y las variables de flujo omitidas de tal manera que el colapso de la población Maya ocurra en el año 800. Simula 2000 años de evolución iniciando en el año 1,000 A.C. (Envía tu modelo con la versión final de tu tarea)
library("deSolve")
collapse.of.civilizations<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -1*fertility.losses
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
parameters<-c(intensity=1,
emigration.ratio=0.05,
consumed.food.per.person=200, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
InitialConditions <- c(forest = 5000,
agricultural.land=8,
fertility.of.lands=5000000,
population=100000)
times <- seq(-1000, #initial time
1000, #end of simulation
1) #time step
intg.method<-c("rk4")
#Simulate model
out2 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters,
method =intg.method )- ¿Qué pasa con la población? Gráfica el comportamiento de esta variable, ¿corresponde el comportamiento de tu modelo al comportamiento observado?
plot(out2, mfrow = c(1, 3), col = c("red"))
La población empieza a decrecer drásticamente hasta su desaparición alrededor del año 800 (según se solicitó en el punto anterior).
- Introduce cambios en el modelo que hagan más realista su comportamiento
library("deSolve")
collapse.of.civilizations<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -1*fertility.losses
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
parameters<-c(intensity=1.2,
emigration.ratio=0.01,
consumed.food.per.person=150, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
InitialConditions <- c(forest = 5000,
agricultural.land=8,
fertility.of.lands=5000000,
population=100000)
times <- seq(-1000, #initial time
1000, #end of simulation
1) #time step
intg.method<-c("rk4")
#Simulate model
out2 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters,
method =intg.method )
plot(out2, mfrow = c(1, 3), col = c("green"))
Se aumentó la intensidad en 20%, la emigración se redujo al 1% y el consumo de comida por persona a 150 kg anuales. Con esto se puede ver un retraso en el tiempo de colpaso.
- ¿Qué tan sensible es el modelo a cambios marginales en los parámetros o a cambios estructurales? Presenta al menos dos ejemplos.
Modelo con cambios marginales
library("deSolve")
collapse.of.civilizations<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -1*fertility.losses
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
parameters<-c(intensity=1.2,
emigration.ratio=0.01,
consumed.food.per.person=100, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
parameters2<-c(intensity=1.3,
emigration.ratio=0.02,
consumed.food.per.person=150, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
parameters3<-c(intensity=1.4,
emigration.ratio=0.03,
consumed.food.per.person=200, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
InitialConditions <- c(forest = 5000,
agricultural.land=8,
fertility.of.lands=5000000,
population=100000)
times <- seq(-1000, #initial time
2000, #end of simulation
1) #time step
intg.method<-c("rk4")
#Simulate model
out2 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters,
method =intg.method )
out3 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters2,
method =intg.method )
out4 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters3,
method =intg.method )
plot(out2, out3, out4, mfrow = c(1, 3), col = c("green", "red", "blue"))
Ante cambios marginales el comportamiento es el mismo, sólo se retrasan los efectos.
Modelo con cambios estructurales
library("deSolve")
collapse.of.civilizations<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -1*fertility.losses
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
collapse.of.civilizations2<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
fertility.recuperation<-0.6*fertility.losses
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -0.5*fertility.losses+fertility.recuperation
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
parameters<-c(intensity=1.2,
emigration.ratio=0.01,
consumed.food.per.person=100, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
InitialConditions <- c(forest = 5000,
agricultural.land=8,
fertility.of.lands=5000000,
population=100000)
times <- seq(-1000, #initial time
5000, #end of simulation
1) #time step
intg.method<-c("rk4")
#Simulate model
out2 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters,
method =intg.method )
out3 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations2,
parms = parameters,
method =intg.method )
plot(out2, out3, mfrow = c(1, 3), col = c("green", "red"))
El modelo es muy sensible ante cambios estructurales. Agregando variables que pudieran contrarestar el efecto negativo de otras, pueden provocar que el modelo no llegue al colapso. En este caso se modificó la forma en que se calculó la fertilidad de la tierra agregando una nueva variable llamada recuperación de fertilidad, evitando de esta forma que el modelo colapse.
- Propón una política (i.e. preferentemente una política dinámica) que evite el colapso de la civilización Maya. Implementa esta política en el modelo y compara gráficamente el comportamiento del sistema con y sin tu política.
library("deSolve")
collapse.of.civilizations<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -1*fertility.losses
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
collapse.of.civilizations2<- function(t, state, parameters) {
with(as.list(c(state,parameters)), {
#Endogenous variables
food.produced<-fertility.of.lands*agricultural.land
demand.for.food<-consumed.food.per.person*population
gap<-demand.for.food-food.produced
#Flow variables
deforestation<-min(gap/max(fertility.of.lands,1),forest/4)/intensity
fertility.losses<-fertility.of.lands*min(2,(agricultural.land/forest)^1.5)/intensity
natural.population.increase<-population*natural.increase.rate
emigration<-(gap/consumed.food.per.person)*emigration.ratio
fertility.recuperation<-0.5*fertility.losses
#stock variables
dagricultural.land<- deforestation
dforest<- -1*deforestation
dfertility.of.lands<- -0.5*fertility.losses+fertility.recuperation
dpopulation<-natural.population.increase-emigration
list(c(dforest, dagricultural.land, dfertility.of.lands, dpopulation), deforestation=deforestation, fertility.losses=fertility.losses)
})
}
parameters<-c(intensity=1.2,
emigration.ratio=0.01,
consumed.food.per.person=100, #kg per person per year
natural.increase.rate=(2^(1/408)-1))
InitialConditions <- c(forest = 5000,
agricultural.land=8,
fertility.of.lands=5000000,
population=100000)
times <- seq(-1000, #initial time
2000, #end of simulation
1) #time step
intg.method<-c("rk4")
#Simulate model
out2 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations,
parms = parameters,
method =intg.method )
out3 <- ode(y = InitialConditions,
times = times,
func = collapse.of.civilizations2,
parms = parameters,
method =intg.method )
plot(out2, out3, mfrow = c(1, 3), col = c("green", "red"))
La política propuesta para evitar el colpaso es fomentar la recuperación de la fertilidad, mediante la recuperación de al menos 50% de las pérdidas de fertilidad por la deforestación. Con esta política se logra evitar el colapso del modelo.
- Construye un diagrama de fase del modelo sin política. ¿Cuál es tu conclusión?, ¿cómo cambia este diagrama de fase con tu política?
plot(out2[,"population"], out2[,"fertility.losses"], xlab="population", ylab = "fertility.losses", type = "p", lwd = 2)
plot(out3[,"population"], out2[,"fertility.losses"], xlab="population", ylab = "fertility.losses", type = "p", lwd = 2)
Se puede observar claramente que aunque la perdida de fertilidad no ha sufrido cambios, la implementación de la política ha permitido que el incremento de la población se de mejor forma.