R codes for the paper One man, One vote Part 1 Electoral Justice in the US Electoral college Banzhaf and Shapley Shubik versus May
Olivier de Mouzon, Thibault Laurent, Michel Le Breton, Issofa Moyouwou
This document presents the R codes used to obtain the computational results included in the paper ``One Man, One Vote’’ Part 1: Electoral Justice in the U.S. Electoral College: Banzhaf and Shapley/Shubik versus May.
To cite this work, please use :
de Mouzon, O., Laurent, T., Le Breton, M. and I. Moyouwou (2019). ``One Man, One Vote’’ Part 1: Electoral Justice in the U.S. Electoral College: Banzhaf and Shapley/Shubik versus May, TSE WP.
Packages needed:
require(Rcpp)
require(readxl)
require(knitr)
require(tidyverse)1 Presentation of our simulator
The Algorithm is presented in the paper. It has been coded in C++ and the codes can be find here.
To use it:
sourceCpp("codesCplusplus_opti.cpp")The function f() takes as argument :
- n_simu: a double, the number of simulations;
- taille_k: a vector of double of size \(K\) with the size of population for each state \(k\), \(k=1,...,K\);
- seats_k: a vector of double of size \(K\) with the number of seats given for each state \(k\), \(k=1,...,K\);
- type: an integer, 0 for IC, 1 for IAC and 2 for IAC*
It returns a vector of size \(K\) with the probability of being pivotal inside each state.
Table 1 in the article presents the number of voters and seats which have been used in our simulator. It can be found here. To load the data:
df_election_usa <- read_xls("electoral_college.xls", skip = 1, n_max = 51)Example of the simulator:
We present here an example of our simulator when the model is Banzhaf (type=0) and the number of simulations is equal to \(10^5\):
f(n_simu = 10^5,
taille_k = df_election_usa$pop_2010,
seats_k = df_election_usa$college_2012,
type = 0)For increasing the number of replications, we have done parallel computing by using the function SimuElec():
SimuElect <- function(x, n_simu, pop, seats, type) {
library("Rcpp")
sourceCpp("codesCplusplus_opti.cpp")
res <- f(n_simu, pop, seats, type = type)
return(res)
}2 The 2010 U.S. Electoral College and Population Data
For representing figure 1 and 2 in the article, we create the following variables :
- nb_representatives equal to the number of seats per state minus 2
- seat_per_hab equal to the number of seats for 1,000,000 inhabitants
- rep_per_hab equal to the number of representatives for 1,000,000 inhabitants
df_election_usa$nb_representatives <- df_election_usa$college_2012 - 2
df_election_usa$seat_per_hab <- df_election_usa$college_2012 /
df_election_usa$pop_2010 * 10^6
df_election_usa$rep_per_hab <- df_election_usa$nb_representatives /
df_election_usa$pop_2010 * 10^6We also create the abbreviation of the names of the states:
df_election_usa$state_abb <- c("AL", "AK", "AZ", "AR", "CA", "CO", "CT", "DE", "DC", "FL",
"GA", "HI", "ID", "IL", "IN", "IA", "KS", "KY", "LA", "ME",
"MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", "NV", "NH",
"NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", "RI",
"SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI",
"WY")To obtain figure 1 in the article:
ggplot(df_election_usa) +
aes(x = log(pop_2010), y = rep_per_hab, label = state_abb) +
geom_point(aes(col = factor(college_2012))) +
labs(color = "Seats") +
geom_text(size = 4, hjust = -0.2) +
geom_hline(yintercept = sum(df_election_usa$nb_representatives) /
sum(df_election_usa$pop_2010) * 10^6,
linetype="dashed", color = "red") +
xlab("Log of population per state") +
ylab("Number of representatives for 1,000,000 inhabitants") +
scale_x_continuous(limits = c(13, 18)) +
scale_y_continuous(limits = c(1, 2))
To obtain figure 2 in the article:
ggplot(df_election_usa) +
aes(x = log(pop_2010), y = seat_per_hab, label = state_abb) +
geom_point(aes(col = factor(college_2012))) +
labs(color = "Seats") +
geom_text(size = 4, hjust = -0.2) +
geom_hline(yintercept = sum(df_election_usa$college_2012) / sum(df_election_usa$pop_2010) * 10^6,
linetype="dashed", color = "red") +
xlab("Log of population per state") +
ylab("Number of seats for 1,000,000 inhabitants") +
scale_x_continuous(limits = c(13, 18)) +
scale_y_continuous(limits = c(1.25, 5.5))
3 Electoral Justice with respect to Banzhaf
For the IC case, we used the exact population and \(10^{12}\) simulations
require("parallel")
n_simu <- 25000000000
P <- 40 # number of clusters
cl <- makeCluster(P)
system.time(
res_par_ic <- clusterApply(cl, 1:40, fun = SimuElect,
n_simu = n_simu, pop = df_election_usa$pop_2010,
seats = df_election_usa$college_2012,
type = 0)
)
stopCluster(cl) The results of the parallel computing can be found in this file results_full_electors.RData. For importing it with R:
load("results_full_electors.RData")
P <- 40
res_IC <- numeric(51)
for(p in 1:P)
res_IC <- res_IC + res_par_ic[[p]]
df_election_usa$pivot_IC <- res_IC/PTo obtain Table 2 in the article, we first need to compute the theoretical values. For doing this, we need to add for each state the theoretical values (see page 12 in the article). The values of \(B_k\) were obtained thanks to the simulator of the Leech brothers (see Table 1 in the Appendix 3).
df_election_usa$B_k <- NULL
for(k in 1:nrow(df_election_usa))
df_election_usa$B_k[k] <- switch(as.character(df_election_usa$college_2012)[k],
"55" = 0.471147,
"38" = 0.298862,
"29" = 0.223975,
"20" = 0.152464,
"18" = 0.136921,
"16" = 0.121475,
"15" = 0.113784,
"14" = 0.106113,
"13" = 0.098460,
"12" = 0.090823,
"11" = 0.083202,
"10" = 0.075594,
"9" = 0.067999,
"8" = 0.060416,
"7" = 0.052842,
"6" = 0.045277,
"5" = 0.037720,
"4" = 0.030169,
"3" = 0.022622)## Warning: Unknown or uninitialised column: 'B_k'.df_election_usa$ic_theory <- sqrt(2/pi/df_election_usa$pop_2010) * df_election_usa$B_kThen, we compute the ration by dividing the probability of being pivotal by the minimum:.
df_election_usa$ratio_IC <- round(df_election_usa$pivot_IC / min(df_election_usa$pivot_IC), 3)We present here the Table 2 in the article:
kable(df_election_usa[, c("state", "ic_theory", "pivot_IC", "ratio_IC")])| state | ic_theory | pivot_IC | ratio_IC |
|---|---|---|---|
| Alabama | 2.48e-05 | 2.48e-05 | 1.368 |
| Alaska | 2.12e-05 | 2.12e-05 | 1.174 |
| Arizona | 2.62e-05 | 2.62e-05 | 1.449 |
| Arkansas | 2.11e-05 | 2.11e-05 | 1.167 |
| California | 6.15e-05 | 6.15e-05 | 3.399 |
| Colorado | 2.42e-05 | 2.42e-05 | 1.334 |
| Connecticut | 2.23e-05 | 2.23e-05 | 1.231 |
| Delaware | 1.90e-05 | 1.90e-05 | 1.050 |
| District of Columbia | 2.33e-05 | 2.33e-05 | 1.286 |
| Florida | 4.11e-05 | 4.11e-05 | 2.272 |
| Georgia | 3.11e-05 | 3.11e-05 | 1.717 |
| Hawaii | 2.06e-05 | 2.06e-05 | 1.138 |
| Idaho | 1.92e-05 | 1.92e-05 | 1.060 |
| Illinois | 3.39e-05 | 3.39e-05 | 1.874 |
| Indiana | 2.60e-05 | 2.60e-05 | 1.438 |
| Iowa | 2.07e-05 | 2.07e-05 | 1.142 |
| Kansas | 2.13e-05 | 2.13e-05 | 1.180 |
| Kentucky | 2.31e-05 | 2.31e-05 | 1.277 |
| Louisiana | 2.26e-05 | 2.26e-05 | 1.248 |
| Maine | 2.08e-05 | 2.09e-05 | 1.152 |
| Maryland | 2.51e-05 | 2.51e-05 | 1.385 |
| Massachusetts | 2.59e-05 | 2.59e-05 | 1.432 |
| Michigan | 3.08e-05 | 3.08e-05 | 1.701 |
| Minnesota | 2.62e-05 | 2.62e-05 | 1.445 |
| Mississippi | 2.09e-05 | 2.09e-05 | 1.157 |
| Missouri | 2.46e-05 | 2.46e-05 | 1.359 |
| Montana | 1.81e-05 | 1.81e-05 | 1.000 |
| Nebraska | 2.22e-05 | 2.22e-05 | 1.229 |
| Nevada | 2.19e-05 | 2.19e-05 | 1.212 |
| New Hampshire | 2.09e-05 | 2.09e-05 | 1.157 |
| New Jersey | 2.85e-05 | 2.85e-05 | 1.576 |
| New Mexico | 2.09e-05 | 2.09e-05 | 1.156 |
| New York | 4.06e-05 | 4.06e-05 | 2.240 |
| North Carolina | 2.94e-05 | 2.94e-05 | 1.622 |
| North Dakota | 2.20e-05 | 2.20e-05 | 1.213 |
| Ohio | 3.21e-05 | 3.21e-05 | 1.775 |
| Oklahoma | 2.17e-05 | 2.17e-05 | 1.201 |
| Oregon | 2.15e-05 | 2.15e-05 | 1.187 |
| Pennsylvania | 3.41e-05 | 3.41e-05 | 1.883 |
| Rhode Island | 2.34e-05 | 2.34e-05 | 1.295 |
| South Carolina | 2.52e-05 | 2.52e-05 | 1.391 |
| South Dakota | 1.99e-05 | 1.99e-05 | 1.102 |
| Tennessee | 2.63e-05 | 2.63e-05 | 1.453 |
| Texas | 4.74e-05 | 4.74e-05 | 2.621 |
| Utah | 2.17e-05 | 2.17e-05 | 1.199 |
| Vermont | 2.27e-05 | 2.27e-05 | 1.256 |
| Virginia | 2.77e-05 | 2.77e-05 | 1.531 |
| Washington | 2.79e-05 | 2.79e-05 | 1.541 |
| West Virginia | 2.21e-05 | 2.21e-05 | 1.219 |
| Wisconsin | 2.53e-05 | 2.53e-05 | 1.396 |
| Wyoming | 2.39e-05 | 2.39e-05 | 1.323 |
To obtain figure 3 in the article:
df_election_usa_ic <- df_election_usa %>%
arrange(desc(ratio_IC))
p <- df_election_usa_ic %>%
ggplot(aes(reorder(state, ratio_IC), ratio_IC)) +
geom_col(aes(fill = factor(college_2012))) +
labs(fill = "Seats") +
coord_flip() +
xlab("State") +
ylab("Ratio of pivotality")
p + guides(fill = guide_legend(reverse = T)) 
To obtain figure 4 in the article:
p <- ggplot(df_election_usa, aes(x = seat_per_hab, y= pivot_IC, color = factor(college_2012),
label = state_abb)) +
geom_text(size = 4, vjust = -0.6, color = "black") +
labs(color = "Seats") +
geom_point(size = 3) +
xlab("Number of electoral seats for 1,000,000 inhabitants") +
ylab("Probability to be pivot")
p + guides(col = guide_legend(nrow = 1, reverse = T)) + theme(legend.position = "bottom",
legend.box = "vertical", legend.text = element_text(size=10)) 
To obtain figure 5, we decompose the probability of being pivotal as shown in page 12 in the article.
order_data_ic <- df_election_usa[order(df_election_usa$pop_2010), ]
order_data_ic$state <- factor(order_data_ic$state,
levels = order_data_ic$state,
ordered= T)
order_data_ic$state_abb <- factor(order_data_ic$state_abb,
levels = order_data_ic$state_abb,
ordered= T)
order_data_ic$P_state <- sqrt(2/pi/order_data_ic$pop_2010)
order_data_ic[, "P_representatives"] <-
order_data_ic[, "pivot_IC"]/(sqrt(2/pi/order_data_ic$pop_2010))To obtain figure 5 at the top:
p <- ggplot(order_data_ic, aes(x = log(pop_2010), y= pivot_IC)) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
geom_hline(yintercept = sum(order_data_ic$pivot_IC * order_data_ic$pop_2010) /
sum(order_data_ic$pop_2010),
linetype="dashed", color = "magenta") +
geom_hline(yintercept = sqrt(2/pi/sum(order_data_ic$pop_2010) ),
linetype="dashed", color = "royalblue") +
xlab("Log of population per state") +
ylab("Probability to be pivot")
p + guides(col = guide_legend(nrow=1, reverse = F)) + theme(legend.position = "top",
legend.box = "vertical", legend.text = element_text(size=6)) 
To obtain figure 5 at the middle:
p <- ggplot(order_data_ic, aes(x = log(pop_2010), y= P_state)) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
xlab("Log of population per state") +
ylab("Pivotality power of voter i in his state")
p + theme(legend.position = "none") 
To obtain figure 5 at the bottom:
p <- ggplot(order_data_ic, aes(x = log(pop_2010), y= P_representatives )) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
xlab("Log of population per state") +
ylab("Pivotality power of the representatives in the second tier")
p + theme(legend.position = "none") 
4 Electoral Justice with respect to Shapley-Shubik
We have done the computations by using the exact population.
require("parallel")
n_simu <- 25000000000
P <- 40 # number of clusters
cl <- makeCluster(P)
system.time(
res_par_iac <- clusterApply(cl, 1:40, fun = SimuElect,
n_simu = n_simu, pop = df_election_usa$pop_2010,
seats = df_election_usa$college_2012,
type = 1)
)
stopCluster(cl) res_IAC <- numeric(51)
for(p in 1:P) {
res_IAC <- res_IAC + res_par_iac[[p]]
}
df_election_usa$pivot_IAC <- res_IAC/PThe statistics on the minimum and maximum obtained with the excat population can be obtained here:
df_election_usa[which.min(df_election_usa$pivot_IAC),
c("state", "pivot_IAC")] ## # A tibble: 1 x 2
## state pivot_IAC
## <chr> <dbl>
## 1 Montana 0.00000000173df_election_usa[which.max(df_election_usa$pivot_IAC),
c("state", "pivot_IAC")] ## # A tibble: 1 x 2
## state pivot_IAC
## <chr> <dbl>
## 1 California 0.00000000572To obtain Table 3 in the article:
df_election_usa$ratio_IAC <- round(df_election_usa$pivot_IAC /
min(df_election_usa$pivot_IAC), 3)kable(df_election_usa[, c("state", "pivot_IAC", "ratio_IAC")], digits = 12)| state | pivot_IAC | ratio_IAC |
|---|---|---|
| Alabama | 2.311e-09 | 1.336 |
| Alaska | 1.905e-09 | 1.101 |
| Arizona | 2.465e-09 | 1.425 |
| Arkansas | 1.941e-09 | 1.122 |
| California | 5.721e-09 | 3.307 |
| Colorado | 2.263e-09 | 1.308 |
| Connecticut | 2.098e-09 | 1.213 |
| Delaware | 1.823e-09 | 1.054 |
| District of Columbia | 2.169e-09 | 1.253 |
| Florida | 3.873e-09 | 2.239 |
| Georgia | 2.990e-09 | 1.728 |
| Hawaii | 1.929e-09 | 1.115 |
| Idaho | 1.842e-09 | 1.065 |
| Illinois | 3.182e-09 | 1.839 |
| Indiana | 2.469e-09 | 1.427 |
| Iowa | 1.942e-09 | 1.123 |
| Kansas | 2.055e-09 | 1.188 |
| Kentucky | 2.178e-09 | 1.259 |
| Louisiana | 2.066e-09 | 1.194 |
| Maine | 1.955e-09 | 1.130 |
| Maryland | 2.377e-09 | 1.374 |
| Massachusetts | 2.448e-09 | 1.415 |
| Michigan | 2.851e-09 | 1.648 |
| Minnesota | 2.490e-09 | 1.439 |
| Mississippi | 1.951e-09 | 1.128 |
| Missouri | 2.306e-09 | 1.333 |
| Montana | 1.730e-09 | 1.000 |
| Nebraska | 2.061e-09 | 1.191 |
| Nevada | 2.091e-09 | 1.209 |
| New Hampshire | 1.955e-09 | 1.130 |
| New Jersey | 2.601e-09 | 1.503 |
| New Mexico | 2.036e-09 | 1.177 |
| New York | 3.882e-09 | 2.244 |
| North Carolina | 2.694e-09 | 1.557 |
| North Dakota | 2.061e-09 | 1.191 |
| Ohio | 3.029e-09 | 1.751 |
| Oklahoma | 2.050e-09 | 1.185 |
| Oregon | 2.072e-09 | 1.197 |
| Pennsylvania | 3.227e-09 | 1.865 |
| Rhode Island | 2.250e-09 | 1.301 |
| South Carolina | 2.391e-09 | 1.382 |
| South Dakota | 1.896e-09 | 1.096 |
| Tennessee | 2.530e-09 | 1.463 |
| Texas | 4.491e-09 | 2.596 |
| Utah | 2.071e-09 | 1.197 |
| Vermont | 2.161e-09 | 1.249 |
| Virginia | 2.565e-09 | 1.482 |
| Washington | 2.568e-09 | 1.484 |
| West Virginia | 2.081e-09 | 1.203 |
| Wisconsin | 2.389e-09 | 1.381 |
| Wyoming | 2.226e-09 | 1.287 |
To obtain figure 6 in the article :
df_election_usa_iac <- df_election_usa %>%
arrange(desc(ratio_IAC))
p <- df_election_usa_iac %>%
ggplot(aes(reorder(state, ratio_IAC), ratio_IAC)) +
geom_col(aes(fill = factor(college_2012))) +
coord_flip() +
labs(fill = "Seats") +
xlab("State") +
ylab("Probability to be pivot")
p + guides(fill = guide_legend(reverse = T)) 
To obtain figure 8 in the article:
p <- ggplot(df_election_usa, aes(x = seat_per_hab, y = pivot_IAC,
color = factor(college_2012),
label = state_abb)) +
geom_text(size = 4, vjust = -0.6, color = "black") +
labs(color = "Seats") +
geom_point(size = 3) +
xlab("Number of electoral seats for 100,000 inhabitants") +
ylab("Probability to be pivot")
p + guides(col = guide_legend(nrow = 1, reverse = T)) + theme(legend.position = "bottom",
legend.box = "vertical", legend.text = element_text(size=10)) 
To obtain figure 7 in the article, we first create a new table with the rankings obtained in the Banzhaf and Shapley-Shubik model.
df_ranking_ic <- df_election_usa[order(df_election_usa$pivot_IC) , c("state", "college_2012")]
df_ranking_ic$type <- "IC"
df_ranking_ic$rank <- 51:1
df_ranking_iac <- df_election_usa[order(df_election_usa$pivot_IAC) , c("state", "college_2012")]
df_ranking_iac$type <- "IAC"
df_ranking_iac$rank <- 51:1
df_ranking <- rbind(df_ranking_ic, df_ranking_iac)
df_ranking$type <- factor(df_ranking$type, levels = c("IC", "IAC"), ordered = T)To obtain figure 7:
df_ranking %>% ggplot(aes(x = type, y = rank, group = state)) +
geom_line(size = 2) +
geom_point(size = 2.3, aes(color = factor(college_2012))) +
labs(color = "Seats") +
geom_text(data = df_ranking %>% filter(type == "IC"), aes(label = state, x = 0.5) ,
hjust = -.05, size = 3) +
geom_text(data = df_ranking %>% filter(type == "IAC"), aes(label = state, x = 2.5) ,
hjust = 1.05, size = 3) 
5 Electoral Justice with respect to May
We have done the computations by using the exact population.
require("parallel")
n_simu <- 25000000000
P <- 40 # number of clusters
cl <- makeCluster(P)
system.time(
res_par_iac_star <- clusterApply(cl, 1:25, fun = SimuElect,
n_simu = n_simu, pop = df_election_usa$pop_2010,
seats = df_election_usa$college_2012,
type = 2)
)
stopCluster(cl)
save(res_par_ic, res_par_iac, res_par_iac_star,
file = "results_all_electors.RData")res_IAC_star <- numeric(51)
for(p in 1:P) {
res_IAC_star <- res_IAC_star + res_par_iac_star[[p]]
}
df_election_usa$pivot_IAC_star <- res_IAC_star/PThe statistics on the minimum and maximum obtained with the excat population can be obtained here:
df_election_usa[which.min(df_election_usa$pivot_IAC_star_exact),
c("state", "pivot_IAC_star")] ## Warning: Unknown or uninitialised column: 'pivot_IAC_star_exact'.## # A tibble: 0 x 2
## # … with 2 variables: state <chr>, pivot_IAC_star <dbl>df_election_usa[which.max(df_election_usa$pivot_IAC_star_exact),
c("state", "pivot_IAC_star")] ## Warning: Unknown or uninitialised column: 'pivot_IAC_star_exact'.## # A tibble: 0 x 2
## # … with 2 variables: state <chr>, pivot_IAC_star <dbl>To obtain Table 4 in the article, we first need to compute the theoretical values.
We create the ratio by dividing the results by the minimum value.
df_election_usa$ratio_IAC_star <- round(df_election_usa$pivot_IAC_star /
min(df_election_usa$pivot_IAC_star), 3)kable(df_election_usa[, c("state", "iac_star_theory",
"pivot_IAC_star", "ratio_IAC_star")],
digits = 11)| state | iac_star_theory | pivot_IAC_star | ratio_IAC_star |
|---|---|---|---|
| Alabama | 1.416e-08 | 1.415e-08 | 1.222 |
| Alaska | 3.135e-08 | 3.116e-08 | 2.691 |
| Arizona | 1.297e-08 | 1.304e-08 | 1.126 |
| Arkansas | 1.547e-08 | 1.541e-08 | 1.331 |
| California | 1.262e-08 | 1.271e-08 | 1.098 |
| Colorado | 1.348e-08 | 1.338e-08 | 1.155 |
| Connecticut | 1.475e-08 | 1.475e-08 | 1.273 |
| Delaware | 2.511e-08 | 2.530e-08 | 2.185 |
| District of Columbia | 3.759e-08 | 3.748e-08 | 3.236 |
| Florida | 1.185e-08 | 1.202e-08 | 1.038 |
| Georgia | 1.249e-08 | 1.245e-08 | 1.075 |
| Hawaii | 2.207e-08 | 2.210e-08 | 1.908 |
| Idaho | 1.917e-08 | 1.893e-08 | 1.635 |
| Illinois | 1.185e-08 | 1.187e-08 | 1.025 |
| Indiana | 1.280e-08 | 1.272e-08 | 1.099 |
| Iowa | 1.483e-08 | 1.477e-08 | 1.275 |
| Kansas | 1.581e-08 | 1.588e-08 | 1.372 |
| Kentucky | 1.389e-08 | 1.384e-08 | 1.195 |
| Louisiana | 1.327e-08 | 1.319e-08 | 1.139 |
| Maine | 2.263e-08 | 2.259e-08 | 1.951 |
| Maryland | 1.306e-08 | 1.307e-08 | 1.128 |
| Massachusetts | 1.268e-08 | 1.256e-08 | 1.085 |
| Michigan | 1.226e-08 | 1.227e-08 | 1.059 |
| Minnesota | 1.422e-08 | 1.421e-08 | 1.227 |
| Mississippi | 1.520e-08 | 1.531e-08 | 1.322 |
| Missouri | 1.257e-08 | 1.259e-08 | 1.087 |
| Montana | 2.275e-08 | 2.283e-08 | 1.971 |
| Nebraska | 2.059e-08 | 2.062e-08 | 1.781 |
| Nevada | 1.671e-08 | 1.671e-08 | 1.443 |
| New Hampshire | 2.283e-08 | 2.279e-08 | 1.968 |
| New Jersey | 1.205e-08 | 1.224e-08 | 1.057 |
| New Mexico | 1.825e-08 | 1.803e-08 | 1.557 |
| New York | 1.153e-08 | 1.158e-08 | 1.000 |
| North Carolina | 1.189e-08 | 1.201e-08 | 1.037 |
| North Dakota | 3.347e-08 | 3.342e-08 | 2.886 |
| Ohio | 1.184e-08 | 1.198e-08 | 1.034 |
| Oklahoma | 1.404e-08 | 1.406e-08 | 1.214 |
| Oregon | 1.373e-08 | 1.370e-08 | 1.183 |
| Pennsylvania | 1.197e-08 | 1.195e-08 | 1.032 |
| Rhode Island | 2.859e-08 | 2.837e-08 | 2.450 |
| South Carolina | 1.464e-08 | 1.463e-08 | 1.263 |
| South Dakota | 2.760e-08 | 2.764e-08 | 2.387 |
| Tennessee | 1.305e-08 | 1.296e-08 | 1.119 |
| Texas | 1.183e-08 | 1.185e-08 | 1.023 |
| Utah | 1.634e-08 | 1.633e-08 | 1.410 |
| Vermont | 3.589e-08 | 3.599e-08 | 3.108 |
| Virginia | 1.225e-08 | 1.226e-08 | 1.059 |
| Washington | 1.345e-08 | 1.339e-08 | 1.156 |
| West Virginia | 2.028e-08 | 2.039e-08 | 1.761 |
| Wisconsin | 1.327e-08 | 1.328e-08 | 1.146 |
| Wyoming | 3.981e-08 | 3.977e-08 | 3.434 |
To obtain figure 9:
df_election_usa_iac_star <- df_election_usa %>%
arrange(desc(ratio_IAC_star))
df_election_usa_iac_star %>%
ggplot(aes(reorder(state, ratio_IAC_star), ratio_IAC_star)) +
geom_col(aes(fill = factor(college_2012))) +
labs(fill = "Seats") +
coord_flip() +
xlab("State") +
ylab("Probability to be pivot") 
To obtain figure 10, we first create the ranks:
df_ranking_iac_star <- df_election_usa[order(df_election_usa$pivot_IAC_star),
c("state", "college_2012")]
df_ranking_iac_star$type <- "IAC_star"
df_ranking_iac_star$rank <- 51:1
df_ranking <- rbind(df_ranking_ic, df_ranking_iac, df_ranking_iac_star)
df_ranking$type <- factor(df_ranking$type,
levels = c("IC", "IAC", "IAC_star"), ordered = T)df_ranking %>% filter(type != "IC") %>% ggplot(aes(x = type, y = rank, group = state)) +
geom_line(size = 2) +
geom_point(size = 2.3, aes(color = factor(college_2012))) +
labs(color = "Seats") +
geom_text(data = df_ranking %>% filter(type == "IAC"), aes(label = state, x = 0.5) ,
hjust = -.05, size = 3) +
geom_text(data = df_ranking %>% filter(type == "IAC_star"), aes(label = state, x = 2.5),
hjust = 1.05, size = 3) 
To obtain figure 12:
p <- ggplot(df_election_usa, aes(x = seat_per_hab, y= pivot_IAC_star,
color = factor(college_2012),
label = state_abb)) +
geom_text(size = 4, vjust = -0.6, color = "black") +
labs(color = "Seats") +
geom_point(size = 3) +
xlab("Number of electoral seats for 100,000 inhabitants") +
ylab("Probability to be pivot")
p + guides(col = guide_legend(nrow = 1, reverse = T)) + theme(legend.position = "bottom",
legend.box = "vertical", legend.text = element_text(size=10)) 
To obtain figure 11, we decompose the probability of being pivotal as presented in page 12 in the article:
order_data_iac_star <- df_election_usa[order(df_election_usa$pop_2010), ]
order_data_iac_star$state <- factor(order_data_iac_star$state,
levels = order_data_iac_star$state,
ordered= T)
order_data_iac_star$state_abb <- factor(order_data_iac_star$state_abb,
levels = order_data_iac_star$state_abb,
ordered= T)
order_data_iac_star$P_state <- 1/order_data_iac_star$pop_2010
order_data_iac_star[, "P_representatives"] <-
order_data_iac_star[, "pivot_IAC_star"]/(1/order_data_iac_star$pop_2010)To obtain figure 11 at the top:
p <- ggplot(order_data_iac_star, aes(x = log(pop_2010), y= pivot_IAC_star)) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
geom_hline(yintercept = sum(order_data_iac_star$pivot_IAC_star * order_data_iac_star$pop_2010) /
sum(order_data_iac_star$pop_2010),
linetype="dashed", color = "magenta") +
xlab("Log of population per state") +
ylab("Probability to be pivot")
p + guides(col = guide_legend(nrow=1, reverse = F)) + theme(legend.position = "top",
legend.box = "vertical", legend.text = element_text(size=6)) 
To obtain figure 11 at the middle:
p <- ggplot(order_data_iac_star, aes(x = log(pop_2010), y= P_state)) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
xlab("Log of population per state") +
ylab("Pivotality power of voter i in his state")
p + theme(legend.position = "none") 
To obtain figure 11 at the bottom:
p <- ggplot(order_data_iac_star, aes(x = log(pop_2010), y = P_representatives )) +
geom_point(aes(colour = factor(college_2012)), size = 3) +
theme(axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1)) +
labs(color = "Seats") +
xlab("Log of population per state") +
ylab("Pivotality power of the representatives in the second tier")
p + theme(legend.position = "none") 
library(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2##
## Attaching package: 'GGally'## The following object is masked from 'package:dplyr':
##
## nasaggpairs(df_election_usa[, c("pivot_IC", "pivot_IAC", "pivot_IAC_star")])
## logical(0)