Studying Policy Design Quality in Comparative Perspective

Xavier Fernández i Marín, Christoph Knill, Yves Steinebach

2021-03-11 09:19:16

Introduction

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.

Data description

library(PolicyPortfolios)
data(consensus)

Show the portfolios of selected countries / years for illustration purposes.

D <- consensus %>%
  filter(Sector == "Environmental") %>%
  droplevels() %>%
  pp_measures()

consensus.without.labels <- consensus %>%
  mutate(Target = as.factor(as.numeric(Target))) %>%
  mutate(Instrument = as.factor(as.numeric(Instrument)))


rM <- pp_array(filter(consensus, Sector == "Environmental" & Country == "France" & Year == 1976), return_matrix = TRUE)

manual.aid.fr.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.us.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)

# France: growth in size and diversity
f1 <- pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")), 
              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))
f2 <- pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")), 
              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)

f3 <- pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")), 
              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))
f4 <- pp_plot(droplevels(filter(consensus.without.labels, Sector == "Environmental")), 
              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)
Example portfolios comparing Average Instrument Diversity. France: +size +diversity; United States: +size =diversity.

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.

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.

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)
Average instrument diversity compared against other measures of diversity, by sector.

Figure 4: Average instrument diversity compared against other measures of diversity, by sector.

Explanatory model of performance

library(PolicyPortfolios)
data(consensus)

ca <- consensus %>%
  filter(Sector == "Environmental") %>%
  droplevels() %>%
  pp_measures() %>%
  filter(Measure %in% c("Div.aid", "Size")) %>%
  select(-Measure.label) %>%
  spread(Measure, value) %>%
  rename(Diversity = Div.aid)


countries <- country.coverage <- as.character(levels(ca$Country))
nC <- length(countries)
years <- range(ca$Year)
save(countries, years, country.coverage, file = "details.RData")

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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:

countries <- as.character(levels(ca$Country))
load("wdi/wdi.RData")
wdi <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- subset(wdi, country=="Ireland")

# So we use the combination of GDP and population 
# to make a regression against the observed GDP per capita 
# and impute accordingly.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  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.original <- 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.l <- gov.eff.original %>%
  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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    #v <- weighted.mean(series$p.seats, diff(c(as.Date("1976-01-01"), series$date)))
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

Save and arrange for analysis.

d.perf <- 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()

Y <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)

indicator.label <- dimnames(Y)[[1]]
sector.label <- dimnames(Y)[[2]]
nI <- length(indicator.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)



# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

diversity <- ca %>%
  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")


GDPpc <- wdi %>%
  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")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)

trade <- wdi %>%
  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")

deliberation <- vdem %>%
  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")

constraints <- polcon %>%
  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")


gov.eff <- expand.grid(country = country.label, year = year.label.numeric) %>%
  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")


portfolio.size <- ca %>%
  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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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 <- cpm %>%
  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 <- green.socialist[1,,]


DJ <- list(
  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)

nC   # Number of countries
## [1] 21
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "performance-tscs"
M.lab <- "Baseline"
m <- "model {
  #
  # 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 = ""))
par <- 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")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", "Portfolio size"),
                                Sector = sector.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
ggs_caterpillar(S.lambda) +
  ggtitle("Variance component")

Figure 5: Variance component.

Variance component.

Variance components (country varying intercepts).

L.lambda.c <- plab("lambda_c", list(Indicator = indicator.label, Country = country.label))
S.lambda.c <- ggs(s, family = "lambda_c\\[", par_labels = L.lambda.c)
ggs_caterpillar(S.lambda.c, label = "Country") +
  facet_grid(~ Indicator) +
  ggtitle("Variance component (countries)")

Figure 6: Variance component (country varying intercepts).

Variance component (country varying intercepts).

Auto-regressive components.

L.rho <- plab("rho", list(Indicator = indicator.label, Country = country.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.

Lagged dependent variable.

L.delta <- plab("delta", list(Indicator = indicator.label, Country = country.label))
S.delta <- ggs(s, family = "delta", par_labels = L.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.

Lagged dependent variable.
L.thetas <- plab("theta", list(Variable = c("Portfolio size", "Diversity"),
                        Indicator = indicator.label))

L.betas <- plab("beta", list(Variable = c("GDP pc", "Trade", "EU", "Green",
                                          "GDP growth", "Urban", "Industry",
                                          "Consensus"),
                        Indicator = indicator.label))
L.betas <- bind_rows(L.thetas, L.betas)

S.betas <- ggs(s, family = "^beta\\[|^theta\\[", par_labels = L.betas) %>%
  filter(value != 0)
S.betas <- filter(S.betas, !Variable %in% c("Green", "Consensus"))

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()
Slopes with the effects of control and main variables on performance, by performance indicator.

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) #+
Slopes with the effects of control and main variables on performance, by performance indicator.

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

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

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) #+
Slopes with the effects of control and main variables on performance, by performance indicator.

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.

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)
Slopes with the effects of control and main variables on performance.

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.gral <- S.betas %>%
  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).

Slopes for the effects of control variables on performance (Global performance indicator).

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Indicator = indicator.label,
                             Country = country.label,
                             Year = year.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data) %>%
  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).

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.

L.data <- plab("resid", list(Indicator = indicator.label,
                             Country = country.label,
                             Year = year.label))

S.resid <- ggs(s, family = "resid", par_labels = L.data) %>%
  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.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))

Explanatory model of performance (robustness, with interaction)

library(PolicyPortfolios)
data(consensus)

ca <- consensus %>%
  filter(Sector == "Environmental") %>%
  droplevels() %>%
  pp_measures() %>%
  filter(Measure %in% c("Div.aid", "Size")) %>%
  select(-Measure.label) %>%
  spread(Measure, value) %>%
  rename(Diversity = Div.aid)


countries <- as.character(levels(ca$Country))
nC <- length(countries)
years <- range(ca$Year)
save(countries, years, file = "details.RData")

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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:

countries <- as.character(levels(ca$Country))
load("wdi/wdi.RData")
wdi <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- subset(wdi, country=="Ireland")

# So we use the combination of GDP and population 
# to make a regression against the observed GDP per capita 
# and impute accordingly.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  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.original <- 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.l <- gov.eff.original %>%
  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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    #v <- weighted.mean(series$p.seats, diff(c(as.Date("1976-01-01"), series$date)))
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

Save and arrange for analysis.

d.perf <- 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()

Y <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)

indicator.label <- dimnames(Y)[[1]]
sector.label <- dimnames(Y)[[2]]
nI <- length(indicator.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)



# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

diversity <- ca %>%
  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")


GDPpc <- wdi %>%
  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")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)

trade <- wdi %>%
  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")

deliberation <- vdem %>%
  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")

constraints <- polcon %>%
  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")


gov.eff <- expand.grid(country = country.label, year = year.label.numeric) %>%
  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")


portfolio.size <- ca %>%
#  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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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 <- cpm %>%
  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 <- green.socialist[1,,]


DJ <- list(
  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)#,

nC   # Number of countries
## [1] 21
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "performance-tscs-robustness"
M.lab <- "Robustness, with interaction"
m <- "model {
  #
  # 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 = ""))
par <- 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")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", "Portfolio size"),
                                Sector = sector.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
ggs_caterpillar(S.lambda) +
  ggtitle("Variance component")

Figure 18: Variance component.

Variance component.

Variance components (country varying intercepts).

L.lambda.c <- plab("lambda_c", list(Indicator = indicator.label, Country = country.label))
S.lambda.c <- ggs(s, family = "lambda_c\\[", par_labels = L.lambda.c)
ggs_caterpillar(S.lambda.c, label = "Country") +
  facet_grid(~ Indicator) +
  ggtitle("Variance component (countries)")

Figure 19: Variance component (country varying intercepts).

Variance component (country varying intercepts).

Auto-regressive components.

L.rho <- plab("rho", list(Indicator = indicator.label, Country = country.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.

Lagged dependent variable.

L.delta <- plab("delta", list(Indicator = indicator.label, Country = country.label))
S.delta <- ggs(s, family = "delta", par_labels = L.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.

Lagged dependent variable.
L.thetas <- plab("theta", list(Variable = c("Portfolio size", 
                                            "Diversity", "Portfolio size * Diversity"),
                        Indicator = indicator.label))

L.betas <- plab("beta", list(Variable = c("GDP pc", "Trade", "EU", "Green",
                                          "GDP growth", "Urban", "Industry",
                                          "Consensus"),
                        Indicator = indicator.label))
L.betas <- bind_rows(L.thetas, L.betas)

S.betas <- ggs(s, family = "^beta\\[|^theta\\[", par_labels = L.betas) %>%
  filter(value != 0)
S.betas <- filter(S.betas, !Variable %in% c("Green", "Consensus"))

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()
Slopes with the effects of control and main variables on performance, by performance indicator.

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) #+
Slopes with the effects of control and main variables on performance, by performance indicator.

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

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

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) #+
Slopes with the effects of control and main variables on performance, by performance indicator.

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.

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)
Slopes with the effects of control and main variables on performance.

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.gral <- S.betas %>%
  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).

Slopes for the effects of control variables on performance (Global performance indicator).

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Indicator = indicator.label,
                             Country = country.label,
                             Year = year.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data) %>%
  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).

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.

L.data <- plab("resid", list(Indicator = indicator.label,
                             Country = country.label,
                             Year = year.label))

S.resid <- ggs(s, family = "resid", par_labels = L.data) %>%
  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.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))

Explanatory model of instrument diversity

Data is TSCS, by sector.

library(PolicyPortfolios)
data(consensus)

D <- bind_rows(
  # 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.size.env <- range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.soc <- range(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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)))




diversity <- D %>%
  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`)

countries <- as.character(unique(D$Country))
nC <- length(countries)
years <- range(D$Year)

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

d.perf <- 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()

Y.performance <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nYperformance <- dim(Y.performance)[3]

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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 <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- subset(wdi, country=="Ireland")

# So we use the combination of GDP and population 
# to make a regression against the observed GDP per capita 
# and impute accordingly.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  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")
gov.eff.original <- wgi %>%
  filter(indicator == "Government effectiveness") %>%
  select(country, year, value = Estimate) %>%
  expand_grid(Sector = c("Environmental", "Social"))

Add fake government effectiveness

range.ge.env <- range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)

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],
                                           range.ge.env[2],
                                           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],
                                           range.ge.soc[2],
                                           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.d <- polcon %>%
  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)

range.polcon <- polcon.d %>%
  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],
                                            range.polcon[2],
                                            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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

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")

salience <- cpm.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 <- M.borders[dimnames(M.borders)[[1]] %in% countries,
                       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.l <- diversity %>%
  gather(Measure, value, -c(Sector, Country, Year))
Y <- reshape2::acast(diversity.l,
                     Sector ~ Country ~ Year ~ Measure, value.var = "value")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]
nD <- dim(Y)[4]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)
nC.fake <- 21
nC.real <- nC - nC.fake
id.real.countries <- 1:nC.real
id.fake.countries <- (nC.real + 1):nC

sector.label <- dimnames(Y)[[1]]
nS <- length(sector.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)

decade.text <- paste0(str_sub(year.label, 1, 3), "0s")
id.decade <- as.numeric(as.factor(decade.text))
decade.label <- levels(as.factor(decade.text))
nDecades <- length(decade.label)

diversity.label <- dimnames(Y)[[4]]
nD <- length(diversity.label)

nB <- 11
b0 <- rep(0, nB)
B0 <- diag(nB)
diag(B0) <- 1^-2


# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

# Fake countries
f.c <- paste0("Z-", sprintf("%02d", 1:21))
# Fake years
f.y <- year.label.numeric

GDPpc <- wdi %>%
  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")

trade.df <- wdi %>%
  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 <- trade.df %>%
  reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")

constraints.d <- expand_grid(Country = country.label, 
                             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 <- constraints.d %>%
  reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")


gov.eff.df <- expand.grid(
    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 <- gov.eff.df %>%
  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")


min.discard.zero <- function(x) return(min(x[x!=0]))
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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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
green.socialist <- salience %>%
  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
d.perf.fake <- expand_grid(
  Country = country.label[str_detect(country.label, "^Z-") ],
  Year = year.label.numeric,
  Indicator = unique(d.perf$Indicator),
  Performance = NA)

Y.performance <- diversity.l %>%
  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 <- Y.performance[-4,,,] 

nP <- dim(Y.performance)[1]
performance.label <- dimnames(Y.performance)[[1]]
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 <- gdp.growth[,-dim(gdp.growth)[2]]
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
gdp.growth.means <- apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means[is.nan(gdp.growth.means)] <- 0


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 <- urban[,-dim(urban)[2]]
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
urban.means <- apply(urban, 1, mean, na.rm = TRUE)
urban.means[is.nan(urban.means)] <- 0

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 <- industry[,-dim(industry)[2]]
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)
industry.means[is.nan(industry.means)] <- 0



DP <- list(
  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)

nC   # Number of countries (including fake ones)
## [1] 42
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "diversity-main"
M.lab <- "Diversity (AID), Main"
m <- "model {
  #
  # 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 = ""))
par <- 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.fake <- expand_grid(Sector = 1:nS, 
                        Country = id.fake.countries, 
                        Year = 2:nY, 
                        Diversity = 1:nD) %>%
  mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.fake)
par.resid <- expand_grid(Sector = 1:nS, 
                         Country = id.real.countries, 
                         Year = 2:nY, 
                         Diversity = 1:nD) %>%
  mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.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.

Variance component.
rm(S.lambda)
L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda %>%
  filter(Sector == "Environmental") %>%
  filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
  ggs_caterpillar(label = "Variable") +
  ggtitle("Variance component")

Figure 32: Variance component.

Variance component.
rm(S.lambda)

Variance components (country varying intercepts).

L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)
L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)

Auto-regressive components.

L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)
L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)

Intercepts

L.alpha <- plab("alpha", list(Sector = sector.label,
                              Diversity = diversity.label,
                              Decade = decade.label))

S.alpha <- ggs(s, family = "^alpha\\[", par_label = L.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.

Intercepts.
covariates.label <- c("GDP pc", 
                                        "Consensus", 
                                        "Deliberation",
                                        "Government effectiveness",
                                        "Portfolio size",
                                        "Trade", "EU", "Salience",
                                        "Political constraints",
                                        "Interdependency (Contiguity)",
                                        "Interdependency (Trade)")

L.betas <- plab("beta", list(Variable = covariates.label,
                             Sector = sector.label,
                        Diversity = diversity.label))

S.betas <- ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
  filter(!Variable %in% c("Deliberation", "Consensus"))
ci.betas <- ci(S.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()
Slopes with the effects on diversity, by sector.

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()
Slopes with the effects on diversity, for the environmental sector.

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)
Slopes with the effects on diversity, by diversity indicator.

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

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)
Slopes with the effects on diversity, comparing sectors.

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.env <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas.env.sorted <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
L.deltas <- plab("delta", list(Variable = c("GDP pc", 
                                        "Government effectiveness",
                                        "Salience",
                                        "Political constraints"),
                        Sector = sector.label))

S.deltas <- ggs(s, family = "^delta\\[", par_labels = L.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.

Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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()
Mediated effects on diversity, by sector.

Figure 46: Mediated effects on diversity, by sector.

L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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.

Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
L.eta <- plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
                                                    "Diversity", "Portfolio size",
                                                    "Diversity * Portfolio size",
                                                    "GDPpc", "Trade", "EU",
                                                    "GDP growth", "Urban", "Industry"),
                                      Performance = performance.label,
                                      Diversity = diversity.label))
S.eta <- ggs(s, family = "eta.performance", par_label = L.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.

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.

Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)

V-Cov

L.Sigma <- plab("Sigma", list(Covariate.1 = covariates.label,
                              Covariate.2 = covariates.label,
                              Sector = sector.label,
                              Diversity = diversity.label))
S.Sigma <- ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
  filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
  filter(!Covariate.2 %in% c("Deliberation", "Consensus"))

vcov.Sigma <- ci(S.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.

Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Sector = sector.label,
                             Country = country.label,
                             Year = year.label,
                             Diversity = diversity.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
  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).

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.

L.data <- plab("resid", list(Sector = sector.label,
                             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()

Magnitude of effects

L.mu <- plab("mu", list(Sector = sector.label,
                        Country = country.label,
                        Year = year.label.numeric,
                        Diversity = diversity.label)) %>%
  filter(str_detect(Country, "^Z-"))
ci.mu <- ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
  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.

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.

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.

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")

f2 <- ci.mu %>%
  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")

f3 <- ci.mu %>%
  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")

cowplot::plot_grid(f1, f2, f3, ncol = 3)
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.

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.

Explanatory model of instrument diversity (robustness, VPI)

Data is TSCS, by sector.

library(PolicyPortfolios)
data(consensus)

D <- bind_rows(
  # 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.size.env <- range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.soc <- range(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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)))




diversity <- D %>%
  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`)

countries <- as.character(unique(D$Country))
nC <- length(countries)
years <- range(D$Year)

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

d.perf <- 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()

Y.performance <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nYperformance <- dim(Y.performance)[3]

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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 <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- 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.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
#wdi.gcr.w
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  select(country, gdpc.ratio) %>%
  mutate(variable = "gdpc.ratio") %>%
  rename(m = gdpc.ratio) %>%
  select(country, variable, m) %>%
  bind_rows(wdi.c)

Vertical Policy Integration.

vpi.d <- as_tibble(read.table("vpi/vpi-raw.csv", header = TRUE))

# Multiply observations by year
vpi.d <- expand_grid(vpi.d,
                     Year = min(D$Year):max(D$Year))

Add fake vertical policy integration.

range.vpi.env <- range(filter(vpi.d, Sector == "Environmental")$VPI)
range.vpi.soc <- range(filter(vpi.d, Sector == "Social")$VPI)

vpi.d <- vpi.d %>%
  bind_rows(expand_grid(tibble(Sector = "Environmental",
                               Country = paste0("Z-", sprintf("%02d", 2:11)),
                               VPI = seq(range.vpi.env[1],
                                         range.vpi.env[2],
                                         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],
                                         range.vpi.soc[2],
                                         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.d <- polcon %>%
  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)

range.polcon <- polcon.d %>%
  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],
                                            range.polcon[2],
                                            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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

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")

salience <- cpm.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 <- M.borders[dimnames(M.borders)[[1]] %in% countries,
                       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.l <- diversity %>%
  gather(Measure, value, -c(Sector, Country, Year))
Y <- reshape2::acast(diversity.l,
                     Sector ~ Country ~ Year ~ Measure, value.var = "value")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]
nD <- dim(Y)[4]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)
nC.fake <- 21
nC.real <- nC - nC.fake
id.real.countries <- 1:nC.real
id.fake.countries <- (nC.real + 1):nC

sector.label <- dimnames(Y)[[1]]
nS <- length(sector.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)

decade.text <- paste0(str_sub(year.label, 1, 3), "0s")
id.decade <- as.numeric(as.factor(decade.text))
decade.label <- levels(as.factor(decade.text))
nDecades <- length(decade.label)

diversity.label <- dimnames(Y)[[4]]
nD <- length(diversity.label)

nB <- 11
b0 <- rep(0, nB)
B0 <- diag(nB)
diag(B0) <- 1^-2


# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

# Fake countries
f.c <- paste0("Z-", sprintf("%02d", 1:21))
# Fake years
f.y <- year.label.numeric

GDPpc <- wdi %>%
  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")

trade.df <- wdi %>%
  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 <- trade.df %>%
  reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")

constraints.d <- expand_grid(Country = country.label, 
                             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 <- constraints.d %>%
  reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")


vpi.df <- expand_grid(Sector = c("Environmental", "Social"),
                      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.A <- vpi.df %>%
  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")

min.discard.zero <- function(x) return(min(x[x!=0]))
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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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
green.socialist <- salience %>%
  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
d.perf.fake <- expand_grid(
  Country = country.label[str_detect(country.label, "^Z-") ],
  Year = year.label.numeric,
  Indicator = unique(d.perf$Indicator),
  Performance = NA)

Y.performance <- diversity.l %>%
  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 <- Y.performance[-4,,,] 

nP <- dim(Y.performance)[1]
performance.label <- dimnames(Y.performance)[[1]]
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 <- gdp.growth[,-dim(gdp.growth)[2]]
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
gdp.growth.means <- apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means[is.nan(gdp.growth.means)] <- 0


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 <- urban[,-dim(urban)[2]]
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
urban.means <- apply(urban, 1, mean, na.rm = TRUE)
urban.means[is.nan(urban.means)] <- 0

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 <- industry[,-dim(industry)[2]]
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)
industry.means[is.nan(industry.means)] <- 0



DP <- list(
  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)

nC   # Number of countries (including fake ones)
## [1] 42
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "diversity-vpi"
M.lab <- "Diversity (AID), robustness, VPI"
m <- "model {
  #
  # 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 = ""))
par <- 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.fake <- expand_grid(Sector = 1:nS, 
                        Country = id.fake.countries, 
                        Year = 2:nY, 
                        Diversity = 1:nD) %>%
  mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.fake)
par.resid <- expand_grid(Sector = 1:nS, 
                         Country = id.real.countries, 
                         Year = 2:nY, 
                         Diversity = 1:nD) %>%
  mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.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.

Variance component.
rm(S.lambda)
L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda %>%
  filter(Sector == "Environmental") %>%
  filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
  ggs_caterpillar(label = "Variable") +
  ggtitle("Variance component")

Figure 57: Variance component.

Variance component.
rm(S.lambda)

Variance components (country varying intercepts).

L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)
L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)

Auto-regressive components.

L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)
L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)

Intercepts

L.alpha <- plab("alpha", list(Sector = sector.label,
                              Diversity = diversity.label,
                              Decade = decade.label))

S.alpha <- ggs(s, family = "^alpha\\[", par_label = L.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.

Intercepts.
covariates.label <- c("GDP pc", 
                                        "Consensus", 
                                        "Deliberation",
                                        "Policy feedback",
                                        "Portfolio size",
                                        "Trade", "EU", "Salience",
                                        "Political constraints",
                                        "Interdependency (Contiguity)",
                                        "Interdependency (Trade)")

L.betas <- plab("beta", list(Variable = covariates.label,
                             Sector = sector.label,
                        Diversity = diversity.label))

S.betas <- ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
  filter(!Variable %in% c("Deliberation", "Consensus"))
ci.betas <- ci(S.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()
Slopes with the effects on diversity, by sector.

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()
Slopes with the effects on diversity, for the environmental sector.

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)
Slopes with the effects on diversity, by diversity indicator.

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

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)
Slopes with the effects on diversity, comparing sectors.

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.env <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas.env.sorted <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
L.deltas <- plab("delta", list(Variable = c("GDP pc", 
                                        "Policy feedback",
                                        "Salience",
                                        "Political constraints"),
                        Sector = sector.label))

S.deltas <- ggs(s, family = "^delta\\[", par_labels = L.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.

Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Policy feedback",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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()
Mediated effects on diversity, by sector.

Figure 71: Mediated effects on diversity, by sector.

L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Policy feedback",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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.

Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
L.eta <- plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
                                                    "Diversity", "Portfolio size",
                                                    "Diversity * Portfolio size",
                                                    "GDPpc", "Trade", "EU",
                                                    "GDP growth", "Urban", "Industry"),
                                      Performance = performance.label,
                                      Diversity = diversity.label))
S.eta <- ggs(s, family = "eta.performance", par_label = L.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.

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.

Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)

V-Cov

L.Sigma <- plab("Sigma", list(Covariate.1 = covariates.label,
                              Covariate.2 = covariates.label,
                              Sector = sector.label,
                              Diversity = diversity.label))
S.Sigma <- ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
  filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
  filter(!Covariate.2 %in% c("Deliberation", "Consensus"))

vcov.Sigma <- ci(S.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.

Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Sector = sector.label,
                             Country = country.label,
                             Year = year.label,
                             Diversity = diversity.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
  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).

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.

L.data <- plab("resid", list(Sector = sector.label,
                             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()

Magnitude of effects

L.mu <- plab("mu", list(Sector = sector.label,
                        Country = country.label,
                        Year = year.label.numeric,
                        Diversity = diversity.label)) %>%
  filter(str_detect(Country, "^Z-"))
ci.mu <- ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
  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.

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.

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.

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")

f2 <- ci.mu %>%
  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")

f3 <- ci.mu %>%
  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")

cowplot::plot_grid(f1, f2, f3, ncol = 3)
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.

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.

Explanatory model of instrument diversity (robustness, market-based instrumemnts)

Data is TSCS, by sector.

library(PolicyPortfolios)
data(consensus)
c.eu <- c("Austria", "Belgium", "Denmark", "Finland",
          "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
extra <- consensus %>%
  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))
D <- bind_rows(
  # 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.size.env <- range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.soc <- range(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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)))




diversity <- D %>%
  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`)

countries <- as.character(unique(D$Country))
nC <- length(countries)
years <- range(D$Year)

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

d.perf <- 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()

Y.performance <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nYperformance <- dim(Y.performance)[3]

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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 <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- subset(wdi, country=="Ireland")

# So we use the combination of GDP and population 
# to make a regression against the observed GDP per capita 
# and impute accordingly.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  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")
gov.eff.original <- wgi %>%
  filter(indicator == "Government effectiveness") %>%
  select(country, year, value = Estimate) %>%
  expand_grid(Sector = c("Environmental", "Social"))

Add fake government effectiveness

range.ge.env <- range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)

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],
                                           range.ge.env[2],
                                           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],
                                           range.ge.soc[2],
                                           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.d <- polcon %>%
  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)

range.polcon <- polcon.d %>%
  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],
                                            range.polcon[2],
                                            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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

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")

salience <- cpm.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 <- M.borders[dimnames(M.borders)[[1]] %in% countries,
                       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.l <- diversity %>%
  gather(Measure, value, -c(Sector, Country, Year))
Y <- reshape2::acast(diversity.l,
                     Sector ~ Country ~ Year ~ Measure, value.var = "value")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]
nD <- dim(Y)[4]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)
nC.fake <- 21
nC.real <- nC - nC.fake
id.real.countries <- 1:nC.real
id.fake.countries <- (nC.real + 1):nC

sector.label <- dimnames(Y)[[1]]
nS <- length(sector.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)

decade.text <- paste0(str_sub(year.label, 1, 3), "0s")
id.decade <- as.numeric(as.factor(decade.text))
decade.label <- levels(as.factor(decade.text))
nDecades <- length(decade.label)

diversity.label <- dimnames(Y)[[4]]
nD <- length(diversity.label)

nB <- 11
b0 <- rep(0, nB)
B0 <- diag(nB)
diag(B0) <- 1^-2


# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

# Fake countries
f.c <- paste0("Z-", sprintf("%02d", 1:21))
# Fake years
f.y <- year.label.numeric

GDPpc <- wdi %>%
  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")

trade.df <- wdi %>%
  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 <- trade.df %>%
  reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")

constraints.d <- expand_grid(Country = country.label, 
                             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 <- constraints.d %>%
  reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")


gov.eff.df <- expand.grid(
    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 <- gov.eff.df %>%
  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")


min.discard.zero <- function(x) return(min(x[x!=0]))
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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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
green.socialist <- salience %>%
  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
d.perf.fake <- expand_grid(
  Country = country.label[str_detect(country.label, "^Z-") ],
  Year = year.label.numeric,
  Indicator = unique(d.perf$Indicator),
  Performance = NA)

Y.performance <- diversity.l %>%
  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 <- Y.performance[-4,,,] 

nP <- dim(Y.performance)[1]
performance.label <- dimnames(Y.performance)[[1]]
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 <- gdp.growth[,-dim(gdp.growth)[2]]
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
gdp.growth.means <- apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means[is.nan(gdp.growth.means)] <- 0


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 <- urban[,-dim(urban)[2]]
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
urban.means <- apply(urban, 1, mean, na.rm = TRUE)
urban.means[is.nan(urban.means)] <- 0

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 <- industry[,-dim(industry)[2]]
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)
industry.means[is.nan(industry.means)] <- 0



DP <- list(
  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)

nC   # Number of countries (including fake ones)
## [1] 42
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "diversity-mbi"
M.lab <- "Diversity (AID), robustness, Market-based instruments"
m <- "model {
  #
  # 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 = ""))
par <- 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.fake <- expand_grid(Sector = 1:nS, 
                        Country = id.fake.countries, 
                        Year = 2:nY, 
                        Diversity = 1:nD) %>%
  mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.fake)
par.resid <- expand_grid(Sector = 1:nS, 
                         Country = id.real.countries, 
                         Year = 2:nY, 
                         Diversity = 1:nD) %>%
  mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.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.

Variance component.
rm(S.lambda)
L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda %>%
  filter(Sector == "Environmental") %>%
  filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
  ggs_caterpillar(label = "Variable") +
  ggtitle("Variance component")

Figure 82: Variance component.

Variance component.
rm(S.lambda)

Variance components (country varying intercepts).

L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)
L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)

Auto-regressive components.

L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)
L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)

Intercepts

L.alpha <- plab("alpha", list(Sector = sector.label,
                              Diversity = diversity.label,
                              Decade = decade.label))

S.alpha <- ggs(s, family = "^alpha\\[", par_label = L.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.

Intercepts.
covariates.label <- c("GDP pc", 
                                        "Consensus", 
                                        "Deliberation",
                                        "Government effectiveness",
                                        "Portfolio size",
                                        "Trade", "EU", "Salience",
                                        "Political constraints",
                                        "Interdependency (Contiguity)",
                                        "Interdependency (Trade)")

L.betas <- plab("beta", list(Variable = covariates.label,
                             Sector = sector.label,
                        Diversity = diversity.label))

S.betas <- ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
  filter(!Variable %in% c("Deliberation", "Consensus"))
ci.betas <- ci(S.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()
Slopes with the effects on diversity, by sector.

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()
Slopes with the effects on diversity, for the environmental sector.

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)
Slopes with the effects on diversity, by diversity indicator.

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

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)
Slopes with the effects on diversity, comparing sectors.

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.env <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas.env.sorted <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
L.deltas <- plab("delta", list(Variable = c("GDP pc", 
                                        "Government effectiveness",
                                        "Salience",
                                        "Political constraints"),
                        Sector = sector.label))

S.deltas <- ggs(s, family = "^delta\\[", par_labels = L.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.

Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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()
Mediated effects on diversity, by sector.

Figure 96: Mediated effects on diversity, by sector.

L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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.

Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
L.eta <- plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
                                                    "Diversity", "Portfolio size",
                                                    "Diversity * Portfolio size",
                                                    "GDPpc", "Trade", "EU",
                                                    "GDP growth", "Urban", "Industry"),
                                      Performance = performance.label,
                                      Diversity = diversity.label))
S.eta <- ggs(s, family = "eta.performance", par_label = L.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.

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.

Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)

V-Cov

L.Sigma <- plab("Sigma", list(Covariate.1 = covariates.label,
                              Covariate.2 = covariates.label,
                              Sector = sector.label,
                              Diversity = diversity.label))
S.Sigma <- ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
  filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
  filter(!Covariate.2 %in% c("Deliberation", "Consensus"))

vcov.Sigma <- ci(S.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.

Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Sector = sector.label,
                             Country = country.label,
                             Year = year.label,
                             Diversity = diversity.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
  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).

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.

L.data <- plab("resid", list(Sector = sector.label,
                             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()

Magnitude of effects

L.mu <- plab("mu", list(Sector = sector.label,
                        Country = country.label,
                        Year = year.label.numeric,
                        Diversity = diversity.label)) %>%
  filter(str_detect(Country, "^Z-"))
ci.mu <- ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
  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.

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.

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.

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")

f2 <- ci.mu %>%
  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")

f3 <- ci.mu %>%
  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")

cowplot::plot_grid(f1, f2, f3, ncol = 3)
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.

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.

Explanatory model of instrument diversity (robustness, with Democracy)

Data is TSCS, by sector.

library(PolicyPortfolios)
data(consensus)

D <- bind_rows(
  # 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.size.env <- range(filter(D, Sector == "Environmental" & Measure == "Size")$value)
range.size.soc <- range(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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.size.env <- mean(filter(D, Sector == "Environmental" & Measure == "Size")$value)
mean.size.soc <- mean(filter(D, Sector == "Social" & Measure == "Size")$value)

D <- bind_rows(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)))

D <- bind_rows(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)))




diversity <- D %>%
  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`)

countries <- as.character(unique(D$Country))
nC <- length(countries)
years <- range(D$Year)

Performance

perf <- foreign::read.dta("jahn/PoEP_Replication_Data/Environmental_Performance_Chapter5.dta") %>%
  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)

d.perf <- 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()

Y.performance <- reshape2::acast(d.perf, Indicator ~ Country ~ Year, value.var = "Performance")
nYperformance <- dim(Y.performance)[3]

Covariates

World Development Indicators - Revenue.

load("wdi/wdi-tax.RData")

tax.rev.l <- tax.rev %>%
  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 <- 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)

# GDP pc in Ireland is bad
ireland.wdi <- subset(wdi, country=="Ireland")

# So we use the combination of GDP and population 
# to make a regression against the observed GDP per capita 
# and impute accordingly.
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ gdp.capita.div, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  predict(m.ireland, ireland.wdi)[1:(length(predict(m.ireland, ireland.wdi)) - (length(predict(m.ireland))))]

ireland.wdi <- subset(wdi, country=="Ireland")
ireland.wdi <- cbind(ireland.wdi, gdp.capita.div = ireland.wdi$gdp/ireland.wdi$population)
m.ireland <- lm(gdp.capita ~ year, data=ireland.wdi)
wdi$gdp.capita[wdi$country=="Ireland" & is.na(wdi$gdp.capita)] <-
  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.
switzerland.wdi <- subset(wdi, country=="Switzerland")
switzerland.wdi <- cbind(switzerland.wdi, gdp.capita.div = switzerland.wdi$gdp/switzerland.wdi$population)
m.switzerland <- lm(gdp.capita ~ year, data=switzerland.wdi)
wdi$gdp.capita[wdi$country=="Switzerland" & is.na(wdi$gdp.capita)] <-
  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.
newzealand.wdi <- subset(wdi, country=="New Zealand")
newzealand.wdi <- cbind(newzealand.wdi, gdp.capita.div = newzealand.wdi$gdp/newzealand.wdi$population)
m.newzealand <- lm(gdp.capita ~ year, data=newzealand.wdi)
wdi$gdp.capita[wdi$country=="New Zealand" & is.na(wdi$gdp.capita)] <-
  predict(m.newzealand, newzealand.wdi)[1:(length(predict(m.newzealand, newzealand.wdi)) - (length(predict(m.newzealand))))]


switzerland.wdi <- subset(wdi, country=="Switzerland")
m.switzerland <- lm(trade ~ year, data=switzerland.wdi)
wdi$trade[wdi$country=="Switzerland" & is.na(wdi$trade)] <-
  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.
wdi.gdp.capita.ratio <- subset(wdi[,c("country", "year", "gdp.capita")], year==min(year) | year==max(year))
wdi.gcr.w <- wdi.gdp.capita.ratio %>%
  spread(year, gdp.capita)
wdi.gcr.w <- cbind(wdi.gcr.w, gdpc.ratio=wdi.gcr.w$`2005`/wdi.gcr.w$`1976`)


# Data is averaged by country through all years.
wdi.c <- wdi %>%
  gather(variable, value, -country, -year) %>%
  group_by(country, variable) %>%
  summarize(m = median(value, na.rm = TRUE)) %>%
  ungroup()


# Include GDP per capita growth, ratio
wdi.l <- wdi.gcr.w %>%
  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")
gov.eff.original <- wgi %>%
  filter(indicator == "Government effectiveness") %>%
  select(country, year, value = Estimate) %>%
  expand_grid(Sector = c("Environmental", "Social"))

Add fake government effectiveness

range.ge.env <- range.ge.soc <- range(gov.eff.original$value, na.rm = TRUE)

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],
                                           range.ge.env[2],
                                           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],
                                           range.ge.soc[2],
                                           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.d <- polcon %>%
  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)

range.polcon <- polcon.d %>%
  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],
                                            range.polcon[2],
                                            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")
cpm$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")

# Take only Green parties and Socialist=social democrats + communists
cpm$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)

# 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.
families <- c("Green", "Socialist")
wmsf <- data.frame(country=countries, Green=NA, Socialist=NA)
for (C in 1:nC) {
  for (F in 1:length(families)) {
    series <- subset(cpm, country==countries[C] & family==families[F])[,c(2, 4)]
    series <- series[order(series$date),]
    v <- weighted.mean(series$p.seats, as.numeric(diff(c(as.Date("1976-01-01"), series$date))))
    v[is.nan(v)] <- 0
    wmsf[C, 1+F] <- v
  }
}

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")

salience <- cpm.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 <- M.borders[dimnames(M.borders)[[1]] %in% countries,
                       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.l <- diversity %>%
  gather(Measure, value, -c(Sector, Country, Year))
Y <- reshape2::acast(diversity.l,
                     Sector ~ Country ~ Year ~ Measure, value.var = "value")
nS <- dim(Y)[1]
nC <- dim(Y)[2]
nY <- dim(Y)[3]
nD <- dim(Y)[4]


country.label <- dimnames(Y)[[2]]
nC <- length(country.label)
nC.fake <- 21
nC.real <- nC - nC.fake
id.real.countries <- 1:nC.real
id.fake.countries <- (nC.real + 1):nC

sector.label <- dimnames(Y)[[1]]
nS <- length(sector.label)

year.label <- dimnames(Y)[[3]]
year.label.numeric <- as.integer(as.numeric(year.label))
nY <- length(year.label)

decade.text <- paste0(str_sub(year.label, 1, 3), "0s")
id.decade <- as.numeric(as.factor(decade.text))
decade.label <- levels(as.factor(decade.text))
nDecades <- length(decade.label)

diversity.label <- dimnames(Y)[[4]]
nD <- length(diversity.label)

nB <- 11
b0 <- rep(0, nB)
B0 <- diag(nB)
diag(B0) <- 1^-2


# Function to assign zeros to the fake countries (mean value)
zero.fk <- function(x, id = id.fake.countries) { # zero to fake countries
  x[id] <- 0
  return(x)
}

source("get-eu_time.R") # generates eu.ms

# Fake countries
f.c <- paste0("Z-", sprintf("%02d", 1:21))
# Fake years
f.y <- year.label.numeric

GDPpc <- wdi %>%
  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")

trade.df <- wdi %>%
  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 <- trade.df %>%
  reshape2::acast(country ~ year, value.var = "trade")
if ( length(which(!dimnames(trade)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")


democracy <- vdem %>%
  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")


constraints.d <- expand_grid(Country = country.label, 
                             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 <- constraints.d %>%
  reshape2::acast(Country ~ Year, value.var = "polcon")
if ( length(which(!dimnames(constraints)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")


gov.eff.df <- expand.grid(
    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 <- gov.eff.df %>%
  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")


min.discard.zero <- function(x) return(min(x[x!=0]))
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")

eu <- expand.grid(country = country.label, year = 1958:2020) %>%
  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
green.socialist <- salience %>%
  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
d.perf.fake <- expand_grid(
  Country = country.label[str_detect(country.label, "^Z-") ],
  Year = year.label.numeric,
  Indicator = unique(d.perf$Indicator),
  Performance = NA)

Y.performance <- diversity.l %>%
  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 <- Y.performance[-4,,,] 

nP <- dim(Y.performance)[1]
performance.label <- dimnames(Y.performance)[[1]]
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 <- gdp.growth[,-dim(gdp.growth)[2]]
if ( length(which(!dimnames(gdp.growth)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
gdp.growth.means <- apply(gdp.growth, 1, mean, na.rm = TRUE)
gdp.growth.means[is.nan(gdp.growth.means)] <- 0


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 <- urban[,-dim(urban)[2]]
if ( length(which(!dimnames(urban)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
urban.means <- apply(urban, 1, mean, na.rm = TRUE)
urban.means[is.nan(urban.means)] <- 0

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 <- industry[,-dim(industry)[2]]
if ( length(which(!dimnames(industry)[[1]] == country.label)) > 0) stop("Ep! There is a mistake here")
industry.means <- apply(industry, 1, mean, na.rm = TRUE)
industry.means[is.nan(industry.means)] <- 0



DP <- list(
  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)

nC   # Number of countries (including fake ones)
## [1] 42
nS   # Number of sectors
## [1] 2
years  # Range of years
## [1] 1976 2005

Model

M <- "diversity-democracy"
M.lab <- "Diversity (AID), robustness, democracy"
m <- "model {
  #
  # 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 = ""))
par <- 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.fake <- expand_grid(Sector = 1:nS, 
                        Country = id.fake.countries, 
                        Year = 2:nY, 
                        Diversity = 1:nD) %>%
  mutate(parameter = paste0("mu[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.fake)
par.resid <- expand_grid(Sector = 1:nS, 
                         Country = id.real.countries, 
                         Year = 2:nY, 
                         Diversity = 1:nD) %>%
  mutate(parameter = paste0("resid[", Sector, ",", Country, ",", Year, ",", Diversity, "]")) %>%
  select(parameter) %>%
  unlist(., use.names = FALSE)
par <- c(par, par.resid)
par <- c(par, "delta", "alpha.ps", "sigma.ps", "pi")
par <- c(par, "eta.performance", "sigma.performance")
inits <- list(
  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))
t0 <- proc.time()
rj <- run.jags(model = paste("models/model-", M, ".bug", sep = ""),
  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)
s <- as.mcmc.list(rj)
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 = ""))

Model results

Variance components.

L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.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.

Variance component.
rm(S.lambda)
L.lambda <- plab("lambda", list(Variable = c("(Intercept)", 
                                             "Portfolio size",
                                             "Constraints"),
                                Sector = sector.label,
                                Diversity = diversity.label))
S.lambda <- ggs(s, family = "lambda\\[", par_labels = L.lambda)
S.lambda %>%
  filter(Sector == "Environmental") %>%
  filter(Diversity == "Diversity (Average Instrument Diversity)") %>%
  ggs_caterpillar(label = "Variable") +
  ggtitle("Variance component")

Figure 107: Variance component.

Variance component.
rm(S.lambda)

Variance components (country varying intercepts).

L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)
L.gamma <- plab("gamma", list(Country = country.label,
                              Diversity = diversity.label))
S.gamma <- ggs(s, family = "gamma\\[", par_labels = L.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).

Variance component (country varying intercepts).
rm(S.gamma)

Auto-regressive components.

L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)
L.rho <- plab("rho", list(Sector = sector.label, 
                          Country = country.label,
                          Diversity = diversity.label))
S.rho <- ggs(s, family = "rho", par_labels = L.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.

Auto-regressive component.
rm(S.rho)

Intercepts

L.alpha <- plab("alpha", list(Sector = sector.label,
                              Diversity = diversity.label,
                              Decade = decade.label))

S.alpha <- ggs(s, family = "^alpha\\[", par_label = L.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.

Intercepts.
covariates.label <- c("GDP pc", 
                                        "Consensus", 
                                        "Democracy",
                                        "Government effectiveness",
                                        "Portfolio size",
                                        "Trade", "EU", "Salience",
                                        "Political constraints",
                                        "Interdependency (Contiguity)",
                                        "Interdependency (Trade)")

L.betas <- plab("beta", list(Variable = covariates.label,
                             Sector = sector.label,
                        Diversity = diversity.label))

S.betas <- ggs(s, family = "^beta\\[", par_labels = L.betas) %>%
  filter(!Variable %in% c("Deliberation", "Consensus"))
ci.betas <- ci(S.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()
Slopes with the effects on diversity, by sector.

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()
Slopes with the effects on diversity, for the environmental sector.

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)
Slopes with the effects on diversity, by diversity indicator.

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

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)
Slopes with the effects on diversity, comparing sectors.

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.env <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env)
S.betas.env.sorted <- S.betas %>%
  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.

Slopes with the effects on portfolio diversity (AID). Environmental sector.
rm(S.betas.env.sorted)
ci.betas <- ci(S.betas) %>%
  mutate(Model = M.lab)

save(ci.betas, file = paste0("ci_betas-", M, ".RData"))
rm(S.betas, ci.betas)
L.deltas <- plab("delta", list(Variable = c("GDP pc", 
                                        "Government effectiveness",
                                        "Salience",
                                        "Political constraints"),
                        Sector = sector.label))

S.deltas <- ggs(s, family = "^delta\\[", par_labels = L.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.

Slopes with the direct effects on portfolio size, by sector.
rm(S.deltas)
L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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()
Mediated effects on diversity, by sector.

Figure 121: Mediated effects on diversity, by sector.

L.pi <- plab("pi", list(Variable = c("GDP pc", 
                                     "Government effectiveness",
                                     "Salience",
                                     "Political constraints"),
                        Sector = sector.label,
                        Diversity = diversity.label))

S.pis <- ggs(s, family = "^pi\\[", par_labels = L.pi) %>%
  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.

Mediated effects on diversity, for AID and the environmental sector.
rm(S.pis)
L.eta <- plab("eta.performance", list(Covariate = c("(Intercept)", "Residuals",
                                                    "Diversity", "Portfolio size",
                                                    "Diversity * Portfolio size",
                                                    "GDPpc", "Trade", "EU",
                                                    "GDP growth", "Urban", "Industry"),
                                      Performance = performance.label,
                                      Diversity = diversity.label))
S.eta <- ggs(s, family = "eta.performance", par_label = L.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.

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.

Direct effects on Environmental performance, for general performance and using AID as diversity.
rm(S.eta)

V-Cov

L.Sigma <- plab("Sigma", list(Covariate.1 = covariates.label,
                              Covariate.2 = covariates.label,
                              Sector = sector.label,
                              Diversity = diversity.label))
S.Sigma <- ggs(s, family = "^Sigma\\[", par_labels = L.Sigma) %>%
  filter(!Covariate.1 %in% c("Deliberation", "Consensus")) %>%
  filter(!Covariate.2 %in% c("Deliberation", "Consensus"))

vcov.Sigma <- ci(S.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.

Variance-covariance matrix of main effects.
rm(S.Sigma, vcov.Sigma)

Model evaluation

What is the model fit?

L.data <- plab("resid", list(Sector = sector.label,
                             Country = country.label,
                             Year = year.label,
                             Diversity = diversity.label))

Obs.sd <- Y %>%
  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))

S.rsd <- ggs(s, family = "resid", par_labels = L.data, sort = FALSE) %>%
  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).

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.

L.data <- plab("resid", list(Sector = sector.label,
                             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()

Magnitude of effects

L.mu <- plab("mu", list(Sector = sector.label,
                        Country = country.label,
                        Year = year.label.numeric,
                        Diversity = diversity.label)) %>%
  filter(str_detect(Country, "^Z-"))
ci.mu <- ggs(s, family = "^mu\\[", par_labels = L.mu, sort = FALSE) %>%
  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.

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.

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.

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")

f2 <- ci.mu %>%
  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")

f3 <- ci.mu %>%
  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")

cowplot::plot_grid(f1, f2, f3, ncol = 3)
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.

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.

Model comparison

Policy feedback

d <- NULL
load("ci-betas-diversity-main.RData")
d <- bind_rows(ci.betas %>%
               mutate(Model = "Government effectiveness") %>%
               mutate(Variable = as.character(Variable)) %>%
               mutate(Variable = ifelse(Variable == "Government effectiveness",
                                        "GovEff/PolFb", Variable)))

load("ci-betas-diversity-vpi.RData")
d <- bind_rows(d, ci.betas %>%
               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.

Model comparison for the same model specification, diversity measure, and different bureaucratic variable. Environmental Sector. Average Instrument Diversity.
rm(d)

Instrument-based mechanisms

d <- NULL
load("ci-betas-diversity-mbi.RData")
d.liability <- bind_rows(ci.betas %>%
               mutate(Model = "Government effectiveness") %>%
               mutate(Data = "New instrument"))

load("ci-betas-diversity-main.RData")
d <- bind_rows(ci.betas %>%
               mutate(Model = "Government effectiveness") %>%
               mutate(Data = "Original"))

d <- bind_rows(d, d.liability)
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.

Model comparison for the same model specification, diversity measure, by dataset. Environmental Sector. Average Instrument Diversity.
rm(d)

Democracy

d <- NULL
load("ci-betas-diversity-main.RData")
d <- bind_rows(ci.betas %>%
               mutate(Model = "Baseline"))

load("ci-betas-diversity-democracy.RData")
d <- bind_rows(d, ci.betas %>%
               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.

Model comparison for the same model specification, diversity measure, and different bureaucratic variable. Environmental Sector. Average Instrument Diversity.

Programming environment

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).