Version 5 (13 countries & 3 Xs)(Last week)
############## Version 5
#load data
combined_data <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vTCR15LDjmHoVC3cWEbYbOyXQhTgncTbqO9V-PWmYBEvNZj5fjOLYFJBgAWFB1eSgiCRxT8HtX7MTAk/pub?output=csv")
# filtering country as a unit
library(dplyr)
filter_data <- combined_data %>%
filter(year >= 1986 & year <= 2005) %>%
filter(!is.na(life_expectancy)) %>%
group_by(country) %>%
filter(!(any(is.na(infant_mortality[year >= 1986 & year <= 1995])))) %>%
filter(!(any(is.na(gdp_per_capita[year >= 1986 & year <= 1995])))) %>%
filter(!(any(is.na(physicians[year >= 1986 & year <= 1995])))) %>%
filter(n() == 20) %>%
ungroup()
# SCM
library(Synth )
filter_data <- as.data.frame(filter_data)
country_unit_all <- unique(filter_data$unit.num)
country_unit_control <- setdiff(country_unit_all, c(100,238))
dataprep.out <-
dataprep(
foo = filter_data,
predictors = c("gdp_per_capita","infant_mortality","physicians"),
predictors.op = "mean",
dependent = "life_expectancy",
unit.variable = "unit.num",
unit.names.variable = "country",
time.variable = "year",
treatment.identifier = 238,
controls.identifier = country_unit_control,
time.predictors.prior = c(1986:1995),
time.optimize.ssr = c(1986:1995),
time.plot = 1986:2005
)
# SCM result
synth.out <- synth(dataprep.out)
##
## X1, X0, Z1, Z0 all come directly from dataprep object.
##
##
## ****************
## searching for synthetic control unit
##
##
## ****************
## ****************
## ****************
##
## MSPE (LOSS V): 0.02309512
##
## solution.v:
## 0.166419 0.001201041 0.83238
##
## solution.w:
## 0.2333782 4.8946e-05 0.1715912 7.02095e-05 6.12505e-05 0.0001048732 0.0001523125 7.43668e-05 0.593918 0.0005110849 5.47351e-05 3.47795e-05
synth.tables <- synth.tab(
dataprep.res = dataprep.out,
synth.res = synth.out)
synth.tables$tab.pred
## Treated Synthetic Sample Mean
## gdp_per_capita 8797.800 8941.194 18702.115
## infant_mortality 4.368 11.291 8.707
## physicians 1.123 1.124 2.311
synth.tables$tab.w
## w.weights unit.names unit.numbers
## 14 0.233 Australia 14
## 22 0.000 Belgium 22
## 39 0.172 Canada 39
## 84 0.000 France 84
## 105 0.000 Hungary 105
## 107 0.000 Iceland 107
## 127 0.000 Korea, Rep. 127
## 147 0.000 Luxembourg 147
## 151 0.594 Malaysia 151
## 176 0.001 New Zealand 176
## 235 0.000 Sweden 235
## 236 0.000 Switzerland 236
synth.tables$tab.loss
## Loss W Loss V
## [1,] 0.00474858 0.02309512
#Plot
path.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Life expectancy at birth",
Xlab="Year",
Ylim = c(70,82),
Legend=c("Taiwan","Synthetic Taiwan"),
Legend.position="bottomright",
Main = "SCM Version 5"
)
abline(v=1995, lty=2)
arrows(1995, 78, 1993, 78,
col = "black",
length = .1)
text(1991, 78,
"NHI Policy",
cex = 1)
gaps.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Gap of life expectancy",
Xlab="Year"
)
abline(v=1995, lty=2)
arrows(1995, 1, 1993, 1,
col = "black",
length = .1)
text(1991, 1,
"NHI Policy",
cex = 1)
Version 6 (21 countries & 3 Xs)(New progress)
##############
#load data
combined_data <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vTCR15LDjmHoVC3cWEbYbOyXQhTgncTbqO9V-PWmYBEvNZj5fjOLYFJBgAWFB1eSgiCRxT8HtX7MTAk/pub?gid=52113182&single=true&output=csv")
# filtering country as a unit
library(dplyr)
filter_data <- combined_data %>%
filter(year >= 1986 & year <= 2005) %>%
filter(!is.na(life_expectancy)) %>%
group_by(country) %>%
filter(!(any(is.na(infant_mortality[year >= 1987 & year <= 1995])))) %>%
filter(!(any(is.na(gdp_per_capita[year >= 1987 & year <= 1995])))) %>%
filter(!(any(is.na(physicians[year >= 1987 & year <= 1995])))) %>%
filter(n() == 20) %>%
ungroup()
# SCM
library(Synth )
filter_data <- as.data.frame(filter_data)
country_unit_all <- unique(filter_data$unit.num)
country_unit_control <- setdiff(country_unit_all, c(100,213,238))
dataprep.out <-
dataprep(
foo = filter_data,
predictors = c("gdp_per_capita","infant_mortality","physicians"),
predictors.op = "mean",
dependent = "life_expectancy",
unit.variable = "unit.num",
unit.names.variable = "country",
time.variable = "year",
treatment.identifier = 238,
controls.identifier = country_unit_control, #c(14,22,39, 84, 88, 105, 107, 127, 147, 151, 176, 202, 213, 235, 236, 248, 252)
time.predictors.prior = c(1986:1995),
time.optimize.ssr = c(1986:1995),
time.plot = 1986:2005
)
# SCM result
synth.out <- synth(dataprep.out)
##
## X1, X0, Z1, Z0 all come directly from dataprep object.
##
##
## ****************
## searching for synthetic control unit
##
##
## ****************
## ****************
## ****************
##
## MSPE (LOSS V): 0.02677698
##
## solution.v:
## 0.2466577 0.05742318 0.6959191
##
## solution.w:
## 0.3018694 9.72626e-05 9.71734e-05 0.002050282 5.26176e-05 0.0001349936 1.45689e-05 0.0001023502 0.0003281362 9.52523e-05 1.832e-07 0.5602892 1.29e-08 4.19582e-05 0.0001000716 1.38299e-05 8.1372e-06 1.10316e-05 5.68765e-05 0.1346367
synth.tables <- synth.tab(
dataprep.res = dataprep.out,
synth.res = synth.out)
synth.tables$tab.pred
## Treated Synthetic Sample Mean
## gdp_per_capita 8797.800 9052.261 14815.551
## infant_mortality 4.368 11.217 16.452
## physicians 1.123 1.125 2.514
synth.tables$tab.w
## w.weights unit.names unit.numbers
## 14 0.302 Australia 14
## 15 0.000 Austria 15
## 22 0.000 Belgium 22
## 39 0.002 Canada 39
## 59 0.000 Denmark 59
## 84 0.000 France 84
## 88 0.000 Georgia 88
## 105 0.000 Hungary 105
## 107 0.000 Iceland 107
## 127 0.000 Korea, Rep. 127
## 147 0.000 Luxembourg 147
## 151 0.560 Malaysia 151
## 176 0.000 New Zealand 176
## 202 0.000 Romania 202
## 235 0.000 Sweden 235
## 236 0.000 Switzerland 236
## 247 0.000 Turkiye 247
## 248 0.000 Turkmenistan 248
## 252 0.000 Ukraine 252
## 254 0.135 United Kingdom 254
synth.tables$tab.loss
## Loss W Loss V
## [1,] 0.009484183 0.02677698
#Plot
path.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Life expectancy at birth",
Xlab="Year",
Ylim = c(72,78),
Legend=c("Taiwan","Synthetic Taiwan"),
Legend.position="bottomright",
Main = "SCM Version 6"
)
abline(v=1995, lty=2)
arrows(1995, 76, 1993, 76,
col = "black",
length = .1)
text(1991, 76,
"NHI Policy",
cex = 1)
gaps.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Gap of life expectancy",
Xlab="Year"
)
abline(v=1995, lty=2)
arrows(1995, 1, 1993, 1,
col = "black",
length = .1)
text(1991, 1,
"NHI Policy",
cex = 1)
Placebo in time
library(Synth )
filter_data <- as.data.frame(filter_data)
country_unit_all <- unique(filter_data$unit.num)
country_unit_control <- setdiff(country_unit_all, c(100,213,238))
dataprep.out <-
dataprep(
foo = filter_data,
predictors = c("gdp_per_capita","infant_mortality","physicians"),
predictors.op = "mean",
dependent = "life_expectancy",
unit.variable = "unit.num",
unit.names.variable = "country",
time.variable = "year",
treatment.identifier = 238,
controls.identifier = country_unit_control, #c(14,22,39, 84, 88, 105, 107, 127, 147, 151, 176, 202, 213, 235, 236, 248, 252)
time.predictors.prior = c(1986:1990),
time.optimize.ssr = c(1986:1990),
time.plot = 1986:2005
)
# SCM result
synth.out <- synth(dataprep.out)
##
## X1, X0, Z1, Z0 all come directly from dataprep object.
##
##
## ****************
## searching for synthetic control unit
##
##
## ****************
## ****************
## ****************
##
## MSPE (LOSS V): 0.03360987
##
## solution.v:
## 0.007428031 0.01428303 0.9782889
##
## solution.w:
## 0.1367539 0.0005394139 0.000356744 0.0005589364 0.0003164573 0.0002821782 9.42169e-05 0.0003453144 0.0005623129 0.0004304337 1.5e-09 0.5109359 5.7766e-06 0.0003181318 0.0004099542 9.43299e-05 4.53319e-05 7.41631e-05 8.47859e-05 0.3477917
synth.tables <- synth.tab(
dataprep.res = dataprep.out,
synth.res = synth.out)
synth.tables$tab.pred
## Treated Synthetic Sample Mean
## gdp_per_capita 6314.800 8372.875 12676.444
## infant_mortality 4.248 12.319 17.868
## physicians 1.014 1.015 2.414
synth.tables$tab.w
## w.weights unit.names unit.numbers
## 14 0.137 Australia 14
## 15 0.001 Austria 15
## 22 0.000 Belgium 22
## 39 0.001 Canada 39
## 59 0.000 Denmark 59
## 84 0.000 France 84
## 88 0.000 Georgia 88
## 105 0.000 Hungary 105
## 107 0.001 Iceland 107
## 127 0.000 Korea, Rep. 127
## 147 0.000 Luxembourg 147
## 151 0.511 Malaysia 151
## 176 0.000 New Zealand 176
## 202 0.000 Romania 202
## 235 0.000 Sweden 235
## 236 0.000 Switzerland 236
## 247 0.000 Turkiye 247
## 248 0.000 Turkmenistan 248
## 252 0.000 Ukraine 252
## 254 0.348 United Kingdom 254
synth.tables$tab.loss
## Loss W Loss V
## [1,] 0.003239071 0.03360987
#Plot
path.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Life expectancy at birth",
Xlab="Year",
Ylim = c(72,78),
Legend=c("Taiwan","Synthetic Taiwan"),
Legend.position="bottomright",
Main = "SCM Version 6_Placebo implementation in 1990"
)
abline(v=1995, lty=2)
arrows(1995, 76, 1993.5, 76,
col = "black",
length = .1)
text(1992, 76,
"NHI Policy",
cex = 1)
abline(v=1990, lty=2)
arrows(1990, 76, 1988.5, 76,
col = "black",
length = .1)
text(1987.2, 76,
"Placebo",
cex = 1)
gaps.plot(dataprep.res = dataprep.out,
synth.res = synth.out,
Ylab="Gap of life expectancy",
Xlab="Year"
)
abline(v=1995, lty=2)
arrows(1995, 1, 1993, 1,
col = "black",
length = .1)
text(1991.5, 1,
"NHI Policy",
cex = 1)
abline(v=1990, lty=2)
arrows(1990, 1, 1988.5, 1,
col = "black",
length = .1)
text(1987.2, 1,
"Placebo",
cex = 1)
