This report presents the data analysis for “Studying Policy Design Quality in Comparative Perspective”, published in the American Review of Political Science.
First it contains a brief chapter with the description of the data, and reproduces the figures in the article and the online appendix.
Then in contains two chapters on the analysis of environmental performance, one with the main model and another one with the robustness check from a variation of the main model.
Later, it contains four chapters on the analysis of portfolio diversity, one with the main model and three more with various robustness checks for different specifications.
Finally, one chapter compares the different robustness models of portfolio diversity against the main model.
library(PolicyPortfolios)
data(consensus)
Show the portfolios of selected countries / years for illustration purposes.
consensus %>%
D <- filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures()
consensus %>%
consensus.without.labels <- mutate(Target = as.factor(as.numeric(Target))) %>%
mutate(Instrument = as.factor(as.numeric(Instrument)))
pp_array(filter(consensus, Sector == "Environmental" & Country == "France" & Year == 1976), return_matrix = TRUE)
rM <-
.1976 <- round(D$value[D$Country == "France" & D$Year == 1976 & D$Sector == "Environmental" & D$Measure == "Div.aid"], 3)
manual.aid.fr.2005 <- round(D$value[D$Country == "France" & D$Year == 2005 & D$Sector == "Environmental" & D$Measure == "Div.aid"], 3)
manual.aid.fr.1976 <- round(D$value[D$Country == "United States" & D$Year == 1976 & D$Sector == "Environmental" & D$Measure == "Div.aid"], 3)
manual.aid.us.2005 <- round(D$value[D$Country == "United States" & D$Year == 2005 & D$Sector == "Environmental" & D$Measure == "Div.aid"], 3)
manual.aid.us
# France: growth in size and diversity
pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")),
f1 <-id = list(Country = "France", Year = 1976),
subtitle = FALSE, caption = "") +
labs(subtitle = paste0("AID: ", manual.aid.fr.1976)) +
theme(plot.subtitle = element_text(size = 3.0))
pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")),
f2 <-id = list(Country = "France", Year = 2005),
subtitle = FALSE, caption = "") +
labs(subtitle = paste0("AID: ", manual.aid.fr.2005)) +
theme(plot.subtitle = element_text(size = 3.0))
#grid.arrange(f1, f2, ncol = 2)
pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")),
f3 <-id = list(Country = "United States", Year = 1976),
subtitle = FALSE, caption = "") +
labs(subtitle = paste0("AID: ", manual.aid.us.1976)) +
theme(plot.subtitle = element_text(size = 3.0))
pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")),
f4 <-id = list(Country = "United States", Year = 2005),
subtitle = FALSE, caption = "") +
labs(subtitle = paste0("AID: ", manual.aid.us.2005)) +
theme(plot.subtitle = element_text(size = 3.0))
#grid.arrange(f1, f2, ncol = 2)
grid.arrange(f1, f2, f3, f4, ncol = 2)
Figure 1: Example portfolios comparing Average Instrument Diversity. France: +size +diversity; United States: +size =diversity.
Description of the distribution of Average Instrument Diversity.
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures() %>%
filter(Measure == "Div.aid") %>%
select(Country, Year, Measure.label, value) %>%
spread(Measure.label, value) %>%
ggplot(aes(y = reorder(Country, `Diversity (Average Instrument Diversity)`, mean))) +
geom_boxplot(aes(x = `Diversity (Average Instrument Diversity)`)) +
expand_limits(x = c(0, 1)) +
xlab("Average Instrument Diversity") +
ylab("Country")
Figure 2: Descriptive statistics for portfolio diversity (Average Instrument Diversity). Environmental sector.
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures() %>%
filter(Measure == "Div.aid") %>%
ggplot(aes(x = Year, y = value)) +
geom_line() +
ylab("Diversity (Average Instrument Diversity") +
facet_wrap(~ Country) +
ggtitle("Diversity (Average Instrument Diversity)")
Figure 3: Temporal evolution of average instrument diversity, by country.
Several measures of diversity, compared
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures() %>%
filter(Measure %in% c("Size", "Div.aid", "Div.gs", "C.eq", "Eq.sh")) %>%
mutate(Measure = Measure.label) %>%
select(Country, Sector, Year, Measure, value) %>%
spread(Measure, value) %>%
gather(Measure, Diversity, -c(Country, Sector, Year,
`Diversity (Average Instrument Diversity)`,
`Portfolio size`)) %>%
ggplot(aes(x = `Diversity (Average Instrument Diversity)`,
y = Diversity,
color = Measure,
size = `Portfolio size`)) +
geom_point(alpha = 0.5) +
facet_grid(Measure ~ Sector)
Figure 4: Average instrument diversity compared against other measures of diversity, by sector.
library(PolicyPortfolios)
data(consensus)
consensus %>%
ca <- filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures() %>%
filter(Measure %in% c("Div.aid", "Size")) %>%
select(-Measure.label) %>%
spread(Measure, value) %>%
rename(Diversity = Div.aid)
country.coverage <- as.character(levels(ca$Country))
countries <- length(countries)
nC <- range(ca$Year)
years <-save(countries, years, country.coverage, file = "details.RData")
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
as.character(levels(ca$Country))
countries <-load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "Korea, Republic of"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
V-Dem:
load("vdem/v_dem-ra-1950_2018.RData") # loads vdem
Government effectiveness. Data retrieved manually from the World Bank page on Governance indicators. Only the “Government Effectiveness: Estimation” is used. The data is only available between 1996 and 2005.
load("wgi/government_effectiveness.RData")
gov.eff
gov.eff.original <-$country <- as.character(gov.eff.original$country)
gov.eff.original$country[gov.eff.original$country=="Korea, Rep."] <- "Korea, Republic of"
gov.eff.original$country <- as.character(gov.eff.original$country)
gov.eff.original
gov.eff.original %>%
gov.eff.l <- rename(gov.eff = value) %>%
gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE))
Political constraints
load("./polcon/polcon2017.RData") # loads polcon
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("./manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "Korea, Republic of"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <-#v <- weighted.mean(series$p.seats, diff(c(as.Date("1976-01-01"), series$date)))
weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
Save and arrange for analysis.
perf %>%
d.perf <- # Delete Turkey and Korea
filter(!Country %in% c("Korea, Republic of", "Turkey")) %>%
# Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y <- dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <-
dimnames(Y)[[1]]
indicator.label <- dimnames(Y)[[2]]
sector.label <- length(indicator.label)
nI <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
ca %>%
diversity <- select(Sector, Country, Year, Diversity) %>%
# Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Sector == "Environmental") %>%
filter(Year >= 1980 & Year <= 2005) %>%
select(-Sector) %>%
droplevels() %>%
reshape2::acast(Country ~ Year, value.var = "Diversity")
if ( length(which(!dimnames(diversity)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(urban = std(urban)) %>%
reshape2::acast(country ~ year, value.var = "urban")
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(industry = std(industry)) %>%
reshape2::acast(country ~ year, value.var = "industry")
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-
wdi %>%
trade <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(trade = std(trade)) %>%
reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
vdem %>%
deliberation <- mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "United States of America", "United States", Country)) %>%
mutate(Country = ifelse(Country == "Germany (RDA)", "Germany", Country)) %>%
filter(Democracy == "Deliberative") %>%
filter(Country %in% country.label) %>%
filter(Year >= 1980 & Year <= 2005) %>%
mutate(value = std(value)) %>%
select(Country, Year, value) %>%
reshape2::acast(Country ~ Year, value.var = "value")
if ( length(which(!dimnames(deliberation)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
polcon %>%
constraints <- mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(polcon = std(polcon)) %>%
select(country.polity, year, polcon) %>%
reshape2::acast(country.polity ~ year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = year.label.numeric) %>%
gov.eff <- left_join(gov.eff.original) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(value = std(value)) %>%
select(country, year, value) %>%
reshape2::acast(country ~ year, value.var = "value")
if ( length(which(!dimnames(gov.eff)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
ca %>%
portfolio.size <- filter(Sector == "Environmental") %>%
filter(Country %in% country.label) %>%
filter(Year >= 1980 & Year <= 2005) %>%
mutate(Size = std(logit(Size))) %>%
ungroup() %>%
reshape2::acast(Country ~ Year, variable.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
cpm %>%
green.socialist <- ungroup() %>%
mutate(calendar.year = as.numeric(format(date, "%Y"))) %>%
mutate(calendar.month = as.numeric(format(date, "%m"))) %>%
mutate(year = ifelse(calendar.month > 6, calendar.year + 1, calendar.year)) %>%
# Manually delete some elections that are held too close
# and assigned both to the same year
# Delete the first one, as in case of instability it is unlikely
# that they have passed legislation
filter(!(country == "Japan" & date == as.Date("1979-10-07"))) %>%
filter(!(country == "Greece" & date == as.Date("1989-11-05"))) %>%
filter(!(country == "Denmark" & date == as.Date("1987-09-08"))) %>%
#
select(country, year, family, p.seats) %>%
full_join(expand.grid(country = country.label,
year = (min(year.label.numeric)-5):max(year.label.numeric),
family = c("Socialist", "Green"))) %>%
group_by(country, family) %>%
arrange(country, family, year) %>%
# A bit clumsy, but works
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
ungroup() %>%
select(country, year, family, p.seats) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(p.seats = ifelse(is.na(p.seats), 0, p.seats)) %>%
group_by(family) %>%
mutate(p.seats = std(p.seats)) %>%
ungroup() %>%
unique() %>%
reshape2::acast(family ~ country ~ year, value.var = "p.seats")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
if (!dimnames(green.socialist)[[1]][1] == "Green" & sector.label[1] == "Environmental") stop("Ep! There is a mistake here")
# Use only the green dimension
green.socialist[1,,]
green <-
list(
DJ <-Y = unname(Y),
diversity = unname(diversity),
GDPpc = unname(GDPpc),
trade = unname(trade),
gdp.growth = unname(gdp.growth),
urban = unname(urban),
industry = unname(industry),
industry.means = industry.means,
deliberation = unname(deliberation),
constraints = unname(constraints),
gov.eff = unname(gov.eff),
gov.eff.mean.observed = unname(apply(gov.eff, 1, mean, na.rm = TRUE)),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green = green,
nC = nC,
nI = nI,
nY = nY)
# Number of countries nC
## [1] 21
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"performance-tscs"
M <- "Baseline"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (i in 1:nI) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[i,c,t] ~ dnorm(mu[i,c,t], tau[i,c,t])
mu[i,c,t] <- #alpha[i]
delta[i,c] * Y[i,c,t-1]
+ beta[1,i] * GDPpc[c,t-1]
+ beta[2,i] * trade[c,t-1]
+ beta[3,i] * eu[c,t-1]
+ beta[5,i] * gdp.growth[c,t-1]
+ beta[6,i] * urban[c,t-1]
+ beta[7,i] * industry[c,t-1]
+ theta[1,i] * portfolio.size[c,t]
+ theta[2,i] * diversity[c,t]
+ rho[i,c] * (Y[i,c,t-1] - mu[i,c,t-1] )
tau[i,c,t] <- 1 / sigma.sq[i,c,t]
sigma.sq[i,c,t] <- exp(
lambda_c[i,c])
resid[i,c,t] <- Y[i,c,t] - mu[i,c,t]
}
mu[i,c,1] <- alpha[i]
+ beta[1,i] * GDPpc[c,1]
+ beta[2,i] * trade[c,1]
+ beta[3,i] * eu[c,1]
+ beta[5,i] * gdp.growth[c,1]
+ beta[6,i] * urban[c,1]
+ beta[7,i] * industry[c,1]
+ theta[1,i] * portfolio.size[c,1]
+ theta[2,i] * diversity[c,1]
rho[i,c] ~ dunif(-1, 1)
delta[i,c] ~ dunif(0, 1)
resid[i,c,1] <- Y[i,c,1] - mu[i,c,1]
}
#
# Priors for variance component
#
lambda[1,i] ~ dnorm(0, 2^-2)
lambda[2,i] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
alpha[i] ~ dunif(0, 100)
#
# Priors for the control variables
#
for (b in 1:8) {
beta[b,i] ~ dnorm(0, 1^-2)
}
#
# Priors for main effects
#
for (t in 1:2) {
theta[t,i] ~ dnorm(0, 1^-2)
}
}
# Variance component, intercepts by country
for (i in 1:nI) {
for (c in 1:nC) {
lambda_c[i,c] ~ dt(0, 0.1^-2, 3)
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "lambda", "lambda_c")
par <- c(par, "delta")
par <- c(par, "nu")
par <- c(par, "rho")
par <- c(par, "resid")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=1),
list(.RNG.name="base::Super-Duper", .RNG.seed=2),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=3),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=2))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DJ, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 4, adapt = 1e2, burnin = 1e3, sample = 5e2, thin = 10,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
ggmcmc(ggs(s, family = "alpha|beta|theta|delta|lambda|rho"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|nu|rho"),
plot = c("traceplot", "crosscorrelation", "caterpillar"),
param_page = 8, file = paste("ggmcmc-partial-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)", "Portfolio size"),
L.lambda <-Sector = sector.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda) +
ggtitle("Variance component")
Figure 5: Variance component.
Variance components (country varying intercepts).
plab("lambda_c", list(Indicator = indicator.label, Country = country.label))
L.lambda.c <- ggs(s, family = "lambda_c\\[", par_labels = L.lambda.c)
S.lambda.c <-ggs_caterpillar(S.lambda.c, label = "Country") +
facet_grid(~ Indicator) +
ggtitle("Variance component (countries)")
Figure 6: Variance component (country varying intercepts).
Auto-regressive components.
plab("rho", list(Indicator = indicator.label, Country = country.label))
L.rho <- ggs(s, family = "rho", par_labels = L.rho)
S.rho <-ggs_caterpillar(S.rho, label = "Country") +
facet_wrap(~ Indicator, scales="free") +
aes(color=Indicator) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 7: Auto-regressive component.
Lagged dependent variable.
plab("delta", list(Indicator = indicator.label, Country = country.label))
L.delta <- ggs(s, family = "delta", par_labels = L.delta)
S.delta <-ggs_caterpillar(S.delta, label = "Country") +
facet_wrap(~ Indicator, scales="free") +
aes(color=Indicator) +
ggtitle("Lagged dependent variable (countries)") +
scale_colour_xfim()
Figure 8: Lagged dependent variable.
plab("theta", list(Variable = c("Portfolio size", "Diversity"),
L.thetas <-Indicator = indicator.label))
plab("beta", list(Variable = c("GDP pc", "Trade", "EU", "Green",
L.betas <-"GDP growth", "Urban", "Industry",
"Consensus"),
Indicator = indicator.label))
bind_rows(L.thetas, L.betas)
L.betas <-
ggs(s, family = "^beta\\[|^theta\\[", par_labels = L.betas) %>%
S.betas <- filter(value != 0)
filter(S.betas, !Variable %in% c("Green", "Consensus"))
S.betas <-
%>%
S.betas group_by(Variable, Indicator) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ggs_caterpillar(S.betas, label = "Variable") +
facet_wrap(~ Indicator, scales="free") +
aes(color = Indicator) +
geom_vline(xintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 9: Slopes with the effects of control and main variables on performance, by performance indicator.
%>%
S.betas filter(Indicator %in% c("General", "Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity", "Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
facet_wrap(~ Indicator, scales="free") +
geom_vline(xintercept = 0, lty = 3) #+
Figure 10: Slopes with the effects of control and main variables on performance, by performance indicator.
%>%
S.betas filter(Indicator %in% c("General")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
geom_vline(xintercept = 0, lty = 3) +
ggtitle("General performance")
Figure 11: Slopes with the effects of control and main variables on performance. General performance
%>%
S.betas filter(Indicator %in% c("Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
geom_vline(xintercept = 0, lty = 3) +
ggtitle("Specific 1980 performance")
Figure 12: Slopes with the effects of control and main variables on performance. Specific 1980 performance
%>%
S.betas filter(Indicator %in% c("General", "Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
facet_wrap(~ Indicator, scales="free") +
geom_vline(xintercept = 0, lty = 3) #+
Figure 13: Slopes with the effects of control and main variables on performance, by performance indicator.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Indicator, color = Indicator)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.5)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.5)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.5)) +
ylab("HPD") + xlab("Parameter") +
geom_vline(xintercept = 0, lty = 3)
Figure 14: Slopes with the effects of control and main variables on performance.
ggplot(S.betas, aes(x = value, color = Indicator, fill = Indicator)) +
geom_density(alpha = 0.5) +
facet_wrap(~ Variable, ncol = 5, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 15: Slopes with the effects of control and main variables on performance.
Variables by evidence.
%>%
S.betas filter(value != 0) %>%
group_by(Variable, Indicator) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Variable, Indicator) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max) %>%
kable()
S.betas %>%
S.betas.gral <- filter(Indicator == "General") %>%
mutate(Parameter = Variable)
ggs_caterpillar(S.betas.gral) +
geom_vline(xintercept = 0, lty = 3)
Figure 16: Slopes for the effects of control variables on performance (Global performance indicator).
What is the model fit?
plab("resid", list(Indicator = indicator.label,
L.data <-Country = country.label,
Year = year.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Indicator = Var1, Country = Var2, Year = Var3, value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Indicator) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data) %>%
S.rsd <- filter(!str_detect(Country, "Z-")) %>%
group_by(Iteration, Chain, Indicator) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Indicator ~ .) +
expand_limits(x = 0)
Figure 17: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Indicator) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
Which are the observations with higher residuals, further away from the expectation?1 Negative residuals are cases where the country has lower innovation than expected according to the model.
plab("resid", list(Indicator = indicator.label,
L.data <-Country = country.label,
Year = year.label))
ggs(s, family = "resid", par_labels = L.data) %>%
S.resid <- filter(!str_detect(Country, "Z-"))
%>%
S.resid group_by(Country, Indicator) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:20) %>%
kable()
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
library(PolicyPortfolios)
data(consensus)
consensus %>%
ca <- filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures() %>%
filter(Measure %in% c("Div.aid", "Size")) %>%
select(-Measure.label) %>%
spread(Measure, value) %>%
rename(Diversity = Div.aid)
as.character(levels(ca$Country))
countries <- length(countries)
nC <- range(ca$Year)
years <-save(countries, years, file = "details.RData")
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
as.character(levels(ca$Country))
countries <-load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "Korea, Republic of"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
V-Dem:
load("vdem/v_dem-ra-1950_2018.RData") # loads vdem
Government effectiveness. Data retrieved manually from the World Bank page on Governance indicators. Only the “Government Effectiveness: Estimation” is used. The data is only available between 1996 and 2005.
load("wgi/government_effectiveness.RData")
gov.eff
gov.eff.original <-$country <- as.character(gov.eff.original$country)
gov.eff.original$country[gov.eff.original$country=="Korea, Rep."] <- "Korea, Republic of"
gov.eff.original$country <- as.character(gov.eff.original$country)
gov.eff.original
gov.eff.original %>%
gov.eff.l <- rename(gov.eff = value) %>%
gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE))
Political constraints
load("./polcon/polcon2017.RData") # loads polcon
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("./manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "Korea, Republic of"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <-#v <- weighted.mean(series$p.seats, diff(c(as.Date("1976-01-01"), series$date)))
weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
Save and arrange for analysis.
perf %>%
d.perf <- # Delete Turkey and Korea
filter(!Country %in% c("Korea, Republic of", "Turkey")) %>%
# Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y <- dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <-
dimnames(Y)[[1]]
indicator.label <- dimnames(Y)[[2]]
sector.label <- length(indicator.label)
nI <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
ca %>%
diversity <- select(Sector, Country, Year, Diversity) %>%
# Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Sector == "Environmental") %>%
filter(Year >= 1980 & Year <= 2005) %>%
select(-Sector) %>%
droplevels() %>%
reshape2::acast(Country ~ Year, value.var = "Diversity")
if ( length(which(!dimnames(diversity)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(urban = std(urban)) %>%
reshape2::acast(country ~ year, value.var = "urban")
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(industry = std(industry)) %>%
reshape2::acast(country ~ year, value.var = "industry")
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-
wdi %>%
trade <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(trade = std(trade)) %>%
reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
vdem %>%
deliberation <- mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "United States of America", "United States", Country)) %>%
mutate(Country = ifelse(Country == "Germany (RDA)", "Germany", Country)) %>%
filter(Democracy == "Deliberative") %>%
filter(Country %in% country.label) %>%
filter(Year >= 1980 & Year <= 2005) %>%
mutate(value = std(value)) %>%
select(Country, Year, value) %>%
reshape2::acast(Country ~ Year, value.var = "value")
if ( length(which(!dimnames(deliberation)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
polcon %>%
constraints <- mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(polcon = std(polcon)) %>%
select(country.polity, year, polcon) %>%
reshape2::acast(country.polity ~ year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = year.label.numeric) %>%
gov.eff <- left_join(gov.eff.original) %>%
filter(country %in% country.label) %>%
filter(year >= 1980 & year <= 2005) %>%
mutate(value = std(value)) %>%
select(country, year, value) %>%
reshape2::acast(country ~ year, value.var = "value")
if ( length(which(!dimnames(gov.eff)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
ca %>%
portfolio.size <-# filter(Measure == "Size") %>%
filter(Sector == "Environmental") %>%
# spread(Measure, value) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1980 & Year <= 2005) %>%
mutate(Size = std(logit(Size))) %>%
ungroup() %>%
reshape2::acast(Country ~ Year, variable.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
cpm %>%
green.socialist <- ungroup() %>%
mutate(calendar.year = as.numeric(format(date, "%Y"))) %>%
mutate(calendar.month = as.numeric(format(date, "%m"))) %>%
mutate(year = ifelse(calendar.month > 6, calendar.year + 1, calendar.year)) %>%
# Manually delete some elections that are held too close
# and assigned both to the same year
# Delete the first one, as in case of instability it is unlikely
# that they have passed legislation
filter(!(country == "Japan" & date == as.Date("1979-10-07"))) %>%
filter(!(country == "Greece" & date == as.Date("1989-11-05"))) %>%
filter(!(country == "Denmark" & date == as.Date("1987-09-08"))) %>%
#
select(country, year, family, p.seats) %>%
full_join(expand.grid(country = country.label,
year = (min(year.label.numeric)-5):max(year.label.numeric),
family = c("Socialist", "Green"))) %>%
group_by(country, family) %>%
arrange(country, family, year) %>%
# A bit clumsy, but works
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
mutate(p.seats = ifelse(is.na(p.seats), lag(p.seats), p.seats)) %>%
ungroup() %>%
select(country, year, family, p.seats) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(p.seats = ifelse(is.na(p.seats), 0, p.seats)) %>%
group_by(family) %>%
mutate(p.seats = std(p.seats)) %>%
ungroup() %>%
unique() %>%
reshape2::acast(family ~ country ~ year, value.var = "p.seats")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
if (!dimnames(green.socialist)[[1]][1] == "Green" & sector.label[1] == "Environmental") stop("Ep! There is a mistake here")
# Use only the green dimension
green.socialist[1,,]
green <-
list(
DJ <-Y = unname(Y),
diversity = unname(diversity),
GDPpc = unname(GDPpc),
trade = unname(trade),
gdp.growth = unname(gdp.growth),
urban = unname(urban),
industry = unname(industry),
industry.means = industry.means,
deliberation = unname(deliberation),
constraints = unname(constraints),
gov.eff = unname(gov.eff),
gov.eff.mean.observed = unname(apply(gov.eff, 1, mean, na.rm = TRUE)),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green = green,
nC = nC, #nC.real = nC.real,
nI = nI,
nY = nY)#,
# Number of countries nC
## [1] 21
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"performance-tscs-robustness"
M <- "Robustness, with interaction"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (i in 1:nI) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[i,c,t] ~ dnorm(mu[i,c,t], tau[i,c,t])
mu[i,c,t] <- #alpha[i]
delta[i,c] * Y[i,c,t-1]
+ beta[1,i] * GDPpc[c,t-1]
+ beta[2,i] * trade[c,t-1]
+ beta[3,i] * eu[c,t-1]
+ beta[5,i] * gdp.growth[c,t-1]
+ beta[6,i] * urban[c,t-1]
+ beta[7,i] * industry[c,t-1]
+ theta[1,i] * portfolio.size[c,t]
+ theta[2,i] * diversity[c,t]
+ theta[3,i] * portfolio.size[c,t] * diversity[c,t]
+ rho[i,c] * (Y[i,c,t-1] - mu[i,c,t-1] )
tau[i,c,t] <- 1 / sigma.sq[i,c,t]
sigma.sq[i,c,t] <- exp(lambda_c[i,c])
resid[i,c,t] <- Y[i,c,t] - mu[i,c,t]
}
mu[i,c,1] <- alpha[i]
+ beta[1,i] * GDPpc[c,1]
+ beta[2,i] * trade[c,1]
+ beta[3,i] * eu[c,1]
+ beta[5,i] * gdp.growth[c,1]
+ beta[6,i] * urban[c,1]
+ beta[7,i] * industry[c,1]
+ theta[1,i] * portfolio.size[c,1]
+ theta[2,i] * diversity[c,1]
+ theta[3,i] * portfolio.size[c,1] * diversity[c,1]
rho[i,c] ~ dunif(-1, 1)
delta[i,c] ~ dunif(0, 1)
resid[i,c,1] <- Y[i,c,1] - mu[i,c,1]
}
#
# Priors for variance component
#
lambda[1,i] ~ dnorm(0, 2^-2)
lambda[2,i] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
alpha[i] ~ dunif(0, 100)
#
# Priors for the control variables
#
for (b in 1:8) {
beta[b,i] ~ dnorm(0, 1^-2)
}
#
# Priors for main effects
#
for (t in 1:3) {
theta[t,i] ~ dnorm(0, 1^-2)
}
}
# Variance component, intercepts by country
for (i in 1:nI) {
for (c in 1:nC) {
lambda_c[i,c] ~ dt(0, 0.1^-2, 3)
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "lambda", "lambda_c")
par <- c(par, "delta")
par <- c(par, "nu")
par <- c(par, "rho")
par <- c(par, "resid")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=1),
list(.RNG.name="base::Super-Duper", .RNG.seed=2),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=3),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=2))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DJ, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 4, adapt = 1e2, burnin = 1e3, sample = 5e2, thin = 10,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
ggmcmc(ggs(s, family = "alpha|beta|theta|delta|lambda|rho"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|nu|rho"),
plot = c("traceplot", "crosscorrelation", "caterpillar"),
param_page = 8, file = paste("ggmcmc-partial-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)", "Portfolio size"),
L.lambda <-Sector = sector.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda) +
ggtitle("Variance component")
Figure 18: Variance component.
Variance components (country varying intercepts).
plab("lambda_c", list(Indicator = indicator.label, Country = country.label))
L.lambda.c <- ggs(s, family = "lambda_c\\[", par_labels = L.lambda.c)
S.lambda.c <-ggs_caterpillar(S.lambda.c, label = "Country") +
facet_grid(~ Indicator) +
ggtitle("Variance component (countries)")
Figure 19: Variance component (country varying intercepts).
Auto-regressive components.
plab("rho", list(Indicator = indicator.label, Country = country.label))
L.rho <- ggs(s, family = "rho", par_labels = L.rho)
S.rho <-ggs_caterpillar(S.rho, label = "Country") +
facet_wrap(~ Indicator, scales="free") +
aes(color=Indicator) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 20: Auto-regressive component.
Lagged dependent variable.
plab("delta", list(Indicator = indicator.label, Country = country.label))
L.delta <- ggs(s, family = "delta", par_labels = L.delta)
S.delta <-ggs_caterpillar(S.delta, label = "Country") +
facet_wrap(~ Indicator, scales="free") +
aes(color=Indicator) +
ggtitle("Lagged dependent variable (countries)") +
scale_colour_xfim()
Figure 21: Lagged dependent variable.
plab("theta", list(Variable = c("Portfolio size",
L.thetas <-"Diversity", "Portfolio size * Diversity"),
Indicator = indicator.label))
plab("beta", list(Variable = c("GDP pc", "Trade", "EU", "Green",
L.betas <-"GDP growth", "Urban", "Industry",
"Consensus"),
Indicator = indicator.label))
bind_rows(L.thetas, L.betas)
L.betas <-
ggs(s, family = "^beta\\[|^theta\\[", par_labels = L.betas) %>%
S.betas <- filter(value != 0)
filter(S.betas, !Variable %in% c("Green", "Consensus"))
S.betas <-
%>%
S.betas group_by(Variable, Indicator) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ggs_caterpillar(S.betas, label = "Variable") +
facet_wrap(~ Indicator, scales="free") +
aes(color = Indicator) +
geom_vline(xintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 22: Slopes with the effects of control and main variables on performance, by performance indicator.
%>%
S.betas filter(Indicator %in% c("General", "Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size * Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
facet_wrap(~ Indicator, scales="free") +
geom_vline(xintercept = 0, lty = 3) #+
Figure 23: Slopes with the effects of control and main variables on performance, by performance indicator.
%>%
S.betas filter(Indicator %in% c("General")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size * Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
geom_vline(xintercept = 0, lty = 3) +
ggtitle("General performance")
Figure 24: Slopes with the effects of control and main variables on performance. General performance
%>%
S.betas filter(Indicator %in% c("Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size * Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
geom_vline(xintercept = 0, lty = 3) +
ggtitle("Specific 1980 performance")
Figure 25: Slopes with the effects of control and main variables on performance. Specific 1980 performance
%>%
S.betas filter(Indicator %in% c("General", "Specific1980")) %>%
mutate(Variable = factor(as.character(Variable),
levels = rev(c("Diversity",
"Portfolio size * Diversity",
"Portfolio size",
"EU",
"GDP pc", "GDP growth",
"Industry", "Urban",
"Trade")))) %>%
filter(Variable != "Portfolio size * Diversity") %>%
ggs_caterpillar(label = "Variable", sort = FALSE) +
facet_wrap(~ Indicator, scales="free") +
geom_vline(xintercept = 0, lty = 3) #+
Figure 26: Slopes with the effects of control and main variables on performance, by performance indicator.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Indicator, color = Indicator)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.5)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.5)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.5)) +
ylab("HPD") + xlab("Parameter") +
geom_vline(xintercept = 0, lty = 3)
Figure 27: Slopes with the effects of control and main variables on performance.
ggplot(S.betas, aes(x = value, color = Indicator, fill = Indicator)) +
geom_density(alpha = 0.5) +
facet_wrap(~ Variable, ncol = 5, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 28: Slopes with the effects of control and main variables on performance.
Variables by evidence.
%>%
S.betas filter(value != 0) %>%
group_by(Variable, Indicator) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Variable, Indicator) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max) %>%
kable()
S.betas %>%
S.betas.gral <- filter(Indicator == "General") %>%
mutate(Parameter = Variable)
ggs_caterpillar(S.betas.gral) +
geom_vline(xintercept = 0, lty = 3)
Figure 29: Slopes for the effects of control variables on performance (Global performance indicator).
What is the model fit?
plab("resid", list(Indicator = indicator.label,
L.data <-Country = country.label,
Year = year.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Indicator = Var1, Country = Var2, Year = Var3, value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Indicator) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data) %>%
S.rsd <- filter(!str_detect(Country, "Z-")) %>%
group_by(Iteration, Chain, Indicator) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Indicator ~ .) +
expand_limits(x = 0)
Figure 30: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Indicator) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
Which are the observations with higher residuals, further away from the expectation?2 Negative residuals are cases where the country has lower innovation than expected according to the model.
plab("resid", list(Indicator = indicator.label,
L.data <-Country = country.label,
Year = year.label))
ggs(s, family = "resid", par_labels = L.data) %>%
S.resid <- filter(!str_detect(Country, "Z-"))
%>%
S.resid group_by(Country, Indicator) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:20) %>%
kable()
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
Data is TSCS, by sector.
library(PolicyPortfolios)
data(consensus)
bind_rows(
D <-# Calculate portfolio measures sector by sector
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures(),
%>%
consensus filter(Sector == "Social") %>%
droplevels() %>%
pp_measures())
# Add more fake countries
# Z-01 Increases portfolio size from minimum to maximum observed size
# over time
range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.env <- range(filter(D, Sector == "Social" & Measure == "Size")$value)
range.size.soc <-
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Environmental", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.env[1], range.size.env[2],
length.out = length(min(D$Year):max(D$Year)))))
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Social", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.soc[1], range.size.soc[2],
length.out = length(min(D$Year):max(D$Year)))))
# Z-02, Z-11 Fixes government effectiveness to its mean
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
# Z-12:Z-21 Fixes portfolio size for veto players to move
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
D %>%
diversity <- mutate(Country = as.factor(Country)) %>%
select(-Measure) %>%
rename(Measure = Measure.label) %>%
spread(Measure, value) %>%
mutate(`Diversity/W (Average Instrument Diversity)` =
`Diversity (Average Instrument Diversity)` / (1 - `Proportion of targets covered`)) %>%
select(Sector, Country, Year,
`Diversity (Average Instrument Diversity)`,
`Diversity (Gini-Simpson)`,
`Equitability (Shannon)`,
`Equality of Instrument configurations`)
as.character(unique(D$Country))
countries <- length(countries)
nC <- range(D$Year) years <-
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
perf %>%
d.perf <- # Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Water", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y.performance <- dim(Y.performance)[3] nYperformance <-
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "South Korea"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
Government effectiveness. Data retrieved manually from the World Bank page on Governance indicators. Only the “Government Effectiveness: Estimation” is used. The data is only available between 1996 and 2005.
load("wgi/wgi-full-v201029.RData")
wgi %>%
gov.eff.original <- filter(indicator == "Government effectiveness") %>%
select(country, year, value = Estimate) %>%
expand_grid(Sector = c("Environmental", "Social"))
Add fake government effectiveness
range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)
range.ge.env <-
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Environmental",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.env[1],
2],
range.ge.env[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Social",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.soc[1],
2],
range.ge.soc[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
Political Constraints - polconIII. An indicator of “veto players” comes from Henisz (2002). The indicator “estimates the feasibility of policy change. [That is], the extent to which a change in the preferences of any one actor may lead to a change in government policy”. Higher values represent systems with higher constraints.
load("polcon/polcon2017.RData") # loads polcon
Add fake political constraints values.
polcon %>%
polcon.d <- as_tibble() %>%
filter(year %in% years[1]:years[2]) %>%
mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% countries) %>%
select(Country = country.polity, Year = year, polcon)
polcon.d %>%
range.polcon <- select(polcon) %>%
unlist(., use.names = FALSE) %>%
range()
polcon.d %>%
polcon.d <- bind_rows(expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
polcon = seq(range.polcon[1],
2],
range.polcon[length.out = length(12:21))),
Year = min(D$Year):max(D$Year)))
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "South Korea"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
For the salience of each topic, we employ data from Volkens (2013), weighting the proportion of votes to each party and the importance that each party gives to environmental issues or the expansion of social welfare.
load("manifesto/201029-cpm-salience.RData")
cpm.salience %>%
salience <- filter(Country %in% countries) %>%
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Year %in% years[1]:years[2])
Border contiguity
load("borders/geography.RData")
M.borders[dimnames(M.borders)[[1]] %in% countries,
m.borders <-dimnames(M.borders)[[2]] %in% countries]
Trade dependency
load("trade/trade.RData")
rm(M.trade, M.trade.imports)
Save and arrange for analysis.
diversity %>%
diversity <- # Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
droplevels()
diversity %>%
diversity.l <- gather(Measure, value, -c(Sector, Country, Year))
reshape2::acast(diversity.l,
Y <-~ Country ~ Year ~ Measure, value.var = "value")
Sector dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <- dim(Y)[4]
nD <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <- 21
nC.fake <- nC - nC.fake
nC.real <- 1:nC.real
id.real.countries <- (nC.real + 1):nC
id.fake.countries <-
dimnames(Y)[[1]]
sector.label <- length(sector.label)
nS <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
paste0(str_sub(year.label, 1, 3), "0s")
decade.text <- as.numeric(as.factor(decade.text))
id.decade <- levels(as.factor(decade.text))
decade.label <- length(decade.label)
nDecades <-
dimnames(Y)[[4]]
diversity.label <- length(diversity.label)
nD <-
11
nB <- rep(0, nB)
b0 <- diag(nB)
B0 <-diag(B0) <- 1^-2
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
# Fake countries
paste0("Z-", sprintf("%02d", 1:21))
f.c <-# Fake years
year.label.numeric
f.y <-
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, gdp.capita = 0)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
trade.df <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
mutate(trade = std(trade)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, trade = 0))
trade.df %>%
trade <- reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand_grid(Country = country.label,
constraints.d <-Year = year.label.numeric) %>%
left_join(polcon.d) %>%
mutate(original.polcon = polcon) %>%
mutate(polcon = std(polcon)) %>%
mutate(polcon = ifelse(str_detect(Country, "^Z-") & is.na(polcon), 0, polcon))
constraints.d %>%
constraints <- reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(
gov.eff.df <-country = country.label,
year = year.label.numeric,
Sector = sector.label) %>%
left_join(gov.eff.original) %>%
filter(country %in% country.label) %>%
filter(year >= 1976 & year <= 2005) %>%
mutate(value = std(value)) %>%
select(Sector, country, year, value) %>%
mutate(value = ifelse(str_detect(country, "^Z-") & is.na(value), 0, value))
gov.eff.df %>%
gov.eff <- reshape2::acast(Sector ~ country ~ year, value.var = "value")
if ( length(which(!dimnames(gov.eff)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
function(x) return(min(x[x!=0]))
min.discard.zero <-
portfolio.size <- D %>%
filter(Measure == "Size") %>%
spread(Measure, value) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector) %>%
mutate(Size = ifelse(Size == 0, min.discard.zero(Size)/2, Size)) %>%
mutate(Size = std(logit(Size))) %>%
mutate(Size = ifelse(str_detect(Country, "Z2"), 0, Size)) %>%
ungroup() %>%
select(Country, Sector, Year, Size) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Green socialist as salience
salience %>%
green.socialist <- group_by(Sector) %>%
mutate(Salience = std(Salience)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label, Country = f.c, Year = f.y, Salience = 0)) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Salience")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Borders in tidy data
interdependency.contiguity <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(geography %>%
select(Origin, Destination, p.contiguous),
by = c("Destination" = "Destination")) %>%
mutate(wDiversity = value * p.contiguous) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(contiguity.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(contiguity.dependency = std(contiguity.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
contiguity.dependency = 0))
interdependency.contiguity %>%
interdependency.contiguity <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "contiguity.dependency")
if ( length(which(!dimnames(interdependency.contiguity)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Trade in tidy data
interdependency.trade <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(trade.p %>%
ungroup() %>%
select(Origin, Destination, Year, p.Exports),
by = c("Destination" = "Destination", "Year" = "Year")) %>%
mutate(wDiversity = value * p.Exports) %>%
mutate(Origin = as.character(Origin),
Destination = as.character(Destination)) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(trade.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(trade.dependency = std(trade.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
trade.dependency = 0))
interdependency.trade %>%
interdependency.trade <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "trade.dependency")
if ( length(which(!dimnames(interdependency.trade)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Performance part
# Match it with the general Y, but only for the environmental sector
expand_grid(
d.perf.fake <-Country = country.label[str_detect(country.label, "^Z-") ],
Year = year.label.numeric,
Indicator = unique(d.perf$Indicator),
Performance = NA)
diversity.l %>%
Y.performance <- select(Sector, Country, Year, Measure) %>%
left_join(d.perf) %>%
left_join(d.perf.fake) %>%
filter(Sector == "Environmental") %>%
group_by(Indicator) %>%
mutate(Performance = std1(Performance)) %>%
ungroup() %>%
reshape2::acast(Indicator ~ Country ~ Year ~ Measure, value.var = "Performance")
# manually get rid of ghost performance for missing values
Y.performance[-4,,,]
Y.performance <-
dim(Y.performance)[1]
nP <- dimnames(Y.performance)[[1]]
performance.label <-if ( length(which(!dimnames(Y.performance)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
gdp.growth[,-dim(gdp.growth)[2]]
gdp.growth <-if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means <-is.nan(gdp.growth.means)] <- 0
gdp.growth.means[
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(urban = std(urban)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "urban")
urban[,-dim(urban)[2]]
urban <-if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(urban, 1, mean, na.rm = TRUE)
urban.means <-is.nan(urban.means)] <- 0
urban.means[
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(industry = std(industry)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "industry")
industry[,-dim(industry)[2]]
industry <-if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-is.nan(industry.means)] <- 0
industry.means[
list(
DP <-Y = unname(Y),
Y.performance = unname(Y.performance), nP = nP,
GDPpc = unname(GDPpc),
trade = unname(trade),
constraints = unname(constraints),
gov.eff = unname(gov.eff),
gov.eff.mean.observed = unname(apply(gov.eff, c(1, 2), mean, na.rm = TRUE)),
interdependency.contiguity = unname(interdependency.contiguity),
interdependency.trade = unname(interdependency.trade),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green.socialist = unname(green.socialist),
gdp.growth = unname(gdp.growth), gdp.growth.means = unname(gdp.growth.means),
urban = unname(urban), urban.means = unname(urban.means),
industry = unname(industry), industry.means = unname(industry.means),
nC = nC,
id.fake.countries = id.fake.countries,
id.real.countries = id.real.countries,
id.decade = id.decade, nDecades = nDecades,
nB = nB, b0 = b0, B0 = B0,
nS = nS,
nD = nD,
nY = nY)
# Number of countries (including fake ones) nC
## [1] 42
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"diversity-main"
M <- "Diversity (AID), Main"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (d in 1:nD) {
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
+ beta[1,s,d] * GDPpc[c,t-1]
+ beta[4,s,d] * gov.eff[s,c,t-1]
+ beta[5,s,d] * portfolio.size[s,c,t-1]
+ beta[6,s,d] * trade[c,t-1]
+ beta[7,s,d] * eu[c,t-1]
+ beta[8,s,d] * green.socialist[s,c,t-1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,t-1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,t]
+ beta[11,s,d] * interdependency.trade[d,s,c,t]
+ rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,t]
+ gamma[c,d])
resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
}
Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
mu[s,c,1,d] <- alpha[s,d,1]
+ beta[1,s,d] * GDPpc[c,1]
+ beta[4,s,d] * gov.eff[s,c,1]
+ beta[5,s,d] * portfolio.size[s,c,1]
+ beta[6,s,d] * trade[c,1]
+ beta[7,s,d] * eu[c,1]
+ beta[8,s,d] * green.socialist[s,c,1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,1]
+ beta[11,s,d] * interdependency.trade[d,s,c,1]
resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,1]
+ gamma[c,d])
}
#
# Degrees of freedom of GR
#
nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
nu.trans[s,d] ~ dunif(0, 1)
#
# Priors for variance component
#
lambda[1,s,d] ~ dnorm(0, 2^-2)
lambda[2,s,d] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
for (decade in 1:nDecades) {
alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
}
Alpha[s,d] ~ dunif(0, 1)
tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
sigma.alpha[s,d] ~ dunif(0, 0.5)
#
# Priors for the control variables
#
beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
}
#
# Data part for performance
#
for (p in 1:nP) {
for (c in 1:nC) {
for (t in 2:nY) {
Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
mu.performance[p,c,t,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,t,d]
+ eta.performance[3,p,d] * Y[1,c,t-1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,t-1]
+ eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
+ eta.performance[6,p,d] * GDPpc[c,t-1]
+ eta.performance[7,p,d] * trade[c,t-1]
+ eta.performance[8,p,d] * eu[c,t-1]
+ eta.performance[9,p,d] * gdp.growth[c,t-1]
+ eta.performance[10,p,d] * urban[c,t-1]
+ eta.performance[11,p,d] * industry[c,t-1]
}
Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
mu.performance[p,c,1,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,1,d]
+ eta.performance[3,p,d] * Y[1,c,1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,1]
+ eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
+ eta.performance[6,p,d] * GDPpc[c,1]
+ eta.performance[7,p,d] * trade[c,1]
+ eta.performance[8,p,d] * eu[c,1]
+ eta.performance[9,p,d] * gdp.growth[c,1]
+ eta.performance[10,p,d] * urban[c,1]
+ eta.performance[11,p,d] * industry[c,1]
}
tau.performance[p,d] ~ dgamma(0.001, 0.001)
sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
for (e in 1:11) {
eta.performance[e,p,d] ~ dnorm(0, 1^-2)
}
}
# Variance component, varying intercepts by country
for (c in 1:nC) {
gamma[c,d] ~ dnorm(0, 0.2^-2)
}
#
# AR(1) parameters
#
for (c in id.real.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dunif(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dunif(-1, 1)
}
}
for (c in id.fake.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
}
}
# SEM Part for portfolio size
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
mu.ps[s,c,t] <- alpha.ps[s,c]
+ delta[1,s] * GDPpc[c,t-1]
+ delta[2,s] * gov.eff[s,c,t-1]
+ delta[3,s] * green.socialist[s,c,t-1]
+ delta[4,s] * constraints[c,t-1]
}
tau.ps[s,c] ~ dgamma(0.1, 0.1)
sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
alpha.ps[s,c] ~ dnorm(0, 1^-2)
}
for (d in 1:4) {
delta[d,s] ~ dnorm(0, 1^-2)
}
}
# Mediated effects
for (d in 1:nD) {
for (s in 1:nS) {
pi[1,s,d] <- delta[1,s] * beta[1,s,d] # GDPpc
pi[2,s,d] <- delta[2,s] * beta[4,s,d] # gov.eff
pi[3,s,d] <- delta[3,s] * beta[8,s,d] # green
pi[4,s,d] <- delta[4,s] * beta[9,s,d] # constraints
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
for (s in 1:nS) {
for (c in 1:nC) {
# Reverse years back for NA in early years
for (t in 1:(nY-1)) {
green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
}
for (d in 1:nD) {
for (t in 1:(nY-1)) {
interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
}
}
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "Alpha", "sigma.alpha")
par <- c(par, "Sigma")
par <- c(par, "lambda", "gamma")
par <- c(par, "nu")
par <- c(par, "rho")
par <- expand_grid(Sector = 1:nS,
par.fake <-Country = id.fake.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.fake)
par <- expand_grid(Sector = 1:nS,
par.resid <-Country = id.real.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=10),
list(.RNG.name="base::Super-Duper", .RNG.seed=20),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=30),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=20))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DP, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 1, adapt = 2e2, burnin = 1e3, sample = 2e3, thin = 1,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
cat(str_remove_all(m, "#.+\n"))
## model {
## #
## #
## for (d in 1:nD) {
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
## mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
## + beta[1,s,d] * GDPpc[c,t-1]
## + beta[4,s,d] * gov.eff[s,c,t-1]
## + beta[5,s,d] * portfolio.size[s,c,t-1]
## + beta[6,s,d] * trade[c,t-1]
## + beta[7,s,d] * eu[c,t-1]
## + beta[8,s,d] * green.socialist[s,c,t-1] + beta[9,s,d] * constraints[c,t-1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,t]
## + beta[11,s,d] * interdependency.trade[d,s,c,t]
## + rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
## tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
## sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,t]
## + gamma[c,d])
## resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
## }
## Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
## mu[s,c,1,d] <- alpha[s,d,1]
## + beta[1,s,d] * GDPpc[c,1]
## + beta[4,s,d] * gov.eff[s,c,1]
## + beta[5,s,d] * portfolio.size[s,c,1]
## + beta[6,s,d] * trade[c,1]
## + beta[7,s,d] * eu[c,1]
## + beta[8,s,d] * green.socialist[s,c,1] + beta[9,s,d] * constraints[c,1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,1]
## + beta[11,s,d] * interdependency.trade[d,s,c,1]
##
## resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
## tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
## sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,1]
## + gamma[c,d])
## }
##
##
## #
## #
## nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
## nu.trans[s,d] ~ dunif(0, 1)
##
## #
## #
## lambda[1,s,d] ~ dnorm(0, 2^-2)
## lambda[2,s,d] ~ dnorm(0, 2^-2)
##
## #
## #
## for (decade in 1:nDecades) {
## alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
## }
## Alpha[s,d] ~ dunif(0, 1)
## tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
## sigma.alpha[s,d] ~ dunif(0, 0.5)
##
## #
## #
## beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
## Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
## Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
## }
## #
## #
## for (p in 1:nP) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
## mu.performance[p,c,t,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,t,d]
## + eta.performance[3,p,d] * Y[1,c,t-1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,t-1]
## + eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
## + eta.performance[6,p,d] * GDPpc[c,t-1]
## + eta.performance[7,p,d] * trade[c,t-1]
## + eta.performance[8,p,d] * eu[c,t-1]
## + eta.performance[9,p,d] * gdp.growth[c,t-1]
## + eta.performance[10,p,d] * urban[c,t-1]
## + eta.performance[11,p,d] * industry[c,t-1]
## }
## Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
## mu.performance[p,c,1,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,1,d]
## + eta.performance[3,p,d] * Y[1,c,1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,1]
## + eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
## + eta.performance[6,p,d] * GDPpc[c,1]
## + eta.performance[7,p,d] * trade[c,1]
## + eta.performance[8,p,d] * eu[c,1]
## + eta.performance[9,p,d] * gdp.growth[c,1]
## + eta.performance[10,p,d] * urban[c,1]
## + eta.performance[11,p,d] * industry[c,1]
## }
## tau.performance[p,d] ~ dgamma(0.001, 0.001)
## sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
## for (e in 1:11) {
## eta.performance[e,p,d] ~ dnorm(0, 1^-2)
## }
## }
##
## for (c in 1:nC) {
## gamma[c,d] ~ dnorm(0, 0.2^-2)
## }
## #
## #
## for (c in id.real.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dunif(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dunif(-1, 1)
## }
## }
## for (c in id.fake.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## }
## }
##
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
## mu.ps[s,c,t] <- alpha.ps[s,c]
## + delta[1,s] * GDPpc[c,t-1]
## + delta[2,s] * gov.eff[s,c,t-1]
## + delta[3,s] * green.socialist[s,c,t-1]
## + delta[4,s] * constraints[c,t-1]
## }
## tau.ps[s,c] ~ dgamma(0.1, 0.1)
## sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
## alpha.ps[s,c] ~ dnorm(0, 1^-2)
## }
## for (d in 1:4) {
## delta[d,s] ~ dnorm(0, 1^-2)
## }
## }
## for (d in 1:nD) {
## for (s in 1:nS) {
## pi[1,s,d] <- delta[1,s] * beta[1,s,d] pi[2,s,d] <- delta[2,s] * beta[4,s,d] pi[3,s,d] <- delta[3,s] * beta[8,s,d] pi[4,s,d] <- delta[4,s] * beta[9,s,d] }
## }
##
##
##
## #
## #
## for (c in 1:nC) {
## for (t in 1:nY) {
## gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
## gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
## gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
## urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
## industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
## }
## }
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 1:(nY-1)) {
## green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
## }
## for (d in 1:nD) {
## for (t in 1:(nY-1)) {
## interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
## }
## }
## }
## }
## }
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|rho|nu"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda, label = "Variable", comparison = "Sector") +
aes(color = Sector) +
facet_wrap(~ Diversity) +
theme(legend.position = "right") +
ggtitle("Variance component")
Figure 31: Variance component.
rm(S.lambda)
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-%>%
S.lambda filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable") +
ggtitle("Variance component")
Figure 32: Variance component.
rm(S.lambda)
Variance components (country varying intercepts).
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.gamma, label = "Country") +
facet_grid(~ Diversity) +
ggtitle("Variance component (countries)")
Figure 33: Variance component (country varying intercepts).
rm(S.gamma)
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-")) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)")
ggs_caterpillar(S.gamma, label = "Country") +
ggtitle("Variance component (countries)")
Figure 34: Variance component (country varying intercepts).
rm(S.gamma)
Auto-regressive components.
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
facet_grid(Diversity ~ Sector, scales="free") +
aes(color=Sector) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 35: Auto-regressive component.
rm(S.rho)
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 36: Auto-regressive component.
rm(S.rho)
Intercepts
plab("alpha", list(Sector = sector.label,
L.alpha <-Diversity = diversity.label,
Decade = decade.label))
ggs(s, family = "^alpha\\[", par_label = L.alpha)
S.alpha <-
ci(S.alpha) %>%
ggplot(aes(x = Decade, y = median, ymin = Low, ymax = High)) +
geom_point() +
geom_linerange() +
facet_grid(Diversity ~ Sector) +
ggtitle("Temporal trend")
Figure 37: Intercepts.
c("GDP pc",
covariates.label <-"Consensus",
"Deliberation",
"Government effectiveness",
"Portfolio size",
"Trade", "EU", "Salience",
"Political constraints",
"Interdependency (Contiguity)",
"Interdependency (Trade)")
plab("beta", list(Variable = covariates.label,
L.betas <-Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
S.betas <- filter(!Variable %in% c("Deliberation", "Consensus"))
ci(S.betas)
ci.betas <-save(ci.betas, file = paste0("ci-betas-", M, ".RData"))
%>%
S.betas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 38: Slopes with the effects on diversity, by sector.
ci(S.betas) %>%
filter(Sector == "Environmental") %>%
ggplot(aes(x = Variable,
y = median,
group = Diversity,
color = Diversity)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 39: Slopes with the effects on diversity, for the environmental sector.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
facet_wrap(~ Diversity, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 40: Slopes with the effects on diversity, by diversity indicator.
ci(S.betas) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 41: Slopes with the effects on AID diversity, by sector
ggplot(S.betas, aes(x = value, color = Sector, fill = Sector)) +
geom_density(alpha = 0.5) +
facet_grid(Diversity ~ Variable, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 42: Slopes with the effects on diversity, comparing sectors.
Variables by evidence.
%>%
S.betas filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(value != 0) %>%
group_by(Sector, Diversity, Variable) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Sector, Diversity, Variable) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max, -Diversity) %>%
kable()
S.betas %>%
S.betas.env <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) #%>%
ggs_caterpillar(S.betas.env) +
geom_vline(xintercept = 0, lty = 3)
Figure 43: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas %>%
S.betas.env.sorted <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) %>%
mutate(Parameter = fct_relevel(Parameter, rev(c("Political constraints",
"Government effectiveness",
"Salience",
"GDP pc", "Trade", "EU",
"Interdependency (Contiguity)",
"Interdependency (Trade)",
"Portfolio size"))))
ggs_caterpillar(S.betas.env.sorted, sort = FALSE) +
geom_vline(xintercept = 0, lty = 3)
Figure 44: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
plab("delta", list(Variable = c("GDP pc",
L.deltas <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label))
ggs(s, family = "^delta\\[", par_labels = L.deltas)
S.deltas <-
%>%
S.deltas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.deltas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 45: Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.pis) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 46: Mediated effects on diversity, by sector.
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
%>%
S.pis filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable")
Figure 47: Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
L.eta <-"Diversity", "Portfolio size",
"Diversity * Portfolio size",
"GDPpc", "Trade", "EU",
"GDP growth", "Urban", "Industry"),
Performance = performance.label,
Diversity = diversity.label))
ggs(s, family = "eta.performance", par_label = L.eta)
S.eta <-
ggs_caterpillar(S.eta, label = "Covariate", comparison = "Performance") +
geom_hline(yintercept = 0, lty = 3) +
aes(color = Performance) +
theme(legend.position = "right") +
facet_wrap(~ Diversity)
Figure 48: Direct effects on Environmental performance, by performance indicator and Diversity measure.
%>%
S.eta filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Performance == "General") %>%
ggs_caterpillar(label = "Covariate") +
geom_vline(xintercept = 0, lty = 3)
Figure 49: Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)
plab("Sigma", list(Covariate.1 = covariates.label,
L.Sigma <-Covariate.2 = covariates.label,
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
S.Sigma <- filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
filter(!Covariate.2 %in% c("Deliberation", "Consensus"))
ci(S.Sigma) %>%
vcov.Sigma <- select(Sector, Diversity, Covariate.1, Covariate.2, vcov = median) %>%
mutate(vcov = ifelse(Covariate.1 == Covariate.2, NA, vcov)) %>%
mutate(Covariate.1 = factor(as.character(Covariate.1), rev(levels(Covariate.1))))
ggplot(vcov.Sigma, aes(x = Covariate.2, y = Covariate.1, fill = vcov)) +
geom_raster() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
facet_grid(Sector ~ Diversity) +
scale_fill_continuous_diverging(palette = "Blue-Red")
Figure 50: Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)
What is the model fit?
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Sector = Var1, Country = Var2,
Year = Var3, Diversity = Var4,
value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Sector, Diversity) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
S.rsd <- filter(!str_detect(Country, "^Z-")) %>%
group_by(Iteration, Chain, Sector, Diversity) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Diversity ~ Sector) +
expand_limits(x = 0)
Figure 51: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Sector, Diversity) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
rm(S.rsd)
Which are the observations with higher residuals, further away from the expectation?3 Negative residuals are cases where the country has lower diversity than expected according to the model.
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(!str_detect(Country, "Z-")) %>%
group_by(Country) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:8) %>%
kable()
plab("mu", list(Sector = sector.label,
L.mu <-Country = country.label,
Year = year.label.numeric,
Diversity = diversity.label)) %>%
filter(str_detect(Country, "^Z-"))
ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
ci.mu <- mutate(Year = as.integer(as.character(Year))) %>%
ci()
%>%
ci.mu filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
ggplot(aes(x = Year, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen portfolio size goes\nfrom minimum to maximum\nover time")
Figure 52: Magnitude of the effects: change in the expected diversity when portfolio size goes from the minimum to the maximum observed value over time, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen government effectiveness goes\nfrom minimum to maximum")
Figure 53: Magnitude of the effects: change in the expected diversity when government effectiveness goes from the minimum to the maximum observed value, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen political constraints go\nfrom minimum to maximum")
Figure 54: Magnitude of the effects: change in the expected diversity when political constraints go from the minimum to the maximum observed value, with the rest of the variables at their means.
f1 <- ci.mu %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
left_join(D %>%
filter(Measure == "Size") %>%
select(Country, Sector, Year, value) %>%
rename(`Portfolio size` = value)) %>%
ggplot(aes(x = `Portfolio size`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(a)") +
ylab("Expected diversity")
ci.mu %>%
f2 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(b)") +
ylab("Expected diversity")
ci.mu %>%
f3 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = original.polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(c)") +
ylab("Expected diversity")
::plot_grid(f1, f2, f3, ncol = 3) cowplot
Figure 55: Magnitude of the effects: change in the expected diversity when (a) portfolio size, (b) government effectiveness or (c) political constraints move from the minimum to the maximum observed. In all cases the rest of the variables are fixed at their means.
Data is TSCS, by sector.
library(PolicyPortfolios)
data(consensus)
bind_rows(
D <-# Calculate portfolio measures sector by sector
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures(),
%>%
consensus filter(Sector == "Social") %>%
droplevels() %>%
pp_measures())
# Add more fake countries
# Z-01 Increases portfolio size from minimum to maximum observed size
# over time
range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.env <- range(filter(D, Sector == "Social" & Measure == "Size")$value)
range.size.soc <-
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Environmental", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.env[1], range.size.env[2],
length.out = length(min(D$Year):max(D$Year)))))
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Social", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.soc[1], range.size.soc[2],
length.out = length(min(D$Year):max(D$Year)))))
# Z-02, Z-11 Fixes government effectiveness to its mean
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
# Z-12:Z-21 Fixes portfolio size for veto players to move
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
D %>%
diversity <- mutate(Country = as.factor(Country)) %>%
select(-Measure) %>%
rename(Measure = Measure.label) %>%
spread(Measure, value) %>%
mutate(`Diversity/W (Average Instrument Diversity)` =
`Diversity (Average Instrument Diversity)` / (1 - `Proportion of targets covered`)) %>%
select(Sector, Country, Year,
`Diversity (Average Instrument Diversity)`,
`Diversity (Gini-Simpson)`,
`Equitability (Shannon)`,
`Equality of Instrument configurations`)
as.character(unique(D$Country))
countries <- length(countries)
nC <- range(D$Year) years <-
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
perf %>%
d.perf <- # Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Water", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y.performance <- dim(Y.performance)[3] nYperformance <-
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "South Korea"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-#ireland.wdi
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
#wdi.gcr.w
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
Vertical Policy Integration.
as_tibble(read.table("vpi/vpi-raw.csv", header = TRUE))
vpi.d <-
# Multiply observations by year
expand_grid(vpi.d,
vpi.d <-Year = min(D$Year):max(D$Year))
Add fake vertical policy integration.
range(filter(vpi.d, Sector == "Environmental")$VPI)
range.vpi.env <- range(filter(vpi.d, Sector == "Social")$VPI)
range.vpi.soc <-
vpi.d %>%
vpi.d <- bind_rows(expand_grid(tibble(Sector = "Environmental",
Country = paste0("Z-", sprintf("%02d", 2:11)),
VPI = seq(range.vpi.env[1],
2],
range.vpi.env[length.out = length(2:11))),
Year = min(D$Year):max(D$Year)))
vpi.d %>%
vpi.d <- bind_rows(expand_grid(tibble(Sector = "Social",
Country = paste0("Z-", sprintf("%02d", 2:11)),
VPI = seq(range.vpi.soc[1],
2],
range.vpi.soc[length.out = length(2:11))),
Year = min(D$Year):max(D$Year)))
Political Constraints - polconIII. An indicator of “veto players” comes from Henisz (2002). The indicator “estimates the feasibility of policy change. [That is], the extent to which a change in the preferences of any one actor may lead to a change in government policy”. Higher values represent systems with higher constraints.
load("polcon/polcon2017.RData") # loads polcon
Add fake political constraints values.
polcon %>%
polcon.d <- as_tibble() %>%
filter(year %in% years[1]:years[2]) %>%
mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% countries) %>%
select(Country = country.polity, Year = year, polcon)
polcon.d %>%
range.polcon <- select(polcon) %>%
unlist(., use.names = FALSE) %>%
range()
polcon.d %>%
polcon.d <- bind_rows(expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
polcon = seq(range.polcon[1],
2],
range.polcon[length.out = length(12:21))),
Year = min(D$Year):max(D$Year)))
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "South Korea"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
For the salience of each topic, we employ data from Volkens (2013), weighting the proportion of votes to each party and the importance that each party gives to environmental issues or the expansion of social welfare.
load("manifesto/201029-cpm-salience.RData")
cpm.salience %>%
salience <- filter(Country %in% countries) %>%
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Year %in% years[1]:years[2])
Border contiguity
load("borders/geography.RData")
M.borders[dimnames(M.borders)[[1]] %in% countries,
m.borders <-dimnames(M.borders)[[2]] %in% countries]
Trade dependency
load("trade/trade.RData")
rm(M.trade, M.trade.imports)
Save and arrange for analysis.
diversity %>%
diversity <- # Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
droplevels()
diversity %>%
diversity.l <- gather(Measure, value, -c(Sector, Country, Year))
reshape2::acast(diversity.l,
Y <-~ Country ~ Year ~ Measure, value.var = "value")
Sector dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <- dim(Y)[4]
nD <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <- 21
nC.fake <- nC - nC.fake
nC.real <- 1:nC.real
id.real.countries <- (nC.real + 1):nC
id.fake.countries <-
dimnames(Y)[[1]]
sector.label <- length(sector.label)
nS <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
paste0(str_sub(year.label, 1, 3), "0s")
decade.text <- as.numeric(as.factor(decade.text))
id.decade <- levels(as.factor(decade.text))
decade.label <- length(decade.label)
nDecades <-
dimnames(Y)[[4]]
diversity.label <- length(diversity.label)
nD <-
11
nB <- rep(0, nB)
b0 <- diag(nB)
B0 <-diag(B0) <- 1^-2
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
# Fake countries
paste0("Z-", sprintf("%02d", 1:21))
f.c <-# Fake years
year.label.numeric
f.y <-
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, gdp.capita = 0)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
trade.df <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
# bind_rows(expand_grid(country = f.c, year = f.y, trade = 0)) %>%
mutate(trade = std(trade)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, trade = 0))
trade.df %>%
trade <- reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand_grid(Country = country.label,
constraints.d <-Year = year.label.numeric) %>%
left_join(polcon.d) %>%
mutate(original.polcon = polcon) %>%
mutate(polcon = std(polcon)) %>%
mutate(polcon = ifelse(str_detect(Country, "^Z-") & is.na(polcon), 0, polcon))
constraints.d %>%
constraints <- reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand_grid(Sector = c("Environmental", "Social"),
vpi.df <-Country = country.label,
Year = year.label.numeric) %>%
left_join(vpi.d) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
mutate(value = std(VPI)) %>%
select(Sector, Country, Year, VPI, value) %>%
# mutate(value = ifelse(str_detect(Country, "^Z-01"), 0, value))
mutate(value = ifelse(str_detect(Country, "^Z-") & is.na(value), 0, value))
vpi.df %>%
vpi.A <- reshape2::acast(Sector ~ Country ~ Year, value.var = "value")
if ( length(which(!dimnames(vpi.A)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
function(x) return(min(x[x!=0]))
min.discard.zero <-
portfolio.size <- D %>%
filter(Measure == "Size") %>%
spread(Measure, value) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector) %>%
mutate(Size = ifelse(Size == 0, min.discard.zero(Size)/2, Size)) %>%
mutate(Size = std(logit(Size))) %>%
mutate(Size = ifelse(str_detect(Country, "Z2"), 0, Size)) %>%
ungroup() %>%
select(Country, Sector, Year, Size) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Green socialist as salience
salience %>%
green.socialist <- group_by(Sector) %>%
mutate(Salience = std(Salience)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label, Country = f.c, Year = f.y, Salience = 0)) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Salience")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Borders in tidy data
interdependency.contiguity <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(geography %>%
select(Origin, Destination, p.contiguous),
by = c("Destination" = "Destination")) %>%
mutate(wDiversity = value * p.contiguous) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(contiguity.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(contiguity.dependency = std(contiguity.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
contiguity.dependency = 0))
interdependency.contiguity %>%
interdependency.contiguity <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "contiguity.dependency")
if ( length(which(!dimnames(interdependency.contiguity)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Trade in tidy data
interdependency.trade <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(trade.p %>%
ungroup() %>%
select(Origin, Destination, Year, p.Exports),
by = c("Destination" = "Destination", "Year" = "Year")) %>%
mutate(wDiversity = value * p.Exports) %>%
mutate(Origin = as.character(Origin),
Destination = as.character(Destination)) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(trade.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(trade.dependency = std(trade.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
trade.dependency = 0))
interdependency.trade %>%
interdependency.trade <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "trade.dependency")
if ( length(which(!dimnames(interdependency.trade)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Performance part
# Match it with the general Y, but only for the environmental sector
expand_grid(
d.perf.fake <-Country = country.label[str_detect(country.label, "^Z-") ],
Year = year.label.numeric,
Indicator = unique(d.perf$Indicator),
Performance = NA)
diversity.l %>%
Y.performance <- select(Sector, Country, Year, Measure) %>%
left_join(d.perf) %>%
left_join(d.perf.fake) %>%
filter(Sector == "Environmental") %>%
group_by(Indicator) %>%
mutate(Performance = std1(Performance)) %>%
ungroup() %>%
reshape2::acast(Indicator ~ Country ~ Year ~ Measure, value.var = "Performance")
# manually get rid of ghost performance for missing values
Y.performance[-4,,,]
Y.performance <-
dim(Y.performance)[1]
nP <- dimnames(Y.performance)[[1]]
performance.label <-if ( length(which(!dimnames(Y.performance)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
gdp.growth[,-dim(gdp.growth)[2]]
gdp.growth <-if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means <-is.nan(gdp.growth.means)] <- 0
gdp.growth.means[
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(urban = std(urban)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "urban")
urban[,-dim(urban)[2]]
urban <-if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(urban, 1, mean, na.rm = TRUE)
urban.means <-is.nan(urban.means)] <- 0
urban.means[
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(industry = std(industry)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "industry")
industry[,-dim(industry)[2]]
industry <-if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-is.nan(industry.means)] <- 0
industry.means[
list(
DP <-Y = unname(Y),
Y.performance = unname(Y.performance), nP = nP,
GDPpc = unname(GDPpc),
trade = unname(trade),
constraints = unname(constraints),
vpi = unname(vpi.A),
interdependency.contiguity = unname(interdependency.contiguity),
interdependency.trade = unname(interdependency.trade),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green.socialist = unname(green.socialist),
gdp.growth = unname(gdp.growth), gdp.growth.means = unname(gdp.growth.means),
urban = unname(urban), urban.means = unname(urban.means),
industry = unname(industry), industry.means = unname(industry.means),
nC = nC,
id.fake.countries = id.fake.countries,
id.real.countries = id.real.countries,
id.decade = id.decade, nDecades = nDecades,
nB = nB, b0 = b0, B0 = B0,
nS = nS,
nD = nD,
nY = nY)
# Number of countries (including fake ones) nC
## [1] 42
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"diversity-vpi"
M <- "Diversity (AID), robustness, VPI"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (d in 1:nD) {
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
+ beta[1,s,d] * GDPpc[c,t-1]
+ beta[4,s,d] * vpi[s,c,t-1]
+ beta[5,s,d] * portfolio.size[s,c,t-1]
+ beta[6,s,d] * trade[c,t-1]
+ beta[7,s,d] * eu[c,t-1]
+ beta[8,s,d] * green.socialist[s,c,t-1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,t-1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,t]
+ beta[11,s,d] * interdependency.trade[d,s,c,t]
+ rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,t]
+ gamma[c,d])
resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
}
Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
mu[s,c,1,d] <- alpha[s,d,1]
+ beta[1,s,d] * GDPpc[c,1]
+ beta[4,s,d] * vpi[s,c,1]
+ beta[5,s,d] * portfolio.size[s,c,1]
+ beta[6,s,d] * trade[c,1]
+ beta[7,s,d] * eu[c,1]
+ beta[8,s,d] * green.socialist[s,c,1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,1]
+ beta[11,s,d] * interdependency.trade[d,s,c,1]
resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,1]
+ gamma[c,d])
}
#
# Degrees of freedom of GR
#
nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
nu.trans[s,d] ~ dunif(0, 1)
#
# Priors for variance component
#
lambda[1,s,d] ~ dnorm(0, 2^-2)
lambda[2,s,d] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
for (decade in 1:nDecades) {
alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
}
Alpha[s,d] ~ dunif(0, 1)
tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
sigma.alpha[s,d] ~ dunif(0, 0.5)
#
# Priors for the control variables
#
beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
}
#
# Data part for performance
#
for (p in 1:nP) {
for (c in 1:nC) {
for (t in 2:nY) {
Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
mu.performance[p,c,t,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,t,d]
+ eta.performance[3,p,d] * Y[1,c,t-1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,t-1]
+ eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
+ eta.performance[6,p,d] * GDPpc[c,t-1]
+ eta.performance[7,p,d] * trade[c,t-1]
+ eta.performance[8,p,d] * eu[c,t-1]
+ eta.performance[9,p,d] * gdp.growth[c,t-1]
+ eta.performance[10,p,d] * urban[c,t-1]
+ eta.performance[11,p,d] * industry[c,t-1]
}
Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
mu.performance[p,c,1,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,1,d]
+ eta.performance[3,p,d] * Y[1,c,1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,1]
+ eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
+ eta.performance[6,p,d] * GDPpc[c,1]
+ eta.performance[7,p,d] * trade[c,1]
+ eta.performance[8,p,d] * eu[c,1]
+ eta.performance[9,p,d] * gdp.growth[c,1]
+ eta.performance[10,p,d] * urban[c,1]
+ eta.performance[11,p,d] * industry[c,1]
}
tau.performance[p,d] ~ dgamma(0.001, 0.001)
sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
for (e in 1:11) {
eta.performance[e,p,d] ~ dnorm(0, 1^-2)
}
}
# Variance component, varying intercepts by country
for (c in 1:nC) {
gamma[c,d] ~ dnorm(0, 0.2^-2)
}
#
# AR(1) parameters
#
for (c in id.real.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dunif(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dunif(-1, 1)
}
}
for (c in id.fake.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
}
}
# SEM Part for portfolio size
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
mu.ps[s,c,t] <- alpha.ps[s,c]
+ delta[1,s] * GDPpc[c,t-1]
+ delta[2,s] * vpi[s,c,t-1]
+ delta[3,s] * green.socialist[s,c,t-1]
+ delta[4,s] * constraints[c,t-1]
}
tau.ps[s,c] ~ dgamma(0.1, 0.1)
sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
alpha.ps[s,c] ~ dnorm(0, 1^-2)
}
for (d in 1:4) {
delta[d,s] ~ dnorm(0, 1^-2)
}
}
# Mediated effects
for (d in 1:nD) {
for (s in 1:nS) {
pi[1,s,d] <- delta[1,s] * beta[1,s,d] # GDPpc
pi[2,s,d] <- delta[2,s] * beta[4,s,d] # vpi
pi[3,s,d] <- delta[3,s] * beta[8,s,d] # green
pi[4,s,d] <- delta[4,s] * beta[9,s,d] # constraints
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
for (s in 1:nS) {
for (c in 1:nC) {
# Reverse years back for NA in early years
for (t in 1:(nY-1)) {
green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
}
for (d in 1:nD) {
for (t in 1:(nY-1)) {
interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
}
}
}
}
for (s in 1:nS) {
for (c in 1:nC) {
vpi[s,c,1] ~ dnorm(0, 0.5^-2)
for (t in 2:nY) {
vpi[s,c,t] ~ dnorm(vpi[s,c,1], 100)
}
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "Alpha", "sigma.alpha")
par <- c(par, "Sigma")
par <- c(par, "lambda", "gamma")
par <- c(par, "nu")
par <- c(par, "rho")
par <- expand_grid(Sector = 1:nS,
par.fake <-Country = id.fake.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.fake)
par <- expand_grid(Sector = 1:nS,
par.resid <-Country = id.real.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=10),
list(.RNG.name="base::Super-Duper", .RNG.seed=20),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=30),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=20))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DP, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 1, adapt = 2e2, burnin = 1e3, sample = 2e3, thin = 1,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
cat(str_remove_all(m, "#.+\n"))
## model {
## #
## #
## for (d in 1:nD) {
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
## mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
## + beta[1,s,d] * GDPpc[c,t-1]
## + beta[4,s,d] * vpi[s,c,t-1]
## + beta[5,s,d] * portfolio.size[s,c,t-1]
## + beta[6,s,d] * trade[c,t-1]
## + beta[7,s,d] * eu[c,t-1]
## + beta[8,s,d] * green.socialist[s,c,t-1] + beta[9,s,d] * constraints[c,t-1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,t]
## + beta[11,s,d] * interdependency.trade[d,s,c,t]
## + rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
## tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
## sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,t]
## + gamma[c,d])
## resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
## }
## Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
## mu[s,c,1,d] <- alpha[s,d,1]
## + beta[1,s,d] * GDPpc[c,1]
## + beta[4,s,d] * vpi[s,c,1]
## + beta[5,s,d] * portfolio.size[s,c,1]
## + beta[6,s,d] * trade[c,1]
## + beta[7,s,d] * eu[c,1]
## + beta[8,s,d] * green.socialist[s,c,1] + beta[9,s,d] * constraints[c,1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,1]
## + beta[11,s,d] * interdependency.trade[d,s,c,1]
##
## resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
## tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
## sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,1]
## + gamma[c,d])
## }
##
##
## #
## #
## nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
## nu.trans[s,d] ~ dunif(0, 1)
##
## #
## #
## lambda[1,s,d] ~ dnorm(0, 2^-2)
## lambda[2,s,d] ~ dnorm(0, 2^-2)
##
## #
## #
## for (decade in 1:nDecades) {
## alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
## }
## Alpha[s,d] ~ dunif(0, 1)
## tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
## sigma.alpha[s,d] ~ dunif(0, 0.5)
##
## #
## #
## beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
## Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
## Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
## }
## #
## #
## for (p in 1:nP) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
## mu.performance[p,c,t,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,t,d]
## + eta.performance[3,p,d] * Y[1,c,t-1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,t-1]
## + eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
## + eta.performance[6,p,d] * GDPpc[c,t-1]
## + eta.performance[7,p,d] * trade[c,t-1]
## + eta.performance[8,p,d] * eu[c,t-1]
## + eta.performance[9,p,d] * gdp.growth[c,t-1]
## + eta.performance[10,p,d] * urban[c,t-1]
## + eta.performance[11,p,d] * industry[c,t-1]
## }
## Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
## mu.performance[p,c,1,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,1,d]
## + eta.performance[3,p,d] * Y[1,c,1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,1]
## + eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
## + eta.performance[6,p,d] * GDPpc[c,1]
## + eta.performance[7,p,d] * trade[c,1]
## + eta.performance[8,p,d] * eu[c,1]
## + eta.performance[9,p,d] * gdp.growth[c,1]
## + eta.performance[10,p,d] * urban[c,1]
## + eta.performance[11,p,d] * industry[c,1]
## }
## tau.performance[p,d] ~ dgamma(0.001, 0.001)
## sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
## for (e in 1:11) {
## eta.performance[e,p,d] ~ dnorm(0, 1^-2)
## }
## }
##
## for (c in 1:nC) {
## gamma[c,d] ~ dnorm(0, 0.2^-2)
## }
## #
## #
## for (c in id.real.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dunif(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dunif(-1, 1)
## }
## }
## for (c in id.fake.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## }
## }
##
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
## mu.ps[s,c,t] <- alpha.ps[s,c]
## + delta[1,s] * GDPpc[c,t-1]
## + delta[2,s] * vpi[s,c,t-1]
## + delta[3,s] * green.socialist[s,c,t-1]
## + delta[4,s] * constraints[c,t-1]
## }
## tau.ps[s,c] ~ dgamma(0.1, 0.1)
## sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
## alpha.ps[s,c] ~ dnorm(0, 1^-2)
## }
## for (d in 1:4) {
## delta[d,s] ~ dnorm(0, 1^-2)
## }
## }
## for (d in 1:nD) {
## for (s in 1:nS) {
## pi[1,s,d] <- delta[1,s] * beta[1,s,d] pi[2,s,d] <- delta[2,s] * beta[4,s,d] pi[3,s,d] <- delta[3,s] * beta[8,s,d] pi[4,s,d] <- delta[4,s] * beta[9,s,d] }
## }
##
##
##
## #
## #
## for (c in 1:nC) {
## for (t in 1:nY) {
## gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
## urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
## industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
## }
## }
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 1:(nY-1)) {
## green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
## }
## for (d in 1:nD) {
## for (t in 1:(nY-1)) {
## interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
## }
## }
## }
## }
## for (s in 1:nS) {
## for (c in 1:nC) {
## vpi[s,c,1] ~ dnorm(0, 0.5^-2)
## for (t in 2:nY) {
## vpi[s,c,t] ~ dnorm(vpi[s,c,1], 100)
## }
## }
## }
## }
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|rho|nu"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda, label = "Variable", comparison = "Sector") +
aes(color = Sector) +
facet_wrap(~ Diversity) +
theme(legend.position = "right") +
ggtitle("Variance component")
Figure 56: Variance component.
rm(S.lambda)
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-%>%
S.lambda filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable") +
ggtitle("Variance component")
Figure 57: Variance component.
rm(S.lambda)
Variance components (country varying intercepts).
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.gamma, label = "Country") +
facet_grid(~ Diversity) +
ggtitle("Variance component (countries)")
Figure 58: Variance component (country varying intercepts).
rm(S.gamma)
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-")) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)")
ggs_caterpillar(S.gamma, label = "Country") +
ggtitle("Variance component (countries)")
Figure 59: Variance component (country varying intercepts).
rm(S.gamma)
Auto-regressive components.
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
facet_grid(Diversity ~ Sector, scales="free") +
aes(color=Sector) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 60: Auto-regressive component.
rm(S.rho)
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 61: Auto-regressive component.
rm(S.rho)
Intercepts
plab("alpha", list(Sector = sector.label,
L.alpha <-Diversity = diversity.label,
Decade = decade.label))
ggs(s, family = "^alpha\\[", par_label = L.alpha)
S.alpha <-
ci(S.alpha) %>%
ggplot(aes(x = Decade, y = median, ymin = Low, ymax = High)) +
geom_point() +
geom_linerange() +
facet_grid(Diversity ~ Sector) +
ggtitle("Temporal trend")
Figure 62: Intercepts.
c("GDP pc",
covariates.label <-"Consensus",
"Deliberation",
"Policy feedback",
"Portfolio size",
"Trade", "EU", "Salience",
"Political constraints",
"Interdependency (Contiguity)",
"Interdependency (Trade)")
plab("beta", list(Variable = covariates.label,
L.betas <-Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
S.betas <- filter(!Variable %in% c("Deliberation", "Consensus"))
ci(S.betas)
ci.betas <-save(ci.betas, file = paste0("ci-betas-", M, ".RData"))
%>%
S.betas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 63: Slopes with the effects on diversity, by sector.
ci(S.betas) %>%
filter(Sector == "Environmental") %>%
ggplot(aes(x = Variable,
y = median,
group = Diversity,
color = Diversity)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 64: Slopes with the effects on diversity, for the environmental sector.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
facet_wrap(~ Diversity, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 65: Slopes with the effects on diversity, by diversity indicator.
ci(S.betas) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 66: Slopes with the effects on AID diversity, by sector
ggplot(S.betas, aes(x = value, color = Sector, fill = Sector)) +
geom_density(alpha = 0.5) +
facet_grid(Diversity ~ Variable, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 67: Slopes with the effects on diversity, comparing sectors.
Variables by evidence.
%>%
S.betas filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(value != 0) %>%
group_by(Sector, Diversity, Variable) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Sector, Diversity, Variable) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max, -Diversity) %>%
kable()
S.betas %>%
S.betas.env <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) #%>%
ggs_caterpillar(S.betas.env) +
geom_vline(xintercept = 0, lty = 3)
Figure 68: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas %>%
S.betas.env.sorted <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) %>%
mutate(Parameter = fct_relevel(Parameter, rev(c("Political constraints",
"Policy feedback",
"Salience",
"GDP pc", "Trade", "EU",
"Interdependency (Contiguity)",
"Interdependency (Trade)",
"Portfolio size"))))
ggs_caterpillar(S.betas.env.sorted, sort = FALSE) +
geom_vline(xintercept = 0, lty = 3)
Figure 69: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
plab("delta", list(Variable = c("GDP pc",
L.deltas <-"Policy feedback",
"Salience",
"Political constraints"),
Sector = sector.label))
ggs(s, family = "^delta\\[", par_labels = L.deltas)
S.deltas <-
%>%
S.deltas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.deltas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 70: Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Policy feedback",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.pis) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 71: Mediated effects on diversity, by sector.
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Policy feedback",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
%>%
S.pis filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable")
Figure 72: Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
L.eta <-"Diversity", "Portfolio size",
"Diversity * Portfolio size",
"GDPpc", "Trade", "EU",
"GDP growth", "Urban", "Industry"),
Performance = performance.label,
Diversity = diversity.label))
ggs(s, family = "eta.performance", par_label = L.eta)
S.eta <-
ggs_caterpillar(S.eta, label = "Covariate", comparison = "Performance") +
geom_hline(yintercept = 0, lty = 3) +
aes(color = Performance) +
theme(legend.position = "right") +
facet_wrap(~ Diversity)
Figure 73: Direct effects on Environmental performance, by performance indicator and Diversity measure.
%>%
S.eta filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Performance == "General") %>%
ggs_caterpillar(label = "Covariate") +
geom_vline(xintercept = 0, lty = 3)
Figure 74: Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)
plab("Sigma", list(Covariate.1 = covariates.label,
L.Sigma <-Covariate.2 = covariates.label,
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
S.Sigma <- filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
filter(!Covariate.2 %in% c("Deliberation", "Consensus"))
ci(S.Sigma) %>%
vcov.Sigma <- select(Sector, Diversity, Covariate.1, Covariate.2, vcov = median) %>%
mutate(vcov = ifelse(Covariate.1 == Covariate.2, NA, vcov)) %>%
mutate(Covariate.1 = factor(as.character(Covariate.1), rev(levels(Covariate.1))))
ggplot(vcov.Sigma, aes(x = Covariate.2, y = Covariate.1, fill = vcov)) +
geom_raster() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
facet_grid(Sector ~ Diversity) +
scale_fill_continuous_diverging(palette = "Blue-Red")
Figure 75: Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)
What is the model fit?
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Sector = Var1, Country = Var2,
Year = Var3, Diversity = Var4,
value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Sector, Diversity) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
S.rsd <- filter(!str_detect(Country, "^Z-")) %>%
group_by(Iteration, Chain, Sector, Diversity) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
# geom_histogram(binwidth = 0.001) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Diversity ~ Sector) +
expand_limits(x = 0)
Figure 76: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Sector, Diversity) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
rm(S.rsd)
Which are the observations with higher residuals, further away from the expectation?4 Negative residuals are cases where the country has lower diversity than expected according to the model.
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(!str_detect(Country, "Z-")) %>%
group_by(Country) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:8) %>%
kable()
plab("mu", list(Sector = sector.label,
L.mu <-Country = country.label,
Year = year.label.numeric,
Diversity = diversity.label)) %>%
filter(str_detect(Country, "^Z-"))
ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
ci.mu <- mutate(Year = as.integer(as.character(Year))) %>%
ci()
%>%
ci.mu filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
ggplot(aes(x = Year, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen portfolio size goes\nfrom minimum to maximum\nover time")
Figure 77: Magnitude of the effects: change in the expected diversity when portfolio size goes from the minimum to the maximum observed value over time, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(vpi.df) %>%
rename(`Policy feedback` = value) %>%
ggplot(aes(x = `Policy feedback`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen policy feedback goes\nfrom minimum to maximum")
Figure 78: Magnitude of the effects: change in the expected diversity when government effectiveness goes from the minimum to the maximum observed value, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen political constraints go\nfrom minimum to maximum")
Figure 79: Magnitude of the effects: change in the expected diversity when political constraints go from the minimum to the maximum observed value, with the rest of the variables at their means.
f1 <- ci.mu %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
left_join(D %>%
filter(Measure == "Size") %>%
select(Country, Sector, Year, value) %>%
rename(`Portfolio size` = value)) %>%
ggplot(aes(x = `Portfolio size`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(a)") +
ylab("Expected diversity")
ci.mu %>%
f2 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(vpi.df) %>%
rename(`Policy feedback` = value) %>%
ggplot(aes(x = `Policy feedback`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(b)") +
ylab("Expected diversity")
ci.mu %>%
f3 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = original.polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(c)") +
ylab("Expected diversity")
::plot_grid(f1, f2, f3, ncol = 3) cowplot
Figure 80: Magnitude of the effects: change in the expected diversity when (a) portfolio size, (b) government effectiveness or (c) political constraints move from the minimum to the maximum observed. In all cases the rest of the variables are fixed at their means.
Data is TSCS, by sector.
library(PolicyPortfolios)
data(consensus)
c("Austria", "Belgium", "Denmark", "Finland",
c.eu <-"France", "Germany", "Greece", "Ireland",
"Italy", "Netherlands", "Portugal", "Spain",
"Sweden", "United Kingdom")
# Target 13 (CO2 for combustion plants) + New Instrument; market-based
# All EU countries in the sample; only 2005
consensus %>%
extra <- filter(Instrument == "Liability scheme") %>%
mutate(Instrument = "New market-based") %>%
mutate(covered = ifelse(Target == "Carbon dioxide (CO2) emissions from large combustion plants of the smallest size as defined by the legal act" &
Year == 2005 &
Country %in% c.eu,
1, 0)) %>%
# Target 10 (SO2 for combustion plants) + New Instrument; market-based
# US; for 1995 onwards
mutate(covered = ifelse(Target == "Sulphur dioxide (SO2) emissions from large combustion plants of the smallest size as defined by the legal act" &
Year >= 1995 &
Country == "United States",
1, covered))
consensus %>%
consensus <- bind_rows(extra) %>%
mutate(Instrument = as.factor(Instrument))
bind_rows(
D <-# Calculate portfolio measures sector by sector
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures(),
%>%
consensus filter(Sector == "Social") %>%
droplevels() %>%
pp_measures())
# Add more fake countries
# Z-01 Increases portfolio size from minimum to maximum observed size
# over time
range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.env <- range(filter(D, Sector == "Social" & Measure == "Size")$value)
range.size.soc <-
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Environmental", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.env[1], range.size.env[2],
length.out = length(min(D$Year):max(D$Year)))))
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Social", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.soc[1], range.size.soc[2],
length.out = length(min(D$Year):max(D$Year)))))
# Z-02, Z-11 Fixes government effectiveness to its mean
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
# Z-12:Z-21 Fixes portfolio size for veto players to move
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
D %>%
diversity <- mutate(Country = as.factor(Country)) %>%
select(-Measure) %>%
rename(Measure = Measure.label) %>%
spread(Measure, value) %>%
mutate(`Diversity/W (Average Instrument Diversity)` =
`Diversity (Average Instrument Diversity)` / (1 - `Proportion of targets covered`)) %>%
select(Sector, Country, Year,
`Diversity (Average Instrument Diversity)`,
`Diversity (Gini-Simpson)`,
`Equitability (Shannon)`,
`Equality of Instrument configurations`)
as.character(unique(D$Country))
countries <- length(countries)
nC <- range(D$Year) years <-
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
perf %>%
d.perf <- # Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Water", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y.performance <- dim(Y.performance)[3] nYperformance <-
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "South Korea"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
Government effectiveness. Data retrieved manually from the World Bank page on Governance indicators. Only the “Government Effectiveness: Estimation” is used. The data is only available between 1996 and 2005.
load("wgi/wgi-full-v201029.RData")
wgi %>%
gov.eff.original <- filter(indicator == "Government effectiveness") %>%
select(country, year, value = Estimate) %>%
expand_grid(Sector = c("Environmental", "Social"))
Add fake government effectiveness
range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)
range.ge.env <-
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Environmental",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.env[1],
2],
range.ge.env[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Social",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.soc[1],
2],
range.ge.soc[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
Political Constraints - polconIII. An indicator of “veto players” comes from Henisz (2002). The indicator “estimates the feasibility of policy change. [That is], the extent to which a change in the preferences of any one actor may lead to a change in government policy”. Higher values represent systems with higher constraints.
load("polcon/polcon2017.RData") # loads polcon
Add fake political constraints values.
polcon %>%
polcon.d <- as_tibble() %>%
filter(year %in% years[1]:years[2]) %>%
mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% countries) %>%
select(Country = country.polity, Year = year, polcon)
polcon.d %>%
range.polcon <- select(polcon) %>%
unlist(., use.names = FALSE) %>%
range()
polcon.d %>%
polcon.d <- bind_rows(expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
polcon = seq(range.polcon[1],
2],
range.polcon[length.out = length(12:21))),
Year = min(D$Year):max(D$Year)))
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "South Korea"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
For the salience of each topic, we employ data from Volkens (2013), weighting the proportion of votes to each party and the importance that each party gives to environmental issues or the expansion of social welfare.
load("manifesto/201029-cpm-salience.RData")
cpm.salience %>%
salience <- filter(Country %in% countries) %>%
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Year %in% years[1]:years[2])
Border contiguity
load("borders/geography.RData")
M.borders[dimnames(M.borders)[[1]] %in% countries,
m.borders <-dimnames(M.borders)[[2]] %in% countries]
Trade dependency
load("trade/trade.RData")
rm(M.trade, M.trade.imports)
Save and arrange for analysis.
diversity %>%
diversity <- # Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
droplevels()
diversity %>%
diversity.l <- gather(Measure, value, -c(Sector, Country, Year))
reshape2::acast(diversity.l,
Y <-~ Country ~ Year ~ Measure, value.var = "value")
Sector dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <- dim(Y)[4]
nD <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <- 21
nC.fake <- nC - nC.fake
nC.real <- 1:nC.real
id.real.countries <- (nC.real + 1):nC
id.fake.countries <-
dimnames(Y)[[1]]
sector.label <- length(sector.label)
nS <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
paste0(str_sub(year.label, 1, 3), "0s")
decade.text <- as.numeric(as.factor(decade.text))
id.decade <- levels(as.factor(decade.text))
decade.label <- length(decade.label)
nDecades <-
dimnames(Y)[[4]]
diversity.label <- length(diversity.label)
nD <-
11
nB <- rep(0, nB)
b0 <- diag(nB)
B0 <-diag(B0) <- 1^-2
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
# Fake countries
paste0("Z-", sprintf("%02d", 1:21))
f.c <-# Fake years
year.label.numeric
f.y <-
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, gdp.capita = 0)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
trade.df <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
mutate(trade = std(trade)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, trade = 0))
trade.df %>%
trade <- reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand_grid(Country = country.label,
constraints.d <-Year = year.label.numeric) %>%
left_join(polcon.d) %>%
mutate(original.polcon = polcon) %>%
mutate(polcon = std(polcon)) %>%
mutate(polcon = ifelse(str_detect(Country, "^Z-") & is.na(polcon), 0, polcon))
constraints.d %>%
constraints <- reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(
gov.eff.df <-country = country.label,
year = year.label.numeric,
Sector = sector.label) %>%
left_join(gov.eff.original) %>%
filter(country %in% country.label) %>%
filter(year >= 1976 & year <= 2005) %>%
mutate(value = std(value)) %>%
select(Sector, country, year, value) %>%
mutate(value = ifelse(str_detect(country, "^Z-") & is.na(value), 0, value))
gov.eff.df %>%
gov.eff <- reshape2::acast(Sector ~ country ~ year, value.var = "value")
if ( length(which(!dimnames(gov.eff)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
function(x) return(min(x[x!=0]))
min.discard.zero <-
portfolio.size <- D %>%
filter(Measure == "Size") %>%
spread(Measure, value) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector) %>%
mutate(Size = ifelse(Size == 0, min.discard.zero(Size)/2, Size)) %>%
mutate(Size = std(logit(Size))) %>%
mutate(Size = ifelse(str_detect(Country, "Z2"), 0, Size)) %>%
ungroup() %>%
select(Country, Sector, Year, Size) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Green socialist as salience
salience %>%
green.socialist <- group_by(Sector) %>%
mutate(Salience = std(Salience)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label, Country = f.c, Year = f.y, Salience = 0)) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Salience")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Borders in tidy data
interdependency.contiguity <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(geography %>%
select(Origin, Destination, p.contiguous),
by = c("Destination" = "Destination")) %>%
mutate(wDiversity = value * p.contiguous) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(contiguity.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(contiguity.dependency = std(contiguity.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
contiguity.dependency = 0))
interdependency.contiguity %>%
interdependency.contiguity <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "contiguity.dependency")
if ( length(which(!dimnames(interdependency.contiguity)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Trade in tidy data
interdependency.trade <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(trade.p %>%
ungroup() %>%
select(Origin, Destination, Year, p.Exports),
by = c("Destination" = "Destination", "Year" = "Year")) %>%
mutate(wDiversity = value * p.Exports) %>%
mutate(Origin = as.character(Origin),
Destination = as.character(Destination)) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(trade.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(trade.dependency = std(trade.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
trade.dependency = 0))
interdependency.trade %>%
interdependency.trade <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "trade.dependency")
if ( length(which(!dimnames(interdependency.trade)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Performance part
# Match it with the general Y, but only for the environmental sector
expand_grid(
d.perf.fake <-Country = country.label[str_detect(country.label, "^Z-") ],
Year = year.label.numeric,
Indicator = unique(d.perf$Indicator),
Performance = NA)
diversity.l %>%
Y.performance <- select(Sector, Country, Year, Measure) %>%
left_join(d.perf) %>%
left_join(d.perf.fake) %>%
filter(Sector == "Environmental") %>%
group_by(Indicator) %>%
mutate(Performance = std1(Performance)) %>%
ungroup() %>%
reshape2::acast(Indicator ~ Country ~ Year ~ Measure, value.var = "Performance")
# manually get rid of ghost performance for missing values
Y.performance[-4,,,]
Y.performance <-
dim(Y.performance)[1]
nP <- dimnames(Y.performance)[[1]]
performance.label <-if ( length(which(!dimnames(Y.performance)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
gdp.growth[,-dim(gdp.growth)[2]]
gdp.growth <-if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means <-is.nan(gdp.growth.means)] <- 0
gdp.growth.means[
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(urban = std(urban)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "urban")
urban[,-dim(urban)[2]]
urban <-if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(urban, 1, mean, na.rm = TRUE)
urban.means <-is.nan(urban.means)] <- 0
urban.means[
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(industry = std(industry)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "industry")
industry[,-dim(industry)[2]]
industry <-if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-is.nan(industry.means)] <- 0
industry.means[
list(
DP <-Y = unname(Y),
Y.performance = unname(Y.performance), nP = nP,
GDPpc = unname(GDPpc),
trade = unname(trade),
constraints = unname(constraints),
gov.eff = unname(gov.eff),
gov.eff.mean.observed = unname(apply(gov.eff, c(1, 2), mean, na.rm = TRUE)),
interdependency.contiguity = unname(interdependency.contiguity),
interdependency.trade = unname(interdependency.trade),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green.socialist = unname(green.socialist),
gdp.growth = unname(gdp.growth), gdp.growth.means = unname(gdp.growth.means),
urban = unname(urban), urban.means = unname(urban.means),
industry = unname(industry), industry.means = unname(industry.means),
nC = nC,
id.fake.countries = id.fake.countries,
id.real.countries = id.real.countries,
id.decade = id.decade, nDecades = nDecades,
nB = nB, b0 = b0, B0 = B0,
nS = nS,
nD = nD,
nY = nY)
# Number of countries (including fake ones) nC
## [1] 42
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"diversity-mbi"
M <- "Diversity (AID), robustness, Market-based instruments"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (d in 1:nD) {
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
+ beta[1,s,d] * GDPpc[c,t-1]
+ beta[4,s,d] * gov.eff[s,c,t-1]
+ beta[5,s,d] * portfolio.size[s,c,t-1]
+ beta[6,s,d] * trade[c,t-1]
+ beta[7,s,d] * eu[c,t-1]
+ beta[8,s,d] * green.socialist[s,c,t-1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,t-1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,t]
+ beta[11,s,d] * interdependency.trade[d,s,c,t]
+ rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,t]
+ gamma[c,d])
resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
}
Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
mu[s,c,1,d] <- alpha[s,d,1]
+ beta[1,s,d] * GDPpc[c,1]
+ beta[4,s,d] * gov.eff[s,c,1]
+ beta[5,s,d] * portfolio.size[s,c,1]
+ beta[6,s,d] * trade[c,1]
+ beta[7,s,d] * eu[c,1]
+ beta[8,s,d] * green.socialist[s,c,1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,1]
+ beta[11,s,d] * interdependency.trade[d,s,c,1]
resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,1]
+ gamma[c,d])
}
#
# Degrees of freedom of GR
#
nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
nu.trans[s,d] ~ dunif(0, 1)
#
# Priors for variance component
#
lambda[1,s,d] ~ dnorm(0, 2^-2)
lambda[2,s,d] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
for (decade in 1:nDecades) {
alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
}
Alpha[s,d] ~ dunif(0, 1)
tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
sigma.alpha[s,d] ~ dunif(0, 0.5)
#
# Priors for the control variables
#
beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
}
#
# Data part for performance
#
for (p in 1:nP) {
for (c in 1:nC) {
for (t in 2:nY) {
Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
mu.performance[p,c,t,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,t,d]
+ eta.performance[3,p,d] * Y[1,c,t-1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,t-1]
+ eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
+ eta.performance[6,p,d] * GDPpc[c,t-1]
+ eta.performance[7,p,d] * trade[c,t-1]
+ eta.performance[8,p,d] * eu[c,t-1]
+ eta.performance[9,p,d] * gdp.growth[c,t-1]
+ eta.performance[10,p,d] * urban[c,t-1]
+ eta.performance[11,p,d] * industry[c,t-1]
}
Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
mu.performance[p,c,1,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,1,d]
+ eta.performance[3,p,d] * Y[1,c,1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,1]
+ eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
+ eta.performance[6,p,d] * GDPpc[c,1]
+ eta.performance[7,p,d] * trade[c,1]
+ eta.performance[8,p,d] * eu[c,1]
+ eta.performance[9,p,d] * gdp.growth[c,1]
+ eta.performance[10,p,d] * urban[c,1]
+ eta.performance[11,p,d] * industry[c,1]
}
tau.performance[p,d] ~ dgamma(0.001, 0.001)
sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
for (e in 1:11) {
eta.performance[e,p,d] ~ dnorm(0, 1^-2)
}
}
# Variance component, varying intercepts by country
for (c in 1:nC) {
gamma[c,d] ~ dnorm(0, 0.2^-2)
}
#
# AR(1) parameters
#
for (c in id.real.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dunif(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dunif(-1, 1)
}
}
for (c in id.fake.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
}
}
# SEM Part for portfolio size
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
mu.ps[s,c,t] <- alpha.ps[s,c]
+ delta[1,s] * GDPpc[c,t-1]
+ delta[2,s] * gov.eff[s,c,t-1]
+ delta[3,s] * green.socialist[s,c,t-1]
+ delta[4,s] * constraints[c,t-1]
}
tau.ps[s,c] ~ dgamma(0.1, 0.1)
sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
alpha.ps[s,c] ~ dnorm(0, 1^-2)
}
for (d in 1:4) {
delta[d,s] ~ dnorm(0, 1^-2)
}
}
# Mediated effects
for (d in 1:nD) {
for (s in 1:nS) {
pi[1,s,d] <- delta[1,s] * beta[1,s,d] # GDPpc
pi[2,s,d] <- delta[2,s] * beta[4,s,d] # gov.eff
pi[3,s,d] <- delta[3,s] * beta[8,s,d] # green
pi[4,s,d] <- delta[4,s] * beta[9,s,d] # constraints
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
for (s in 1:nS) {
for (c in 1:nC) {
# Reverse years back for NA in early years
for (t in 1:(nY-1)) {
green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
}
for (d in 1:nD) {
for (t in 1:(nY-1)) {
interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
}
}
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "Alpha", "sigma.alpha")
par <- c(par, "Sigma")
par <- c(par, "lambda", "gamma")
par <- c(par, "nu")
par <- c(par, "rho")
par <- expand_grid(Sector = 1:nS,
par.fake <-Country = id.fake.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.fake)
par <- expand_grid(Sector = 1:nS,
par.resid <-Country = id.real.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=10),
list(.RNG.name="base::Super-Duper", .RNG.seed=20),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=30),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=20))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DP, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 1, adapt = 2e2, burnin = 1e3, sample = 2e3, thin = 1,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
cat(str_remove_all(m, "#.+\n"))
## model {
## #
## #
## for (d in 1:nD) {
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
## mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
## + beta[1,s,d] * GDPpc[c,t-1]
## + beta[4,s,d] * gov.eff[s,c,t-1]
## + beta[5,s,d] * portfolio.size[s,c,t-1]
## + beta[6,s,d] * trade[c,t-1]
## + beta[7,s,d] * eu[c,t-1]
## + beta[8,s,d] * green.socialist[s,c,t-1] + beta[9,s,d] * constraints[c,t-1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,t]
## + beta[11,s,d] * interdependency.trade[d,s,c,t]
## + rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
## tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
## sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,t]
## + gamma[c,d])
## resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
## }
## Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
## mu[s,c,1,d] <- alpha[s,d,1]
## + beta[1,s,d] * GDPpc[c,1]
## + beta[4,s,d] * gov.eff[s,c,1]
## + beta[5,s,d] * portfolio.size[s,c,1]
## + beta[6,s,d] * trade[c,1]
## + beta[7,s,d] * eu[c,1]
## + beta[8,s,d] * green.socialist[s,c,1] + beta[9,s,d] * constraints[c,1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,1]
## + beta[11,s,d] * interdependency.trade[d,s,c,1]
##
## resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
## tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
## sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,1]
## + gamma[c,d])
## }
##
##
## #
## #
## nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
## nu.trans[s,d] ~ dunif(0, 1)
##
## #
## #
## lambda[1,s,d] ~ dnorm(0, 2^-2)
## lambda[2,s,d] ~ dnorm(0, 2^-2)
##
## #
## #
## for (decade in 1:nDecades) {
## alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
## }
## Alpha[s,d] ~ dunif(0, 1)
## tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
## sigma.alpha[s,d] ~ dunif(0, 0.5)
##
## #
## #
## beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
## Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
## Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
## }
## #
## #
## for (p in 1:nP) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
## mu.performance[p,c,t,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,t,d]
## + eta.performance[3,p,d] * Y[1,c,t-1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,t-1]
## + eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
## + eta.performance[6,p,d] * GDPpc[c,t-1]
## + eta.performance[7,p,d] * trade[c,t-1]
## + eta.performance[8,p,d] * eu[c,t-1]
## + eta.performance[9,p,d] * gdp.growth[c,t-1]
## + eta.performance[10,p,d] * urban[c,t-1]
## + eta.performance[11,p,d] * industry[c,t-1]
## }
## Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
## mu.performance[p,c,1,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,1,d]
## + eta.performance[3,p,d] * Y[1,c,1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,1]
## + eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
## + eta.performance[6,p,d] * GDPpc[c,1]
## + eta.performance[7,p,d] * trade[c,1]
## + eta.performance[8,p,d] * eu[c,1]
## + eta.performance[9,p,d] * gdp.growth[c,1]
## + eta.performance[10,p,d] * urban[c,1]
## + eta.performance[11,p,d] * industry[c,1]
## }
## tau.performance[p,d] ~ dgamma(0.001, 0.001)
## sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
## for (e in 1:11) {
## eta.performance[e,p,d] ~ dnorm(0, 1^-2)
## }
## }
##
## for (c in 1:nC) {
## gamma[c,d] ~ dnorm(0, 0.2^-2)
## }
## #
## #
## for (c in id.real.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dunif(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dunif(-1, 1)
## }
## }
## for (c in id.fake.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## }
## }
##
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
## mu.ps[s,c,t] <- alpha.ps[s,c]
## + delta[1,s] * GDPpc[c,t-1]
## + delta[2,s] * gov.eff[s,c,t-1]
## + delta[3,s] * green.socialist[s,c,t-1]
## + delta[4,s] * constraints[c,t-1]
## }
## tau.ps[s,c] ~ dgamma(0.1, 0.1)
## sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
## alpha.ps[s,c] ~ dnorm(0, 1^-2)
## }
## for (d in 1:4) {
## delta[d,s] ~ dnorm(0, 1^-2)
## }
## }
## for (d in 1:nD) {
## for (s in 1:nS) {
## pi[1,s,d] <- delta[1,s] * beta[1,s,d] pi[2,s,d] <- delta[2,s] * beta[4,s,d] pi[3,s,d] <- delta[3,s] * beta[8,s,d] pi[4,s,d] <- delta[4,s] * beta[9,s,d] }
## }
##
##
##
## #
## #
## for (c in 1:nC) {
## for (t in 1:nY) {
## gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
## gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
## gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
## urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
## industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
## }
## }
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 1:(nY-1)) {
## green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
## }
## for (d in 1:nD) {
## for (t in 1:(nY-1)) {
## interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
## }
## }
## }
## }
## }
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|rho|nu"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda, label = "Variable", comparison = "Sector") +
aes(color = Sector) +
facet_wrap(~ Diversity) +
theme(legend.position = "right") +
ggtitle("Variance component")
Figure 81: Variance component.
rm(S.lambda)
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-%>%
S.lambda filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable") +
ggtitle("Variance component")
Figure 82: Variance component.
rm(S.lambda)
Variance components (country varying intercepts).
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.gamma, label = "Country") +
facet_grid(~ Diversity) +
ggtitle("Variance component (countries)")
Figure 83: Variance component (country varying intercepts).
rm(S.gamma)
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-")) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)")
ggs_caterpillar(S.gamma, label = "Country") +
ggtitle("Variance component (countries)")
Figure 84: Variance component (country varying intercepts).
rm(S.gamma)
Auto-regressive components.
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
facet_grid(Diversity ~ Sector, scales="free") +
aes(color=Sector) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 85: Auto-regressive component.
rm(S.rho)
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 86: Auto-regressive component.
rm(S.rho)
Intercepts
plab("alpha", list(Sector = sector.label,
L.alpha <-Diversity = diversity.label,
Decade = decade.label))
ggs(s, family = "^alpha\\[", par_label = L.alpha)
S.alpha <-
ci(S.alpha) %>%
ggplot(aes(x = Decade, y = median, ymin = Low, ymax = High)) +
geom_point() +
geom_linerange() +
facet_grid(Diversity ~ Sector) +
ggtitle("Temporal trend")
Figure 87: Intercepts.
c("GDP pc",
covariates.label <-"Consensus",
"Deliberation",
"Government effectiveness",
"Portfolio size",
"Trade", "EU", "Salience",
"Political constraints",
"Interdependency (Contiguity)",
"Interdependency (Trade)")
plab("beta", list(Variable = covariates.label,
L.betas <-Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
S.betas <- filter(!Variable %in% c("Deliberation", "Consensus"))
ci(S.betas)
ci.betas <-save(ci.betas, file = paste0("ci-betas-", M, ".RData"))
%>%
S.betas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 88: Slopes with the effects on diversity, by sector.
ci(S.betas) %>%
filter(Sector == "Environmental") %>%
ggplot(aes(x = Variable,
y = median,
group = Diversity,
color = Diversity)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 89: Slopes with the effects on diversity, for the environmental sector.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
facet_wrap(~ Diversity, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 90: Slopes with the effects on diversity, by diversity indicator.
ci(S.betas) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 91: Slopes with the effects on AID diversity, by sector
ggplot(S.betas, aes(x = value, color = Sector, fill = Sector)) +
geom_density(alpha = 0.5) +
facet_grid(Diversity ~ Variable, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 92: Slopes with the effects on diversity, comparing sectors.
Variables by evidence.
%>%
S.betas filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(value != 0) %>%
group_by(Sector, Diversity, Variable) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Sector, Diversity, Variable) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max, -Diversity) %>%
kable()
S.betas %>%
S.betas.env <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) #%>%
ggs_caterpillar(S.betas.env) +
geom_vline(xintercept = 0, lty = 3)
Figure 93: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas %>%
S.betas.env.sorted <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) %>%
mutate(Parameter = fct_relevel(Parameter, rev(c("Political constraints",
"Government effectiveness",
"Salience",
"GDP pc", "Trade", "EU",
"Interdependency (Contiguity)",
"Interdependency (Trade)",
"Portfolio size"))))
ggs_caterpillar(S.betas.env.sorted, sort = FALSE) +
geom_vline(xintercept = 0, lty = 3)
Figure 94: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
plab("delta", list(Variable = c("GDP pc",
L.deltas <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label))
ggs(s, family = "^delta\\[", par_labels = L.deltas)
S.deltas <-
%>%
S.deltas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.deltas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 95: Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.pis) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 96: Mediated effects on diversity, by sector.
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
%>%
S.pis filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable")
Figure 97: Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
L.eta <-"Diversity", "Portfolio size",
"Diversity * Portfolio size",
"GDPpc", "Trade", "EU",
"GDP growth", "Urban", "Industry"),
Performance = performance.label,
Diversity = diversity.label))
ggs(s, family = "eta.performance", par_label = L.eta)
S.eta <-
ggs_caterpillar(S.eta, label = "Covariate", comparison = "Performance") +
geom_hline(yintercept = 0, lty = 3) +
aes(color = Performance) +
theme(legend.position = "right") +
facet_wrap(~ Diversity)
Figure 98: Direct effects on Environmental performance, by performance indicator and Diversity measure.
%>%
S.eta filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Performance == "General") %>%
ggs_caterpillar(label = "Covariate") +
geom_vline(xintercept = 0, lty = 3)
Figure 99: Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)
plab("Sigma", list(Covariate.1 = covariates.label,
L.Sigma <-Covariate.2 = covariates.label,
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
S.Sigma <- filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
filter(!Covariate.2 %in% c("Deliberation", "Consensus"))
ci(S.Sigma) %>%
vcov.Sigma <- select(Sector, Diversity, Covariate.1, Covariate.2, vcov = median) %>%
mutate(vcov = ifelse(Covariate.1 == Covariate.2, NA, vcov)) %>%
mutate(Covariate.1 = factor(as.character(Covariate.1), rev(levels(Covariate.1))))
ggplot(vcov.Sigma, aes(x = Covariate.2, y = Covariate.1, fill = vcov)) +
geom_raster() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
facet_grid(Sector ~ Diversity) +
scale_fill_continuous_diverging(palette = "Blue-Red")
Figure 100: Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)
What is the model fit?
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Sector = Var1, Country = Var2,
Year = Var3, Diversity = Var4,
value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Sector, Diversity) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
S.rsd <- filter(!str_detect(Country, "^Z-")) %>%
group_by(Iteration, Chain, Sector, Diversity) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Diversity ~ Sector) +
expand_limits(x = 0)
Figure 101: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Sector, Diversity) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
rm(S.rsd)
Which are the observations with higher residuals, further away from the expectation?5 Negative residuals are cases where the country has lower diversity than expected according to the model.
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(!str_detect(Country, "Z-")) %>%
group_by(Country) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:8) %>%
kable()
plab("mu", list(Sector = sector.label,
L.mu <-Country = country.label,
Year = year.label.numeric,
Diversity = diversity.label)) %>%
filter(str_detect(Country, "^Z-"))
ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
ci.mu <- mutate(Year = as.integer(as.character(Year))) %>%
ci()
%>%
ci.mu filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
ggplot(aes(x = Year, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen portfolio size goes\nfrom minimum to maximum\nover time")
Figure 102: Magnitude of the effects: change in the expected diversity when portfolio size goes from the minimum to the maximum observed value over time, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen government effectiveness goes\nfrom minimum to maximum")
Figure 103: Magnitude of the effects: change in the expected diversity when government effectiveness goes from the minimum to the maximum observed value, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen political constraints go\nfrom minimum to maximum")
Figure 104: Magnitude of the effects: change in the expected diversity when political constraints go from the minimum to the maximum observed value, with the rest of the variables at their means.
f1 <- ci.mu %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
left_join(D %>%
filter(Measure == "Size") %>%
select(Country, Sector, Year, value) %>%
rename(`Portfolio size` = value)) %>%
ggplot(aes(x = `Portfolio size`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(a)") +
ylab("Expected diversity")
ci.mu %>%
f2 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(b)") +
ylab("Expected diversity")
ci.mu %>%
f3 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = original.polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(c)") +
ylab("Expected diversity")
::plot_grid(f1, f2, f3, ncol = 3) cowplot
Figure 105: Magnitude of the effects: change in the expected diversity when (a) portfolio size, (b) government effectiveness or (c) political constraints move from the minimum to the maximum observed. In all cases the rest of the variables are fixed at their means.
Data is TSCS, by sector.
library(PolicyPortfolios)
data(consensus)
bind_rows(
D <-# Calculate portfolio measures sector by sector
%>%
consensus filter(Sector == "Environmental") %>%
droplevels() %>%
pp_measures(),
%>%
consensus filter(Sector == "Social") %>%
droplevels() %>%
pp_measures())
# Add more fake countries
# Z-01 Increases portfolio size from minimum to maximum observed size
# over time
range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.env <- range(filter(D, Sector == "Social" & Measure == "Size")$value)
range.size.soc <-
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Environmental", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.env[1], range.size.env[2],
length.out = length(min(D$Year):max(D$Year)))))
bind_rows(D,
D <-tibble(Country = "Z-01", Sector = "Social", Year = min(D$Year):max(D$Year),
Measure = "Size", value = seq(range.size.soc[1], range.size.soc[2],
length.out = length(min(D$Year):max(D$Year)))))
# Z-02, Z-11 Fixes government effectiveness to its mean
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 2:11)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
# Z-12:Z-21 Fixes portfolio size for veto players to move
mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.env <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)
mean.size.soc <-
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Environmental",
Measure = "Size",
value = mean.size.env),
Year = min(D$Year):max(D$Year)))
bind_rows(D,
D <-expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
Sector = "Social",
Measure = "Size",
value = mean.size.soc),
Year = min(D$Year):max(D$Year)))
D %>%
diversity <- mutate(Country = as.factor(Country)) %>%
select(-Measure) %>%
rename(Measure = Measure.label) %>%
spread(Measure, value) %>%
mutate(`Diversity/W (Average Instrument Diversity)` =
`Diversity (Average Instrument Diversity)` / (1 - `Proportion of targets covered`)) %>%
select(Sector, Country, Year,
`Diversity (Average Instrument Diversity)`,
`Diversity (Gini-Simpson)`,
`Equitability (Shannon)`,
`Equality of Instrument configurations`)
as.character(unique(D$Country))
countries <- length(countries)
nC <- range(D$Year) years <-
foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
perf <- as_tibble() %>%
select(Country = country, Year = year,
General = PolGen100,
Water = PolWat100,
Mundane = Mundane100,
Successfully = Success100,
Specific1980 = LUPI82_1200,
Specific2010 = LUPI07_1200) %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "UK", "United Kingdom", Country)) %>%
mutate(Country = ifelse(Country == "US", "United States", Country)) %>%
filter(Year %in% 1980:2010)
perf %>%
d.perf <- # Delete Years for which we don't have data
filter(Year >= 1980 & Year <= 2005) %>%
gather(Indicator, Performance, -Country, -Year) %>%
# Select specific performance indicators
filter(Indicator %in% c("General", "Water", "Specific1980")) %>%
droplevels()
reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
Y.performance <- dim(Y.performance)[3] nYperformance <-
World Development Indicators - Revenue.
load("wdi/wdi-tax.RData")
tax.rev %>%
tax.rev.l <- select(Country = country, tax.revenue = GC.TAX.TOTL.GD.ZS, Year = year) %>%
group_by(Country) %>%
summarize(tax.revenue = median(tax.revenue, na.rm = TRUE))
World Development Indicators:
load("wdi/wdi.RData")
wdi[,c("country", "year", "gdp", "population", "gdp.capita", "trade")]
wdi <- subset(wdi, year >= 1976 & year <=2005)
wdi <-$country[wdi$country=="Korea, Rep."] <- "South Korea"
wdi subset(wdi, country %in% countries)
wdi <-
# GDP pc in Ireland is bad
subset(wdi, country=="Ireland")
ireland.wdi <-
# So we use the combination of GDP and population
# to make a regression against the observed GDP per capita
# and impute accordingly.
cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
ireland.wdi <- lm(gdp.capita ~ year, data=ireland.wdi)
m.ireland <-$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]
# Switzerland is not so bad, but still problematic until 1979.
# But the procedure does not work, because GDP is also missing.
# So a simple imputation based on evolution over time is performed.
subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
switzerland.wdi <- lm(gdp.capita ~ year, data=switzerland.wdi)
m.switzerland <-$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
#New Zealand only misses 1976' GDP per capita,
# so the same procedure than with Switzerland is used.
subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
newzealand.wdi <- lm(gdp.capita ~ year, data=newzealand.wdi)
m.newzealand <-$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
wdi predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]
subset(wdi, country=="Switzerland")
switzerland.wdi <- lm(trade ~ year, data=switzerland.wdi)
m.switzerland <-$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
wdi predict(m.switzerland, switzerland.wdi)[1:(length(predict(m.switzerland, switzerland.wdi)) - (length(predict(m.switzerland))))]
# GDP per capita growth
# Another way at looking at resources, is to calculate
# how many times is the overall wealth per capita at the
# end of the period compared to the beginning.
subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gdp.capita.ratio <- wdi.gdp.capita.ratio %>%
wdi.gcr.w <- spread(year, gdp.capita)
cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)
wdi.gcr.w <-
# Data is averaged by country through all years.
wdi %>%
wdi.c <- gather(variable, value, -country, -year) %>%
group_by(country, variable) %>%
summarize(m = median(value, na.rm = TRUE)) %>%
ungroup()
# Include GDP per capita growth, ratio
wdi.gcr.w %>%
wdi.l <- select(country, gdpc.ratio) %>%
mutate(variable = "gdpc.ratio") %>%
rename(m = gdpc.ratio) %>%
select(country, variable, m) %>%
bind_rows(wdi.c)
Democracy:
V-Dem, use the average of the 5 dimensions
load("~/est/country_data/v-dem-v9/v_dem-ra-1950_2018.RData") # loads vdem
vdem %>%
vdem <-# filter(Democracy == "Deliberative") %>%
mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "Germany (RDA)", "Germany", Country)) %>%
mutate(Country = ifelse(Country == "United States of America", "United States", Country)) %>%
mutate(Country = ifelse(Country == "South Korea", "Korea, Republic of", Country)) %>%
filter(Country %in% countries) %>%
mutate(Country = as.factor(Country)) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Country, Year) %>%
summarize(Democracy = mean(value, na.rm = TRUE)) #%>%
# expand_grid(Sector = c("Environmental", "Social"))
Government effectiveness. Data retrieved manually from the World Bank page on Governance indicators. Only the “Government Effectiveness: Estimation” is used. The data is only available between 1996 and 2005.
load("wgi/wgi-full-v201029.RData")
wgi %>%
gov.eff.original <- filter(indicator == "Government effectiveness") %>%
select(country, year, value = Estimate) %>%
expand_grid(Sector = c("Environmental", "Social"))
Add fake government effectiveness
range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)
range.ge.env <-
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Environmental",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.env[1],
2],
range.ge.env[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
gov.eff.original %>%
gov.eff.original <- bind_rows(expand_grid(tibble(Sector = "Social",
country = paste0("Z-", sprintf("%02d", 2:11)),
value = seq(range.ge.soc[1],
2],
range.ge.soc[length.out = length(2:11))),
year = min(D$Year):max(D$Year)))
Political Constraints - polconIII. An indicator of “veto players” comes from Henisz (2002). The indicator “estimates the feasibility of policy change. [That is], the extent to which a change in the preferences of any one actor may lead to a change in government policy”. Higher values represent systems with higher constraints.
load("polcon/polcon2017.RData") # loads polcon
Add fake political constraints values.
polcon %>%
polcon.d <- as_tibble() %>%
filter(year %in% years[1]:years[2]) %>%
mutate(country.polity = as.character(country.polity)) %>%
mutate(country.polity = ifelse(country.polity == "Germany West", "Germany", country.polity)) %>%
filter(country.polity %in% countries) %>%
select(Country = country.polity, Year = year, polcon)
polcon.d %>%
range.polcon <- select(polcon) %>%
unlist(., use.names = FALSE) %>%
range()
polcon.d %>%
polcon.d <- bind_rows(expand_grid(tibble(Country = paste0("Z-", sprintf("%02d", 12:21)),
polcon = seq(range.polcon[1],
2],
range.polcon[length.out = length(12:21))),
Year = min(D$Year):max(D$Year)))
For the “Green parties”, data comes from Volkens (2013). It provides dates of elections as well as shares of seats of several families of parties. We generate two indicators for the “green” and “socialist” ideology of the countries, with a weighted average of the proportion of seats and the duration of each legislature.
load("manifesto/cpm-consensus.RData")
$country <- as.character(cpm$country)
cpm$country[cpm$country=="Korea"] <- "South Korea"
cpm$country[cpm$country=="Great Britain"] <- "United Kingdom"
cpm subset(cpm, country %in% countries)
cpm <-$country <- factor(cpm$country)
cpm subset(cpm, date>="1970-01-01" & date<="2005-12-31")
cpm <-
# Take only Green parties and Socialist=social democrats + communists
$family <- as.character(cpm$family)
cpm$family[cpm$family=="Social democratic"] <- "Socialist"
cpm$family[cpm$family=="Communist"] <- "Socialist"
cpm subset(cpm, family=="Green" | family=="Socialist")
cpm <-$family <- factor(cpm$family)
cpm
# Aggregate duplications in Socialist
cpm %>%
cpm <- group_by(country, date, family) %>%
summarize(p.seats=sum(p.seats))
# Calculate the weighted means.
# Unfortunately, a ddply approach would be too complicated and a loop solves it quite quickly.
c("Green", "Socialist")
families <- data.frame(country=countries, Green=NA, Socialist=NA)
wmsf <-for (C in 1:nC) {
for (F in 1:length(families)) {
subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
series <- series[order(series$date),]
series <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
v <-is.nan(v)] <- 0
v[1+F] <- v
wmsf[C,
} }
For the salience of each topic, we employ data from Volkens (2013), weighting the proportion of votes to each party and the importance that each party gives to environmental issues or the expansion of social welfare.
load("manifesto/201029-cpm-salience.RData")
cpm.salience %>%
salience <- filter(Country %in% countries) %>%
filter(!Country %in% c("South Korea", "Turkey")) %>%
filter(Year %in% years[1]:years[2])
Border contiguity
load("borders/geography.RData")
M.borders[dimnames(M.borders)[[1]] %in% countries,
m.borders <-dimnames(M.borders)[[2]] %in% countries]
Trade dependency
load("trade/trade.RData")
rm(M.trade, M.trade.imports)
Save and arrange for analysis.
diversity %>%
diversity <- # Delete Turkey and Korea
filter(!Country %in% c("South Korea", "Turkey")) %>%
droplevels()
diversity %>%
diversity.l <- gather(Measure, value, -c(Sector, Country, Year))
reshape2::acast(diversity.l,
Y <-~ Country ~ Year ~ Measure, value.var = "value")
Sector dim(Y)[1]
nS <- dim(Y)[2]
nC <- dim(Y)[3]
nY <- dim(Y)[4]
nD <-
dimnames(Y)[[2]]
country.label <- length(country.label)
nC <- 21
nC.fake <- nC - nC.fake
nC.real <- 1:nC.real
id.real.countries <- (nC.real + 1):nC
id.fake.countries <-
dimnames(Y)[[1]]
sector.label <- length(sector.label)
nS <-
dimnames(Y)[[3]]
year.label <- as.integer(as.numeric(year.label))
year.label.numeric <- length(year.label)
nY <-
paste0(str_sub(year.label, 1, 3), "0s")
decade.text <- as.numeric(as.factor(decade.text))
id.decade <- levels(as.factor(decade.text))
decade.label <- length(decade.label)
nDecades <-
dimnames(Y)[[4]]
diversity.label <- length(diversity.label)
nD <-
11
nB <- rep(0, nB)
b0 <- diag(nB)
B0 <-diag(B0) <- 1^-2
# Function to assign zeros to the fake countries (mean value)
function(x, id = id.fake.countries) { # zero to fake countries
zero.fk <- 0
x[id] <-return(x)
}
source("get-eu_time.R") # generates eu.ms
# Fake countries
paste0("Z-", sprintf("%02d", 1:21))
f.c <-# Fake years
year.label.numeric
f.y <-
wdi %>%
GDPpc <- select(country, year, gdp.capita) %>%
filter(country %in% country.label) %>%
mutate(gdp.capita = std(gdp.capita)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, gdp.capita = 0)) %>%
reshape2::acast(country ~ year, value.var = "gdp.capita")
if ( length(which(!dimnames(GDPpc)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
wdi %>%
trade.df <- select(country, year, trade) %>%
filter(country %in% country.label) %>%
mutate(trade = std(trade)) %>%
bind_rows(expand_grid(country = f.c, year = f.y, trade = 0))
trade.df %>%
trade <- reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
vdem %>%
democracy <- mutate(Country = as.character(Country)) %>%
mutate(Country = ifelse(Country == "United States of America", "United States", Country)) %>%
mutate(Country = ifelse(Country == "Germany (RDA)", "Germany", Country)) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
mutate(Democracy = std(Democracy)) %>%
select(Country, Year, Democracy) %>%
bind_rows(expand_grid(Country = f.c, Year = f.y, Democracy = 0)) %>%
reshape2::acast(Country ~ Year, value.var = "Democracy")
if ( length(which(!dimnames(democracy)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand_grid(Country = country.label,
constraints.d <-Year = year.label.numeric) %>%
left_join(polcon.d) %>%
mutate(original.polcon = polcon) %>%
mutate(polcon = std(polcon)) %>%
mutate(polcon = ifelse(str_detect(Country, "^Z-") & is.na(polcon), 0, polcon))
constraints.d %>%
constraints <- reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(
gov.eff.df <-country = country.label,
year = year.label.numeric,
Sector = sector.label) %>%
left_join(gov.eff.original) %>%
filter(country %in% country.label) %>%
filter(year >= 1976 & year <= 2005) %>%
mutate(value = std(value)) %>%
select(Sector, country, year, value) %>%
mutate(value = ifelse(str_detect(country, "^Z-") & is.na(value), 0, value))
gov.eff.df %>%
gov.eff <- reshape2::acast(Sector ~ country ~ year, value.var = "value")
if ( length(which(!dimnames(gov.eff)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
function(x) return(min(x[x!=0]))
min.discard.zero <-
portfolio.size <- D %>%
filter(Measure == "Size") %>%
spread(Measure, value) %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector) %>%
mutate(Size = ifelse(Size == 0, min.discard.zero(Size)/2, Size)) %>%
mutate(Size = std(logit(Size))) %>%
mutate(Size = ifelse(str_detect(Country, "Z2"), 0, Size)) %>%
ungroup() %>%
select(Country, Sector, Year, Size) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Size")
if ( length(which(!dimnames(portfolio.size)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
expand.grid(country = country.label, year = 1958:2020) %>%
eu <- as_tibble() %>%
mutate(eu = 0) %>%
left_join(eu.ms, by = c("country" = "ms")) %>%
mutate(eu = ifelse(year == ms.y, 1, eu)) %>%
mutate(eu = ifelse(is.na(eu), 0, eu)) %>%
group_by(country) %>%
arrange(country, year) %>%
mutate(eu = cumsum(eu)) %>%
ungroup() %>%
select(country, year, eu) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
reshape2::acast(country ~ year, value.var = "eu")
if ( length(which(!dimnames(eu)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Green socialist as salience
salience %>%
green.socialist <- group_by(Sector) %>%
mutate(Salience = std(Salience)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label, Country = f.c, Year = f.y, Salience = 0)) %>%
reshape2::acast(Sector ~ Country ~ Year, value.var = "Salience")
if ( length(which(!dimnames(green.socialist)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Borders in tidy data
interdependency.contiguity <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(geography %>%
select(Origin, Destination, p.contiguous),
by = c("Destination" = "Destination")) %>%
mutate(wDiversity = value * p.contiguous) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(contiguity.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(contiguity.dependency = std(contiguity.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
contiguity.dependency = 0))
interdependency.contiguity %>%
interdependency.contiguity <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "contiguity.dependency")
if ( length(which(!dimnames(interdependency.contiguity)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Trade in tidy data
interdependency.trade <- select(diversity.l, Sector, Destination = Country, Year, Measure, value) %>%
left_join(trade.p %>%
ungroup() %>%
select(Origin, Destination, Year, p.Exports),
by = c("Destination" = "Destination", "Year" = "Year")) %>%
mutate(wDiversity = value * p.Exports) %>%
mutate(Origin = as.character(Origin),
Destination = as.character(Destination)) %>%
filter(Origin != Destination) %>%
rename(Country = Origin) %>%
group_by(Sector, Country, Year, Measure) %>%
summarize(trade.dependency = sum(wDiversity, na.rm = TRUE)) %>%
ungroup() %>%
filter(Country %in% country.label) %>%
filter(Year >= 1976 & Year <= 2005) %>%
group_by(Sector, Measure) %>%
mutate(trade.dependency = std(trade.dependency)) %>%
ungroup() %>%
bind_rows(expand_grid(Sector = sector.label,
Country = f.c,
Year = f.y,
Measure = diversity.label,
trade.dependency = 0))
interdependency.trade %>%
interdependency.trade <- reshape2::acast(Measure ~ Sector ~ Country ~ Year, value.var = "trade.dependency")
if ( length(which(!dimnames(interdependency.trade)[[3]] == country.label)) > 0) stop("Ep! There is a mistake here")
# Performance part
# Match it with the general Y, but only for the environmental sector
expand_grid(
d.perf.fake <-Country = country.label[str_detect(country.label, "^Z-") ],
Year = year.label.numeric,
Indicator = unique(d.perf$Indicator),
Performance = NA)
diversity.l %>%
Y.performance <- select(Sector, Country, Year, Measure) %>%
left_join(d.perf) %>%
left_join(d.perf.fake) %>%
filter(Sector == "Environmental") %>%
group_by(Indicator) %>%
mutate(Performance = std1(Performance)) %>%
ungroup() %>%
reshape2::acast(Indicator ~ Country ~ Year ~ Measure, value.var = "Performance")
# manually get rid of ghost performance for missing values
Y.performance[-4,,,]
Y.performance <-
dim(Y.performance)[1]
nP <- dimnames(Y.performance)[[1]]
performance.label <-if ( length(which(!dimnames(Y.performance)[[2]] == country.label)) > 0) stop("Ep! There is a mistake here")
load("wdi/wdi-gdpgrowth.RData") # gdp.growth
gdp.growth %>%
gdp.growth <- select(country, year, gdp.growth = NY.GDP.MKTP.KD.ZG) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(gdp.growth = std(gdp.growth)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "gdp.growth")
gdp.growth[,-dim(gdp.growth)[2]]
gdp.growth <-if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means <-is.nan(gdp.growth.means)] <- 0
gdp.growth.means[
load("wdi/wdi-urban.RData") # urban
urban %>%
urban <- select(country, year, urban = SP.URB.TOTL.IN.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(urban = std(urban)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "urban")
urban[,-dim(urban)[2]]
urban <-if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(urban, 1, mean, na.rm = TRUE)
urban.means <-is.nan(urban.means)] <- 0
urban.means[
load("wdi/wdi-industry.RData") # industry
industry %>%
industry <- select(country, year, industry = NV.IND.TOTL.ZS) %>%
filter(country %in% country.label) %>%
filter(year %in% year.label.numeric) %>%
mutate(industry = std(industry)) %>%
right_join(tibble(country = country.label)) %>%
reshape2::acast(country ~ year, value.var = "industry")
industry[,-dim(industry)[2]]
industry <-if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
apply(industry, 1, mean, na.rm = TRUE)
industry.means <-is.nan(industry.means)] <- 0
industry.means[
list(
DP <-Y = unname(Y),
Y.performance = unname(Y.performance), nP = nP,
GDPpc = unname(GDPpc),
trade = unname(trade),
democracy = unname(democracy),
constraints = unname(constraints),
gov.eff = unname(gov.eff),
gov.eff.mean.observed = unname(apply(gov.eff, c(1, 2), mean, na.rm = TRUE)),
interdependency.contiguity = unname(interdependency.contiguity),
interdependency.trade = unname(interdependency.trade),
portfolio.size = unname(portfolio.size),
eu = unname(eu),
green.socialist = unname(green.socialist),
gdp.growth = unname(gdp.growth), gdp.growth.means = unname(gdp.growth.means),
urban = unname(urban), urban.means = unname(urban.means),
industry = unname(industry), industry.means = unname(industry.means),
nC = nC,
id.fake.countries = id.fake.countries,
id.real.countries = id.real.countries,
id.decade = id.decade, nDecades = nDecades,
nB = nB, b0 = b0, B0 = B0,
nS = nS,
nD = nD,
nY = nY)
# Number of countries (including fake ones) nC
## [1] 42
# Number of sectors nS
## [1] 2
# Range of years years
## [1] 1976 2005
"diversity-democracy"
M <- "Diversity (AID), robustness, democracy"
M.lab <- "model {
m <- #
# Data part at the observational level
#
for (d in 1:nD) {
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
+ beta[1,s,d] * GDPpc[c,t-1]
+ beta[3,s,d] * democracy[c,t-1]
+ beta[4,s,d] * gov.eff[s,c,t-1]
+ beta[5,s,d] * portfolio.size[s,c,t-1]
+ beta[6,s,d] * trade[c,t-1]
+ beta[7,s,d] * eu[c,t-1]
+ beta[8,s,d] * green.socialist[s,c,t-1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,t-1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,t]
+ beta[11,s,d] * interdependency.trade[d,s,c,t]
+ rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,t]
+ gamma[c,d])
resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
}
Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
mu[s,c,1,d] <- alpha[s,d,1]
+ beta[1,s,d] * GDPpc[c,1]
+ beta[3,s,d] * democracy[c,1]
+ beta[4,s,d] * gov.eff[s,c,1]
+ beta[5,s,d] * portfolio.size[s,c,1]
+ beta[6,s,d] * trade[c,1]
+ beta[7,s,d] * eu[c,1]
+ beta[8,s,d] * green.socialist[s,c,1] # col 1 green, col 2 socialist
+ beta[9,s,d] * constraints[c,1]
+ beta[10,s,d] * interdependency.contiguity[d,s,c,1]
+ beta[11,s,d] * interdependency.trade[d,s,c,1]
resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
+ lambda[2,s,d] * portfolio.size[s,c,1]
+ gamma[c,d])
}
#
# Degrees of freedom of GR
#
nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
nu.trans[s,d] ~ dunif(0, 1)
#
# Priors for variance component
#
lambda[1,s,d] ~ dnorm(0, 2^-2)
lambda[2,s,d] ~ dnorm(0, 2^-2)
#
# Priors for the intercept
#
for (decade in 1:nDecades) {
alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
}
Alpha[s,d] ~ dunif(0, 1)
tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
sigma.alpha[s,d] ~ dunif(0, 0.5)
#
# Priors for the control variables
#
beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
}
#
# Data part for performance
#
for (p in 1:nP) {
for (c in 1:nC) {
for (t in 2:nY) {
Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
mu.performance[p,c,t,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,t,d]
+ eta.performance[3,p,d] * Y[1,c,t-1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,t-1]
+ eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
+ eta.performance[6,p,d] * GDPpc[c,t-1]
+ eta.performance[7,p,d] * trade[c,t-1]
+ eta.performance[8,p,d] * eu[c,t-1]
+ eta.performance[9,p,d] * gdp.growth[c,t-1]
+ eta.performance[10,p,d] * urban[c,t-1]
+ eta.performance[11,p,d] * industry[c,t-1]
}
Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
mu.performance[p,c,1,d] <- eta.performance[1,p,d]
+ eta.performance[2,p,d] * resid[1,c,1,d]
+ eta.performance[3,p,d] * Y[1,c,1,d]
+ eta.performance[4,p,d] * portfolio.size[1,c,1]
+ eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
+ eta.performance[6,p,d] * GDPpc[c,1]
+ eta.performance[7,p,d] * trade[c,1]
+ eta.performance[8,p,d] * eu[c,1]
+ eta.performance[9,p,d] * gdp.growth[c,1]
+ eta.performance[10,p,d] * urban[c,1]
+ eta.performance[11,p,d] * industry[c,1]
}
tau.performance[p,d] ~ dgamma(0.001, 0.001)
sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
for (e in 1:11) {
eta.performance[e,p,d] ~ dnorm(0, 1^-2)
}
}
# Variance component, varying intercepts by country
for (c in 1:nC) {
gamma[c,d] ~ dnorm(0, 0.2^-2)
}
#
# AR(1) parameters
#
for (c in id.real.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dunif(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dunif(-1, 1)
}
}
for (c in id.fake.countries) {
for (s in 1:nS) {
rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
for (p in 1:nP) {
rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
}
}
}
# SEM Part for portfolio size
for (s in 1:nS) {
for (c in 1:nC) {
for (t in 2:nY) {
portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
mu.ps[s,c,t] <- alpha.ps[s,c]
+ delta[1,s] * GDPpc[c,t-1]
+ delta[2,s] * gov.eff[s,c,t-1]
+ delta[3,s] * green.socialist[s,c,t-1]
+ delta[4,s] * constraints[c,t-1]
}
tau.ps[s,c] ~ dgamma(0.1, 0.1)
sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
alpha.ps[s,c] ~ dnorm(0, 1^-2)
}
for (d in 1:4) {
delta[d,s] ~ dnorm(0, 1^-2)
}
}
# Mediated effects
for (d in 1:nD) {
for (s in 1:nS) {
pi[1,s,d] <- delta[1,s] * beta[1,s,d] # GDPpc
pi[2,s,d] <- delta[2,s] * beta[4,s,d] # gov.eff
pi[3,s,d] <- delta[3,s] * beta[8,s,d] # green
pi[4,s,d] <- delta[4,s] * beta[9,s,d] # constraints
}
}
#
# Missing data
#
for (c in 1:nC) {
for (t in 1:nY) {
gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
}
}
for (s in 1:nS) {
for (c in 1:nC) {
# Reverse years back for NA in early years
for (t in 1:(nY-1)) {
green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
}
for (d in 1:nD) {
for (t in 1:(nY-1)) {
interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
}
}
}
}
}"
write(m, file= paste("models/model-", M, ".bug", sep = ""))
NULL
par <- c(par, "alpha", "beta", "theta", "sigma")
par <- c(par, "Alpha", "sigma.alpha")
par <- c(par, "Sigma")
par <- c(par, "lambda", "gamma")
par <- c(par, "nu")
par <- c(par, "rho")
par <- expand_grid(Sector = 1:nS,
par.fake <-Country = id.fake.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.fake)
par <- expand_grid(Sector = 1:nS,
par.resid <-Country = id.real.countries,
Year = 2:nY,
Diversity = 1:nD) %>%
mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
select(parameter) %>%
unlist(., use.names = FALSE)
c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
par <- list(
inits <-list(.RNG.name="base::Super-Duper", .RNG.seed=10),
list(.RNG.name="base::Super-Duper", .RNG.seed=20),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=30),
list(.RNG.name="base::Wichmann-Hill", .RNG.seed=20))
proc.time()
t0 <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
rj <-data = dump.format(DP, checkvalid=FALSE),
inits = inits,
modules = "glm",
n.chains = 1, adapt = 2e2, burnin = 1e3, sample = 2e3, thin = 1,
monitor = par, method = "parallel", summarise = FALSE)
as.mcmc.list(rj)
s <-save(s, file = paste("sample-", M, ".RData", sep = ""))
proc.time() - t0
load(file = paste("sample-", M, ".RData", sep = ""))
cat(str_remove_all(m, "#.+\n"))
## model {
## #
## #
## for (d in 1:nD) {
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y[s,c,t,d] ~ dnorm(mu[s,c,t,d], tau[s,c,t,d])
## mu[s,c,t,d] <- alpha[s,d,id.decade[t]]
## + beta[1,s,d] * GDPpc[c,t-1]
## + beta[3,s,d] * democracy[c,t-1]
## + beta[4,s,d] * gov.eff[s,c,t-1]
## + beta[5,s,d] * portfolio.size[s,c,t-1]
## + beta[6,s,d] * trade[c,t-1]
## + beta[7,s,d] * eu[c,t-1]
## + beta[8,s,d] * green.socialist[s,c,t-1] + beta[9,s,d] * constraints[c,t-1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,t]
## + beta[11,s,d] * interdependency.trade[d,s,c,t]
## + rho[s,c,d] * (Y[s,c,t-1,d] - mu[s,c,t-1,d] )
## tau[s,c,t,d] <- 1 / sigma.sq[s,c,t,d]
## sigma.sq[s,c,t,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,t]
## + gamma[c,d])
## resid[s,c,t,d] <- Y[s,c,t,d] - mu[s,c,t,d]
## }
## Y[s,c,1,d] ~ dnorm(mu[s,c,1,d], tau[s,c,1,d])
## mu[s,c,1,d] <- alpha[s,d,1]
## + beta[1,s,d] * GDPpc[c,1]
## + beta[3,s,d] * democracy[c,1]
## + beta[4,s,d] * gov.eff[s,c,1]
## + beta[5,s,d] * portfolio.size[s,c,1]
## + beta[6,s,d] * trade[c,1]
## + beta[7,s,d] * eu[c,1]
## + beta[8,s,d] * green.socialist[s,c,1] + beta[9,s,d] * constraints[c,1]
## + beta[10,s,d] * interdependency.contiguity[d,s,c,1]
## + beta[11,s,d] * interdependency.trade[d,s,c,1]
##
## resid[s,c,1,d] <- Y[s,c,1,d] - mu[s,c,1,d]
## tau[s,c,1,d] <- 1 / sigma.sq[s,c,1,d]
## sigma.sq[s,c,1,d] <- exp(lambda[1,s,d]
## + lambda[2,s,d] * portfolio.size[s,c,1]
## + gamma[c,d])
## }
##
##
## #
## #
## nu[s,d] <- 1 + (-1 * log(nu.trans[s,d]))
## nu.trans[s,d] ~ dunif(0, 1)
##
## #
## #
## lambda[1,s,d] ~ dnorm(0, 2^-2)
## lambda[2,s,d] ~ dnorm(0, 2^-2)
##
## #
## #
## for (decade in 1:nDecades) {
## alpha[s,d,decade] ~ dnorm(Alpha[s,d], tau.alpha[s,d])
## }
## Alpha[s,d] ~ dunif(0, 1)
## tau.alpha[s,d] <- 1 / sqrt(sigma.alpha[s,d])
## sigma.alpha[s,d] ~ dunif(0, 0.5)
##
## #
## #
## beta[1:nB,s,d] ~ dmnorm(b0, Omega[1:nB,1:nB,s,d])
## Omega[1:nB,1:nB,s,d] ~ dwish(B0, nB + 1)
## Sigma[1:nB,1:nB,s,d] <- inverse(Omega[1:nB,1:nB,s,d])
## }
## #
## #
## for (p in 1:nP) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## Y.performance[p,c,t,d] ~ dnorm(mu.performance[p,c,t,d], tau.performance[p,d])
## mu.performance[p,c,t,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,t,d]
## + eta.performance[3,p,d] * Y[1,c,t-1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,t-1]
## + eta.performance[5,p,d] * Y[1,c,t-1,d] * portfolio.size[1,c,t-1]
## + eta.performance[6,p,d] * GDPpc[c,t-1]
## + eta.performance[7,p,d] * trade[c,t-1]
## + eta.performance[8,p,d] * eu[c,t-1]
## + eta.performance[9,p,d] * gdp.growth[c,t-1]
## + eta.performance[10,p,d] * urban[c,t-1]
## + eta.performance[11,p,d] * industry[c,t-1]
## }
## Y.performance[p,c,1,d] ~ dnorm(mu.performance[p,c,1,d], tau.performance[p,d])
## mu.performance[p,c,1,d] <- eta.performance[1,p,d]
## + eta.performance[2,p,d] * resid[1,c,1,d]
## + eta.performance[3,p,d] * Y[1,c,1,d]
## + eta.performance[4,p,d] * portfolio.size[1,c,1]
## + eta.performance[5,p,d] * Y[1,c,1,d] * portfolio.size[1,c,1]
## + eta.performance[6,p,d] * GDPpc[c,1]
## + eta.performance[7,p,d] * trade[c,1]
## + eta.performance[8,p,d] * eu[c,1]
## + eta.performance[9,p,d] * gdp.growth[c,1]
## + eta.performance[10,p,d] * urban[c,1]
## + eta.performance[11,p,d] * industry[c,1]
## }
## tau.performance[p,d] ~ dgamma(0.001, 0.001)
## sigma.performance[p,d] <- 1 / sqrt(tau.performance[p,d])
## for (e in 1:11) {
## eta.performance[e,p,d] ~ dnorm(0, 1^-2)
## }
## }
##
## for (c in 1:nC) {
## gamma[c,d] ~ dnorm(0, 0.2^-2)
## }
## #
## #
## for (c in id.real.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dunif(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dunif(-1, 1)
## }
## }
## for (c in id.fake.countries) {
## for (s in 1:nS) {
## rho[s,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## for (p in 1:nP) {
## rho.performance[p,c,d] ~ dnorm(0.75, 0.2^-2)T(-1, 1)
## }
## }
## }
##
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 2:nY) {
## portfolio.size[s,c,t] ~ dnorm(mu.ps[s,c,t], tau.ps[s,c])
## mu.ps[s,c,t] <- alpha.ps[s,c]
## + delta[1,s] * GDPpc[c,t-1]
## + delta[2,s] * gov.eff[s,c,t-1]
## + delta[3,s] * green.socialist[s,c,t-1]
## + delta[4,s] * constraints[c,t-1]
## }
## tau.ps[s,c] ~ dgamma(0.1, 0.1)
## sigma.ps[s,c] <- 1 / sqrt(tau.ps[s,c])
## alpha.ps[s,c] ~ dnorm(0, 1^-2)
## }
## for (d in 1:4) {
## delta[d,s] ~ dnorm(0, 1^-2)
## }
## }
## for (d in 1:nD) {
## for (s in 1:nS) {
## pi[1,s,d] <- delta[1,s] * beta[1,s,d] pi[2,s,d] <- delta[2,s] * beta[4,s,d] pi[3,s,d] <- delta[3,s] * beta[8,s,d] pi[4,s,d] <- delta[4,s] * beta[9,s,d] }
## }
##
##
##
## #
## #
## for (c in 1:nC) {
## for (t in 1:nY) {
## gov.eff[1,c,t] ~ dnorm(mean(gov.eff.mean.observed[1,c]), 0.05^-2)
## gov.eff[2,c,t] ~ dnorm(gov.eff[1,c,t], 100)
## gdp.growth[c,t] ~ dnorm(gdp.growth.means[c], 0.05^-2)
## urban[c,t] ~ dnorm(urban.means[c], 0.05^-2)
## industry[c,t] ~ dnorm(industry.means[c], 0.05^-2)
## }
## }
## for (s in 1:nS) {
## for (c in 1:nC) {
## for (t in 1:(nY-1)) {
## green.socialist[s,c,t] ~ dnorm(green.socialist[s,c,t+1], 0.05^-2)
## }
## for (d in 1:nD) {
## for (t in 1:(nY-1)) {
## interdependency.trade[d,s,c,t] ~ dnorm(interdependency.trade[d,s,c,t+1], 0.05^-2)
## }
## }
## }
## }
## }
ggmcmc(ggs(s, family = "sigma|alpha|beta|lambda|rho|nu"),
param_page = 10, file = paste("ggmcmc-full-", M, ".pdf", sep = ""))
Variance components.
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-ggs_caterpillar(S.lambda, label = "Variable", comparison = "Sector") +
aes(color = Sector) +
facet_wrap(~ Diversity) +
theme(legend.position = "right") +
ggtitle("Variance component")
Figure 106: Variance component.
rm(S.lambda)
plab("lambda", list(Variable = c("(Intercept)",
L.lambda <-"Portfolio size",
"Constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda <-%>%
S.lambda filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable") +
ggtitle("Variance component")
Figure 107: Variance component.
rm(S.lambda)
Variance components (country varying intercepts).
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.gamma, label = "Country") +
facet_grid(~ Diversity) +
ggtitle("Variance component (countries)")
Figure 108: Variance component (country varying intercepts).
rm(S.gamma)
plab("gamma", list(Country = country.label,
L.gamma <-Diversity = diversity.label))
ggs(s, family = "gamma\\[", par_labels = L.gamma)
S.gamma <- S.gamma %>%
S.gamma <- filter(!str_detect(Country, "^Z-")) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)")
ggs_caterpillar(S.gamma, label = "Country") +
ggtitle("Variance component (countries)")
Figure 109: Variance component (country varying intercepts).
rm(S.gamma)
Auto-regressive components.
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
facet_grid(Diversity ~ Sector, scales="free") +
aes(color=Sector) +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 110: Auto-regressive component.
rm(S.rho)
plab("rho", list(Sector = sector.label,
L.rho <-Country = country.label,
Diversity = diversity.label))
ggs(s, family = "rho", par_labels = L.rho) %>%
S.rho <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(!str_detect(Country, "^Z-"))
ggs_caterpillar(S.rho, label = "Country") +
expand_limits(x = c(-1, 1)) +
ggtitle("Auto-regressive component (countries)") +
scale_colour_xfim()
Figure 111: Auto-regressive component.
rm(S.rho)
Intercepts
plab("alpha", list(Sector = sector.label,
L.alpha <-Diversity = diversity.label,
Decade = decade.label))
ggs(s, family = "^alpha\\[", par_label = L.alpha)
S.alpha <-
ci(S.alpha) %>%
ggplot(aes(x = Decade, y = median, ymin = Low, ymax = High)) +
geom_point() +
geom_linerange() +
facet_grid(Diversity ~ Sector) +
ggtitle("Temporal trend")
Figure 112: Intercepts.
c("GDP pc",
covariates.label <-"Consensus",
"Democracy",
"Government effectiveness",
"Portfolio size",
"Trade", "EU", "Salience",
"Political constraints",
"Interdependency (Contiguity)",
"Interdependency (Trade)")
plab("beta", list(Variable = covariates.label,
L.betas <-Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
S.betas <- filter(!Variable %in% c("Deliberation", "Consensus"))
ci(S.betas)
ci.betas <-save(ci.betas, file = paste0("ci-betas-", M, ".RData"))
%>%
S.betas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 113: Slopes with the effects on diversity, by sector.
ci(S.betas) %>%
filter(Sector == "Environmental") %>%
ggplot(aes(x = Variable,
y = median,
group = Diversity,
color = Diversity)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 114: Slopes with the effects on diversity, for the environmental sector.
ci(S.betas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
facet_wrap(~ Diversity, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 115: Slopes with the effects on diversity, by diversity indicator.
ci(S.betas) %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = Variable,
y = median,
group = Sector, color = Sector)) +
coord_flip() +
geom_point(size = 3, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.2)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.2)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 116: Slopes with the effects on AID diversity, by sector
ggplot(S.betas, aes(x = value, color = Sector, fill = Sector)) +
geom_density(alpha = 0.5) +
facet_grid(Diversity ~ Variable, scales = "free") +
xlab("HPD") +
geom_vline(xintercept = 0, lty = 3)
Figure 117: Slopes with the effects on diversity, comparing sectors.
Variables by evidence.
%>%
S.betas filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(value != 0) %>%
group_by(Sector, Diversity, Variable) %>%
summarize(`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
group_by(Sector, Diversity, Variable) %>%
mutate(max = max(abs(`Prob > 0`), abs(`Prob < 0`))) %>%
arrange(desc(max)) %>%
select(-max, -Diversity) %>%
kable()
S.betas %>%
S.betas.env <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) #%>%
ggs_caterpillar(S.betas.env) +
geom_vline(xintercept = 0, lty = 3)
Figure 118: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas %>%
S.betas.env.sorted <- filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
mutate(Parameter = as.character(Variable)) %>%
mutate(Parameter = fct_relevel(Parameter, rev(c("Political constraints",
"Government effectiveness",
"Democracy",
"Salience",
"GDP pc", "Trade", "EU",
"Interdependency (Contiguity)",
"Interdependency (Trade)",
"Portfolio size"))))
ggs_caterpillar(S.betas.env.sorted, sort = FALSE) +
geom_vline(xintercept = 0, lty = 3)
Figure 119: Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci(S.betas) %>%
ci.betas <- mutate(Model = M.lab)
save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
plab("delta", list(Variable = c("GDP pc",
L.deltas <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label))
ggs(s, family = "^delta\\[", par_labels = L.deltas)
S.deltas <-
%>%
S.deltas group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.deltas) %>%
ggplot(aes(x = Variable,
y = median,
group = Sector)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3)
Figure 120: Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
ci(S.pis) %>%
ggplot(aes(x = Variable,
y = median,
group = interaction(Sector, Diversity),
color = Diversity)) +
coord_flip() +
facet_wrap(~ Sector, scales="free") +
geom_point(size = 3, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = Low, ymax = High), size = 1.5, position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = low, ymax = high), size = 0.5, position = position_dodge(width = 0.3)) +
ylab("HPD") + xlab("Parameter") +
geom_hline(yintercept = 0, lty = 3) +
scale_colour_xfim()
Figure 121: Mediated effects on diversity, by sector.
plab("pi", list(Variable = c("GDP pc",
L.pi <-"Government effectiveness",
"Salience",
"Political constraints"),
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
S.pis <- filter(Variable != "GDP pc")
%>%
S.pis group_by(Variable, Sector) %>%
summarize(median = median(value), sd = sd(value),
`Prob > 0` = length(which(value > 0)) / n(),
`Prob < 0` = length(which(value < 0)) / n(),
`Mean expected effect` = mean(value)) %>%
kable()
%>%
S.pis filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggs_caterpillar(label = "Variable")
Figure 122: Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
L.eta <-"Diversity", "Portfolio size",
"Diversity * Portfolio size",
"GDPpc", "Trade", "EU",
"GDP growth", "Urban", "Industry"),
Performance = performance.label,
Diversity = diversity.label))
ggs(s, family = "eta.performance", par_label = L.eta)
S.eta <-
ggs_caterpillar(S.eta, label = "Covariate", comparison = "Performance") +
geom_hline(yintercept = 0, lty = 3) +
aes(color = Performance) +
theme(legend.position = "right") +
facet_wrap(~ Diversity)
Figure 123: Direct effects on Environmental performance, by performance indicator and Diversity measure.
%>%
S.eta filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Performance == "General") %>%
ggs_caterpillar(label = "Covariate") +
geom_vline(xintercept = 0, lty = 3)
Figure 124: Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)
plab("Sigma", list(Covariate.1 = covariates.label,
L.Sigma <-Covariate.2 = covariates.label,
Sector = sector.label,
Diversity = diversity.label))
ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
S.Sigma <- filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
filter(!Covariate.2 %in% c("Deliberation", "Consensus"))
ci(S.Sigma) %>%
vcov.Sigma <- select(Sector, Diversity, Covariate.1, Covariate.2, vcov = median) %>%
mutate(vcov = ifelse(Covariate.1 == Covariate.2, NA, vcov)) %>%
mutate(Covariate.1 = factor(as.character(Covariate.1), rev(levels(Covariate.1))))
ggplot(vcov.Sigma, aes(x = Covariate.2, y = Covariate.1, fill = vcov)) +
geom_raster() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
facet_grid(Sector ~ Diversity) +
scale_fill_continuous_diverging(palette = "Blue-Red")
Figure 125: Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)
What is the model fit?
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
Y %>%
Obs.sd <- as.data.frame.table() %>%
as_tibble() %>%
rename(Sector = Var1, Country = Var2,
Year = Var3, Diversity = Var4,
value = Freq) %>%
mutate(Year = as.integer(as.numeric(as.character(Year)))) %>%
group_by(Sector, Diversity) %>%
summarize(obs.sd = sd(value, na.rm = TRUE))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
S.rsd <- filter(!str_detect(Country, "^Z-")) %>%
group_by(Iteration, Chain, Sector, Diversity) %>%
summarize(rsd = sd(value))
ggplot(S.rsd, aes(x = rsd)) +
geom_histogram(binwidth = 0.001) +
geom_vline(data = Obs.sd, aes(xintercept = obs.sd)) +
facet_grid(Diversity ~ Sector) +
expand_limits(x = 0)
Figure 126: Model fit. Residual standard deviation (distribution) against observed standard deviation (vertical line).
%>%
S.rsd ungroup() %>%
left_join(Obs.sd) %>%
group_by(Sector, Diversity) %>%
summarize(Pseudo.R2 = mean((obs.sd - rsd) / obs.sd)) %>%
kable()
rm(S.rsd)
Which are the observations with higher residuals, further away from the expectation?6 Negative residuals are cases where the country has lower diversity than expected according to the model.
plab("resid", list(Sector = sector.label,
L.data <-Country = country.label,
Year = year.label,
Diversity = diversity.label))
ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(!str_detect(Country, "Z-")) %>%
group_by(Country) %>%
summarize(Residual = mean(value)) %>%
mutate(`Mean absolute residual` = abs(Residual)) %>%
ungroup() %>%
arrange(desc(`Mean absolute residual`)) %>%
select(-`Mean absolute residual`) %>%
slice(1:8) %>%
kable()
plab("mu", list(Sector = sector.label,
L.mu <-Country = country.label,
Year = year.label.numeric,
Diversity = diversity.label)) %>%
filter(str_detect(Country, "^Z-"))
ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
ci.mu <- mutate(Year = as.integer(as.character(Year))) %>%
ci()
%>%
ci.mu filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
ggplot(aes(x = Year, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen portfolio size goes\nfrom minimum to maximum\nover time")
Figure 127: Magnitude of the effects: change in the expected diversity when portfolio size goes from the minimum to the maximum observed value over time, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen government effectiveness goes\nfrom minimum to maximum")
Figure 128: Magnitude of the effects: change in the expected diversity when government effectiveness goes from the minimum to the maximum observed value, with the rest of the variables at their means.
%>%
ci.mu filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High,
color = Sector, fill = Sector)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
facet_wrap(~ Diversity) +
ylab("Expected diversity\nwhen political constraints go\nfrom minimum to maximum")
Figure 129: Magnitude of the effects: change in the expected diversity when political constraints go from the minimum to the maximum observed value, with the rest of the variables at their means.
f1 <- ci.mu %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country == "Z-01") %>%
filter(Year > min(Year)) %>%
left_join(D %>%
filter(Measure == "Size") %>%
select(Country, Sector, Year, value) %>%
rename(`Portfolio size` = value)) %>%
ggplot(aes(x = `Portfolio size`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(a)") +
ylab("Expected diversity")
ci.mu %>%
f2 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 2:11))) %>%
filter(Year == max(Year)) %>%
left_join(gov.eff.df %>%
rename(Country = country, Year = year)) %>%
rename(`Government effectiveness` = value) %>%
ggplot(aes(x = `Government effectiveness`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(b)") +
ylab("Expected diversity")
ci.mu %>%
f3 <- filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Sector == "Environmental") %>%
filter(Country %in% paste0("Z-", sprintf("%02d", 12:21))) %>%
filter(Year == max(Year)) %>%
left_join(constraints.d) %>%
rename(`Political constraints` = original.polcon) %>%
ggplot(aes(x = `Political constraints`, y = median,
ymin = Low, ymax = High)) +
geom_line() +
geom_ribbon(alpha = 0.2, aes(color = NULL)) +
expand_limits(y = c(0, 1)) +
ggtitle("(c)") +
ylab("Expected diversity")
::plot_grid(f1, f2, f3, ncol = 3) cowplot
Figure 130: Magnitude of the effects: change in the expected diversity when (a) portfolio size, (b) government effectiveness or (c) political constraints move from the minimum to the maximum observed. In all cases the rest of the variables are fixed at their means.
NULL
d <-load("ci-betas-diversity-main.RData")
bind_rows(ci.betas %>%
d <- mutate(Model = "Government effectiveness") %>%
mutate(Variable = as.character(Variable)) %>%
mutate(Variable = ifelse(Variable == "Government effectiveness",
"GovEff/PolFb", Variable)))
load("ci-betas-diversity-vpi.RData")
bind_rows(d, ci.betas %>%
d <- mutate(Model = "Policy feedback (Atemporal)") %>%
mutate(Variable = as.character(Variable)) %>%
mutate(Variable = ifelse(Variable == "Policy feedback",
"GovEff/PolFb", Variable)))
%>%
d filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = median, y = Variable, color = Model)) +
geom_point(position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = Low, xmax = High), lwd = 0.8,
position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = low, xmax = high), lwd = 0.2,
position = position_dodge(width = 0.3)) +
geom_vline(xintercept = 0, lty = 3) +
scale_color_colorblind() +
xlab("HPD") +
ylab("Parameter") +
theme(legend.position = "bottom")
Figure 131: Model comparison for the same model specification, diversity measure, and different bureaucratic variable. Environmental Sector. Average Instrument Diversity.
rm(d)
NULL
d <-load("ci-betas-diversity-mbi.RData")
bind_rows(ci.betas %>%
d.liability <- mutate(Model = "Government effectiveness") %>%
mutate(Data = "New instrument"))
load("ci-betas-diversity-main.RData")
bind_rows(ci.betas %>%
d <- mutate(Model = "Government effectiveness") %>%
mutate(Data = "Original"))
bind_rows(d, d.liability) d <-
%>%
d filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
filter(Model == "Government effectiveness") %>%
ggplot(aes(x = median, y = Variable, color = Data)) +
geom_point(position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = Low, xmax = High), lwd = 0.8,
position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = low, xmax = high), lwd = 0.2,
position = position_dodge(width = 0.3)) +
geom_vline(xintercept = 0, lty = 3) +
scale_color_colorblind() +
xlab("HPD") +
ylab("Parameter") +
theme(legend.position = "bottom")
Figure 132: Model comparison for the same model specification, diversity measure, by dataset. Environmental Sector. Average Instrument Diversity.
rm(d)
NULL
d <-load("ci-betas-diversity-main.RData")
bind_rows(ci.betas %>%
d <- mutate(Model = "Baseline"))
load("ci-betas-diversity-democracy.RData")
bind_rows(d, ci.betas %>%
d <- mutate(Model = "+ Democracy (V-Dem average)"))
%>%
d filter(Sector == "Environmental") %>%
filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
ggplot(aes(x = median, y = Variable, color = Model)) +
geom_point(position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = Low, xmax = High), lwd = 0.8,
position = position_dodge(width = 0.3)) +
geom_linerange(aes(xmin = low, xmax = high), lwd = 0.2,
position = position_dodge(width = 0.3)) +
geom_vline(xintercept = 0, lty = 3) +
scale_color_colorblind() +
xlab("HPD") +
ylab("Parameter") +
theme(legend.position = "bottom")
Figure 133: Model comparison for the same model specification, diversity measure, and different bureaucratic variable. Environmental Sector. Average Instrument Diversity.
sessionInfo()
## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Gentoo/Linux
##
## Matrix products: default
## BLAS: /usr/lib64/blas/blis/libblas.so.3
## LAPACK: /usr/lib64/libopenblas_haswellp-r0.3.13.so
##
## locale:
## [1] LC_CTYPE=ca_AD.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=ca_AD.UTF-8 LC_COLLATE=ca_AD.UTF-8
## [5] LC_MONETARY=ca_AD.UTF-8 LC_MESSAGES=ca_AD.UTF-8
## [7] LC_PAPER=ca_AD.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=ca_AD.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] forcats_0.5.1 PolicyPortfolios_0.2.2 ggrepel_0.9.1
## [4] colorspace_2.0-0 stringr_1.4.0 GGally_2.1.1
## [7] ggmcmc_1.5.1.1 runjags_2.2.0-2 rjags_4-10
## [10] coda_0.19-4 scales_1.1.1 ggthemes_4.2.4
## [13] extrafont_0.17 gridExtra_2.3 ggplot2_3.3.3
## [16] tidyr_1.1.3 dplyr_1.0.5 kableExtra_1.3.4
## [19] tikzDevice_0.12.3.1 rmarkdown_2.7 knitr_1.31
## [22] colorout_1.2-2
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.2 tufte_0.9 sass_0.3.1 jsonlite_1.7.2
## [5] viridisLite_0.3.0 splines_4.0.4 bslib_0.2.4 assertthat_0.2.1
## [9] highr_0.8 yaml_2.2.1 Rttf2pt1_1.3.8 pillar_1.5.1
## [13] lattice_0.20-41 glue_1.4.2 extrafontdb_1.0 digest_0.6.27
## [17] RColorBrewer_1.1-2 rvest_1.0.0 cowplot_1.1.1 htmltools_0.5.1.1
## [21] Matrix_1.3-2 plyr_1.8.6 pkgconfig_2.0.3 bookdown_0.21
## [25] purrr_0.3.4 webshot_0.5.2 svglite_2.0.0 tibble_3.1.0
## [29] mgcv_1.8-34 generics_0.1.0 farver_2.1.0 ellipsis_0.3.1
## [33] withr_2.4.1 magrittr_2.0.1 crayon_1.4.1 evaluate_0.14
## [37] fansi_0.4.2 nlme_3.1-152 MASS_7.3-53.1 xml2_1.3.2
## [41] foreign_0.8-81 vegan_2.5-7 tools_4.0.4 ineq_0.2-13
## [45] lifecycle_1.0.0 munsell_0.5.0 cluster_2.1.1 jquerylib_0.1.3
## [49] compiler_4.0.4 tinytex_0.30 systemfonts_1.0.1 rlang_0.4.10
## [53] debugme_1.1.0 rstudioapi_0.13 filehash_2.4-2 labeling_0.4.2
## [57] gtable_0.3.0 DBI_1.1.1 reshape_0.8.8 reshape2_1.4.4
## [61] R6_2.5.0 utf8_1.1.4 permute_0.9-5 stringi_1.5.3
## [65] parallel_4.0.4 Rcpp_1.0.6 vctrs_0.3.6 tidyselect_1.1.0
## [69] xfun_0.21
Henisz, Witold J. 2002. “The Institutional Environment for Infrastructure Investment.” Industrial and Corporate Change 11 (2): 355–89.
Volkens, Pola AND Merz, Andrea AND Lehmann. 2013. The Manifesto Data Collection. Manifesto Project (Mrg/Cmp/Marpor). Version 2013b. Berlin: Wissenschaftszentrum Berlin für Sozialforschung (WZB).