ECON 413
Animations and simulation
Erol Taymaz
Department of Economics
Middle East Technical University
# Download the data
pwt <- read_stata("http://www.rug.nl/ggdc/docs/pwt90.dta")
# Make the data a data.table object
pwt <- data.table(pwt)
# Select a subset of variables
pwts <- pwt[, list(countrycode, year, rgdpo, pop, emp, avh, hc, rgdpna, rkna)]
# Structure
str(pwts)
## Classes 'data.table' and 'data.frame': 11830 obs. of 9 variables:
## $ countrycode: chr "ABW" "ABW" "ABW" "ABW" ...
## ..- attr(*, "label")= chr "3-letter ISO country code"
## ..- attr(*, "format.stata")= chr "%9s"
## $ year : num 1950 1951 1952 1953 1954 ...
## ..- attr(*, "label")= chr "Year"
## ..- attr(*, "format.stata")= chr "%9.0g"
## $ rgdpo : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Output-side real GDP at chained PPPs (in mil. 2011US$)"
## ..- attr(*, "format.stata")= chr "%14.3g"
## $ pop : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Population (in millions)"
## ..- attr(*, "format.stata")= chr "%10.0g"
## $ emp : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Number of persons engaged (in millions)"
## ..- attr(*, "format.stata")= chr "%9.0g"
## $ avh : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Average annual hours worked by persons engaged (source: The Conference Board)"
## ..- attr(*, "format.stata")= chr "%10.0gc"
## $ hc : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Human capital index, see note hc"
## ..- attr(*, "format.stata")= chr "%9.0g"
## $ rgdpna : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Real GDP at constant 2011 national prices (in mil. 2011US$)"
## ..- attr(*, "format.stata")= chr "%14.3g"
## $ rkna : num NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "label")= chr "Capital stock at constant 2011 national prices (in mil. 2011US$)"
## ..- attr(*, "format.stata")= chr "%14.3g"
## - attr(*, ".internal.selfref")=<externalptr>
pwts[, tr := countrycode == "TUR"]
ggplot(pwts, aes(x=hc, y=gdpc, size=pop, color = tr)) + geom_point()
# SIR model of Covid-19
# Parameters
# The user can change these parameters
# R0 <- 3.5 # Basic reproduction number (the average number of people
# infected by one infectious individual
# pgun <- 200 # When the policy is applied (days)
# petki <- 0 # Policy effectiveness
# 0 means full effect, 100 means no effect,
# After policy, R0 is reduced by petki percent,
# i.e., R0 becomes R0*petki/100
# Constants
h_sure <- 15 # Duration of sickness, days
d_sure <- 15 # Duration of hospitalization, days
v_oran <- 10 # Death ratio, percent
N <- 1000 # Initial population
t <- 120 # İterasyon gün sayısı
# Cimulation function
covidSimul <- function(R0, pgun, petki) {
# Set variables
S <- I <- R <- V <- K <- rep(0, t)
N <- rep(N, t)
# Simulation starts...
S[1] <- N[1] - 1
I[1] <- 1
for (i in c(2:t)) {
pe <- ifelse(i >= pgun, petki / 100, 1)
ii <- ((R0 * pe)/h_sure)*S[i-1]*I[i-1]/(N[i-1] - V[i-1])
rr <- I[i-1]/d_sure
vv <- rr*(v_oran/100)
kk <- rr - vv
S[i] <- S[i-1] - ii
I[i] <- I[i-1] + ii - rr
R[i] <- R[i-1] + rr
V[i] <- V[i-1] + vv
K[i] <- K[i-1] + kk
}
dtab <- data.table(gun = c(1:t), S=S, I=I, R=R, V=V, K=K)
return(dtab)
}
# Graphics function
simSekil <- function(veri, title, subtitle) {
g1 <- ggplot(veri, aes(x = gun)) +
geom_line(aes(y=S, color = "Healthy"), size = 1.5) +
geom_line(aes(y=I, color = "Sick"), size = 1.5) +
geom_line(aes(y=V, color = "Dead"), size = 1.5) +
geom_line(aes(y=K, color = "Recovered"), size = 1.5) +
labs(title = title, subtitle = subtitle,
y = "Number of people", x = "Day") +
theme_bw() +
scale_color_manual(name = NULL,
values= c("Healthy" = "blue",
"Sick" = "red",
"Dead" = "black",
"Recovered" = "orange"))
return(g1)
}
#
sim_results <- covidSimul(3.5, 200, 0)
simSekil(sim_results, "Covid-19 simulation results", "No policy")