Skip to content

Instantly share code, notes, and snippets.

/biproportional.R Secret

Created May 26, 2016 23:55
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/1b6c312f28f5b370c14c37ec867d329c to your computer and use it in GitHub Desktop.
Save anonymous/1b6c312f28f5b370c14c37ec867d329c to your computer and use it in GitHub Desktop.
Download ZIP
R-Code zum Blogeintrag "Wer hat Angst vorm Pukelsheim?" im UZH-Seminar "Politischer Datenjournalismus" 2016: http://pwipdm.uzh.ch/wordpress/?p=7201
Raw
biproportional.R
# Copyright (C) 2016 Salim Brüggemann
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# To get a copy of the GNU General Public License see <http://www.gnu.org/licenses/>.
###############################################################################
# Blogeintrag im UZH-Seminar "Politischer Datenjournalismus" 2016: http://pwipdm.uzh.ch/wordpress/?p=7201
# Autor: Salim Brüggemann, 08-915-126
###############################################################################
remove(list = ls(all = TRUE))
setwd("~/Dokumente/Ausbildung/Studium UZH/Master/2. Semester/Politischer Datenjournalismus/Blogeinträge/3. Blogeintrag")
library(dplyr)
library(DT)
library(ggiraph)
library(grid)
library(plotly)
library(RBazi)
library(reshape2)
library(rgdal)
library(rgeos)
library(viridis)
# Funktion für Parteifarben definieren
get_party_color <- function(party, alpha = 180) {
switch(party,
"AL" = rgb(238, 29, 35, alpha, maxColorValue = 255),
"AL | PdA | solidaritéS" = rgb(238, 29, 35, alpha, maxColorValue = 255),
"BDP" = rgb(255, 221, 0, alpha, maxColorValue = 255),
"CSP" = rgb(0, 150, 167, alpha, maxColorValue = 255),
"CSP Obwalden" = rgb(215, 45, 12, alpha, maxColorValue = 255),
"CVP" = rgb(255, 133, 12, alpha, maxColorValue = 255),
"EDU" = rgb(102, 51, 0, alpha, maxColorValue = 255),
#"EDU" = rgb(0, 0, 0, alpha, maxColorValue = 255),
"EVP" = rgb(204, 153, 255, alpha,maxColorValue = 255),
#"EVP" = rgb(0, 97, 172, alpha,maxColorValue = 255),
"FDP" = rgb(16, 79, 160, alpha, maxColorValue = 255),
"glp" = rgb(195, 217, 63, alpha, maxColorValue = 255),
"Grüne" = rgb(132, 180, 20, alpha, maxColorValue = 255),
"Junge CVP" = rgb(255, 133, 12, alpha, maxColorValue = 255),
"Junge glp" = rgb(195, 217, 63, alpha, maxColorValue = 255),
"Junge Grüne" = rgb(132, 180, 20, alpha, maxColorValue = 255),
#"Junge Grüne" = rgb(44, 79, 57, alpha, maxColorValue = 255),
"Junge SVP" = rgb(63, 123, 23, alpha, maxColorValue = 255),
#"Junge SVP" = rgb(0, 145, 61, alpha, maxColorValue = 255),
"Jungfreisinnige" = rgb(16, 79, 160, alpha, maxColorValue = 255),
#"Jungfreisinnige" = rgb(0, 76, 147, alpha, maxColorValue = 255),
"JUSO" = rgb(238, 42, 59, alpha, maxColorValue = 255),
#"JUSO" = rgb(238, 42, 46, alpha, maxColorValue = 255),
"LDP" = rgb(0, 73, 144, alpha, maxColorValue = 255),
"Lega" = rgb(102, 51, 0, alpha, maxColorValue = 255),
"MCG" = rgb(249, 250, 0, alpha, maxColorValue = 255),
"PdA" = rgb(255, 0, 0, alpha, maxColorValue = 255),
"Piraten" = rgb(0, 0, 0, alpha, maxColorValue = 255),
#"Piraten" = rgb(249, 178, 0, alpha, maxColorValue = 255),
"SP" = rgb(238, 42, 59, alpha, maxColorValue = 255),
"SVP" = rgb(63, 123, 23, alpha, maxColorValue = 255))
}
# Angaben zur Anzahl (un)gültiger Wahlzettel/Stimmender gemäss Bundeskanzlei definieren (S. 3 von https://www.admin.ch/opc/de/federal-gazette/2015/7927.pdf)
ballot_papers_2015 <- list(voters_eligible = 5283556,
voters_participating = 2563052,
spoiled_ballot_papers = 30665,
empty_ballot_papers = 10885)
# Wahlergebnisse der Nationalratswahlen 2015 einlesen
data_tickets_2015 <- read.csv("Nationalratswahlen 2015 – Erhaltene Stimmen und Stärke der Wahllisten nach Kantonen.csv", stringsAsFactors = FALSE)
data_candidates_2015 <- read.csv("Nationalratswahlen 2015 – Erhaltene Stimmen der Kandidierenden nach Kantonen.csv", stringsAsFactors = FALSE)
data_mandates_2015 <- read.csv("Nationalratswahlen 2015 – Mandatsverteilung nach Parteien und Kanton.csv", stringsAsFactors = FALSE)
data_voters_share_2015 <- read.csv("Nationalratswahlen 2015 – Parteistärken.csv", stringsAsFactors = FALSE)
# Unterschiedliche Namen vergeben an Kleinstparteien, die vom BFS nur pauschal als "Übrige" aufgeführt sind (damit deren Stimmen später nicht fälschlich einer einzigen fiktiven Partei "Übrige" zugerechnet werden)
data_tickets_2015$Unterpartei[data_tickets_2015$Unterpartei == ""] <- paste0("_sonstige_", 1:length(data_tickets_2015$Unterpartei[data_tickets_2015$Unterpartei == ""]))
# Variable für national ausgeglichen gewichtete Stimmenzahl in Wahllistendatensatz einfügen
data_tickets_2015$Erhaltene_Stimmen_NZZ <- data_tickets_2015$Erhaltene_Stimmen / data_tickets_2015$Kantonaler_Sitzanspruch
# Art der Listenberücksichtigung im Wahlergebnis (real) bestimmen
data_tickets_2015$Listenberücksichtigung <- ""
for ( i in unique(data_tickets_2015$Kanton) ) {
parties_directly_considered <- data_mandates_2015$Partei[data_mandates_2015[, i] != 0]
lists_considered <- unique(data_tickets_2015$Listenverbindung[data_tickets_2015$Kanton == i & data_tickets_2015$Unterpartei %in% parties_directly_considered])
lists_considered <- lists_considered[lists_considered != ""]
data_tickets_2015$Listenberücksichtigung[data_tickets_2015$Kanton == i & data_tickets_2015$Unterpartei %in% parties_directly_considered] <- "direkt"
data_tickets_2015$Listenberücksichtigung[data_tickets_2015$Kanton == i & !(data_tickets_2015$Unterpartei %in% parties_directly_considered) & data_tickets_2015$Listenverbindung %in% lists_considered] <-"indirekt"
data_tickets_2015$Listenberücksichtigung[data_tickets_2015$Kanton == i & !(data_tickets_2015$Unterpartei %in% parties_directly_considered) & !(data_tickets_2015$Listenverbindung %in% lists_considered)] <- "nicht"
}
# Doppeltproportionale Sitzzuteilung mittels RBazi berechnen
## Stimmdaten-Matrix generieren
subparty_votes_v1 <-
data_tickets_2015 %>%
select(Kanton, Unterpartei, Erhaltene_Stimmen) %>%
group_by(Kanton, Unterpartei) %>%
summarise(sum(Erhaltene_Stimmen)) %>%
rename(Erhaltene_Stimmen = `sum(Erhaltene_Stimmen)`) %>%
ungroup() %>%
acast(Kanton ~ Unterpartei, value.var = "Erhaltene_Stimmen")
### NAs durch 0 ersetzen
subparty_votes_v1[is.na(subparty_votes_v1)] <- 0
## Sitzzahlen-Vektor generieren
seat_numbers <-
data_tickets_2015 %>%
select(Kanton, Kantonaler_Sitzanspruch) %>%
distinct(Kanton) %>%
arrange(Kanton) %>%
select(Kantonaler_Sitzanspruch) %>%
unlist()
## Zuteilung berechnen
apportionment_biprob_2015_v1 <- bipropApp(districtMagnitudes = seat_numbers,
votes = subparty_votes_v1,
appMethod = "DivStd",
nzz = TRUE)
## Oberzuteilung extrahieren
superapportionment_v1 <- apportionment_biprob_2015_v1$Superapportionment$DivStdh200$apportionment
superapportionment_v1 <- superapportionment_v1[grep(x = names(superapportionment_v1), pattern = "^(?!_sonstige.*)", perl = TRUE)]
## Parteien ermitteln, welche keinen eigenen Sitz erreichten
names(superapportionment_v1[superapportionment_v1 == 0])
## Stimmen für diese Parteien den jeweiligen Mutter- bzw. listenverbundenen Parteien zurechnen, sofern eindeutig möglich
data_tickets_2015$Unterpartei_v2 <- data_tickets_2015$Unterpartei
data_tickets_2015$Unterpartei_v2[data_tickets_2015$Unterpartei_v2 == "Junge EVP"] <- "EVP"
data_tickets_2015$Unterpartei_v2[data_tickets_2015$Unterpartei_v2 == "Junge EDU"] <- "EDU"
data_tickets_2015$Unterpartei_v2[data_tickets_2015$Unterpartei_v2 == "SD" & data_tickets_2015$Kanton == "BE"] <- "EDU"
## Doppeltproportionale Sitzzuteilung nochmals anhand der aktualisierten geänderten Daten berechnen
### Stimmdaten-Matrix generieren
subparty_votes_v2 <-
data_tickets_2015 %>%
select(Kanton, Unterpartei_v2, Erhaltene_Stimmen) %>%
group_by(Kanton, Unterpartei_v2) %>%
summarise(sum(Erhaltene_Stimmen)) %>%
rename(Erhaltene_Stimmen = `sum(Erhaltene_Stimmen)`) %>%
ungroup() %>%
acast(Kanton ~ Unterpartei_v2, value.var = "Erhaltene_Stimmen")
#### NAs durch 0 ersetzen
subparty_votes_v2[is.na(subparty_votes_v2)] <- 0
### Zuteilung berechnen
apportionment_biprob_2015_v2 <- bipropApp(districtMagnitudes = seat_numbers,
votes = subparty_votes_v2,
appMethod = "DivStd",
nzz = TRUE)
##3 Oberzuteilung extrahieren
superapportionment_v2 <- apportionment_biprob_2015_v2$Superapportionment$DivStdh200$apportionment
superapportionment_v2 <- superapportionment_v2[grep(x = names(superapportionment_v2), pattern = "^(?!_sonstige.*)", perl = TRUE)]
### Wiederum Parteien ermitteln, welche keinen eigenen Sitz erreichten
names(superapportionment_v2[superapportionment_v2 == 0]) # neu erreicht die "Junge BDP" keinen eigenen Sitz mehr
## Stimmen für die "Junge BDP" der Mutterpartei zurechnen
data_tickets_2015$Unterpartei_v3 <- data_tickets_2015$Unterpartei_v2
data_tickets_2015$Unterpartei_v3[data_tickets_2015$Unterpartei_v3 == "Junge BDP"] <- "BDP"
## Doppeltproportionale Sitzzuteilung ein drittes Mal anhand der aktualisierten geänderten Daten berechnen
### Stimmdaten-Matrix generieren
subparty_votes_v3 <-
data_tickets_2015 %>%
select(Kanton, Unterpartei_v3, Erhaltene_Stimmen) %>%
group_by(Kanton, Unterpartei_v3) %>%
summarise(sum(Erhaltene_Stimmen)) %>%
rename(Erhaltene_Stimmen = `sum(Erhaltene_Stimmen)`) %>%
ungroup() %>%
acast(Kanton ~ Unterpartei_v3, value.var = "Erhaltene_Stimmen")
#### NAs durch 0 ersetzen
subparty_votes_v3[is.na(subparty_votes_v3)] <- 0
### Zuteilung berechnen
apportionment_biprob_2015_v3 <- bipropApp(districtMagnitudes = seat_numbers,
votes = subparty_votes_v3,
appMethod = "DivStd",
nzz = TRUE)
### Oberzuteilung extrahieren
superapportionment_v3 <- apportionment_biprob_2015_v3$Superapportionment$DivStdh200$apportionment
superapportionment_v3 <- superapportionment_v3[grep(x = names(superapportionment_v3), pattern = "^(?!_sonstige.*)", perl = TRUE)]
### Wiederum Parteien ermitteln, welche keinen eigenen Sitz erreichten
names(superapportionment_v3[superapportionment_v3 == 0]) # keine Veränderung mehr, passt!
# Dataframe mit Sitzverteilungen und Co. generieren
data_mandates_plus_2015 <- data.frame(Partei = sort(names(superapportionment_v3[superapportionment_v3 != 0])),
Jungpartei = FALSE,
Parteiblock = "",
Mandate_real = rowSums(data_mandates_2015[2:length(data_mandates_2015)]),
Mandate_biproportional = superapportionment_v3[superapportionment_v3 != 0][sort(names(superapportionment_v3[superapportionment_v3 != 0]))],
stringsAsFactors = FALSE)
data_mandates_plus_2015$Differenz <- data_mandates_plus_2015$Mandate_biproportional - data_mandates_plus_2015$Mandate_real
data_mandates_plus_2015$Jungpartei[grep(x = data_mandates_plus_2015$Partei, pattern = "(JUSO|Jung.*)")] <- TRUE
data_voters_share_biprop_2015 <-
data_tickets_2015 %>%
group_by(Unterpartei_v3) %>%
summarise(sum(Erhaltene_Stimmen_NZZ) / sum(data_tickets_2015$Erhaltene_Stimmen_NZZ) * 100) %>%
rename(Parteistärke_biproportional = `sum(Erhaltene_Stimmen_NZZ)/sum(data_t...`) %>%
rename(Partei = Unterpartei_v3) %>%
ungroup()
data_mandates_plus_2015 <- merge(data_mandates_plus_2015, data_voters_share_biprop_2015, by = ("Partei"), all.x = TRUE)
data_mandates_plus_2015 <- merge(data_mandates_plus_2015, data_voters_share_2015, by = ("Partei"), all.x = TRUE)
# Parteien nach Links-Rechts-Schema anordnen
order_political_orientation_2015 <- c("AL | PdA | solidaritéS",
"JUSO",
"SP",
"Junge Grüne",
"Grüne",
"Piraten",
"Junge glp",
"glp",
"CSP Obwalden",
"EVP",
"Junge CVP",
"CVP",
"BDP",
"LDP",
"Jungfreisinnige",
"FDP",
"MCG",
"Lega",
"SVP",
"Junge SVP",
"EDU")
data_mandates_plus_2015 <- slice(data_mandates_plus_2015, match(order_political_orientation_2015, Partei))
data_mandates_plus_2015$Parteiblock[1:5] <- "Linke"
data_mandates_plus_2015$Parteiblock[6:16] <- "Mitte"
data_mandates_plus_2015$Parteiblock[17:21] <- "Rechte"
data_mandates_plus_2015$Parteifarbe <- ""
for ( i in data_mandates_plus_2015$Partei ) {
data_mandates_plus_2015$Parteifarbe[data_mandates_plus_2015$Partei == i] <- get_party_color(i)
}
# Bar Plots zur Sitzverteilung real vs. biproportional mittels Plotly generieren
## Parteifarbpaletten definieren
young_party_colors <- colorRampPalette(subset(data_mandates_plus_2015, Jungpartei == TRUE)$Parteifarbe)
old_party_colors <- colorRampPalette(subset(data_mandates_plus_2015, Jungpartei == FALSE)$Parteifarbe)
all_party_colors <- colorRampPalette(data_mandates_plus_2015$Parteifarbe)
## Bar Plot zu offiziellen gegenüber biproportionalen Sitzzahldifferenzen mittels Plotly erzeugen
bar_plot_2015 <-
plot_ly(data = subset(data_mandates_plus_2015, Jungpartei == TRUE),
x = Partei,
y = Differenz,
text = paste0(Partei,
"<br><br>Parteistärke",
"<br>biproportional: ", round(Parteistärke_biproportional, digits = 1), " %",
"<br><br>Anzahl Mandate",
"<br>offiziell: ", Mandate_real,
"<br>biproportional: ", Mandate_biproportional),
marker = list(line = list(color = "#00ffff",
width = 4),
color = young_party_colors(length(Partei))),
name = "Jungparteien",
legendgroup = "Jungparteien",
type = "bar",
hoverinfo = "text") %>%
add_trace(data = subset(data_mandates_plus_2015, Jungpartei == FALSE),
x = Partei,
y = Differenz,
text = paste0(Partei,
"<br><br>Parteistärke",
ifelse(is.na(Parteistärke_real), "", paste0("<br>offiziell: ", round(Parteistärke_real, digits = 1), " %")),
"<br>biproportional: ", round(Parteistärke_biproportional, digits = 1), " %",
"<br><br>Anzahl Mandate",
"<br>offiziell: ", Mandate_real,
"<br>biproportional: ", Mandate_biproportional),
marker = list(color = old_party_colors(length(Partei))),
name = "restliche Parteien",
legendgroup = "restliche Parteien",
type = "bar",
hoverinfo = "text") %>%
layout(title = "Differenz zwischen offizieller und biproportionaler Sitzverteilung im Nationalrat<br>「2015 - 2019」",
xaxis = list(title = ""),
yaxis = list(title = "Differenz an Nationalratsmandaten"),
font = list(family = "Liberation Serif"),
margin = list(l = 60, r = 0, t = 40, b = 140, pad = 0, autoexpand = TRUE),
width = 800,
height = 800) %>%
config(displaylogo = FALSE,
showLink = FALSE,
displayModeBar = FALSE)
bar_plot_2015
plotly_POST(bar_plot_2015, filename = "DDJ-Blogeintrag 3/Barplot 2015", fileopt = "overwrite", sharing = "public")
## Bar Plot zu offizieller gegenüber biproportionaler Sitzzahlen mittels Plotly erzeugen
bar_plot_2_2015 <-
plot_ly(data = data_mandates_plus_2015,
x = Partei,
y = Mandate_real,
marker = list(color = all_party_colors(length(Partei))),
opacity = 0.5,
name = "offiziell",
legendgroup = "offiziell",
type = "bar",
hoverinfo = "none") %>%
add_trace(data = data_mandates_plus_2015,
x = Partei,
y = Mandate_biproportional,
text = paste0(Partei,
"<br><br>Parteistärke",
ifelse(is.na(Parteistärke_real), "", paste0("<br>offiziell: ", round(Parteistärke_real, digits = 1), " %")),
"<br>biproportional: ", round(Parteistärke_biproportional, digits = 1), " %",
"<br><br>Anzahl Mandate",
"<br>offiziell: ", Mandate_real,
"<br>biproportional: ", Mandate_biproportional),
marker = list(color = all_party_colors(length(Partei))),
name = "biproportional",
legendgroup = "biproportional",
type = "bar",
hoverinfo = "text") %>%
layout(title = "Sitzverteilung im Nationalrat<br>「2015 - 2019」",
xaxis = list(title = ""),
yaxis = list(title = "Nationalratsmandate"),
font = list(family = "Liberation Serif"),
margin = list(l = 60, r = 0, t = 40, b = 140, pad = 0, autoexpand = TRUE),
width = 800,
height = 800) %>%
config(displaylogo = FALSE,
showLink = FALSE,
displayModeBar = FALSE)
bar_plot_2_2015
plotly_POST(bar_plot_2_2015, filename = "DDJ-Blogeintrag 3/Barplot 2 2015", fileopt = "overwrite", sharing = "public")
# Pie Chart zu offizieller vs. biproportionaler Sitzverteilung nach Parteiblöcken mittels Plotly erzeugen
party_blocks <- data.frame(Parteiblock = unique(data_mandates_plus_2015$Parteiblock),
Parteien = "",
stringsAsFactors = FALSE)
for ( i in unique(data_mandates_plus_2015$Parteiblock) ) {
party_blocks$Parteien_real[party_blocks$Parteiblock == i] <- paste(data_mandates_plus_2015$Partei[data_mandates_plus_2015$Parteiblock==i & data_mandates_plus_2015$Mandate_real != 0], collapse = "<br>")
party_blocks$Parteien_biproportional[party_blocks$Parteiblock == i] <- paste(data_mandates_plus_2015$Partei[data_mandates_plus_2015$Parteiblock==i & data_mandates_plus_2015$Mandate_biproportional != 0], collapse = "<br>")
}
## Parteistärken pro Parteiblock berechnen
Parteiblockstärke_biproportional <- list(Linke = sum(data_mandates_plus_2015$Parteistärke_biproportional[data_mandates_plus_2015$Parteiblock == "Linke"]),
Mitte = sum(data_mandates_plus_2015$Parteistärke_biproportional[data_mandates_plus_2015$Parteiblock == "Mitte"]),
Rechte = sum(data_mandates_plus_2015$Parteistärke_biproportional[data_mandates_plus_2015$Parteiblock == "Rechte"]))
Parteiblockstärke_real <- list(Linke = sum(data_mandates_plus_2015$Parteistärke_real[data_mandates_plus_2015$Parteiblock == "Linke"], na.rm = TRUE),
Mitte = sum(data_mandates_plus_2015$Parteistärke_real[data_mandates_plus_2015$Parteiblock == "Mitte"], na.rm = TRUE),
Rechte = sum(data_mandates_plus_2015$Parteistärke_real[data_mandates_plus_2015$Parteiblock == "Rechte"], na.rm = TRUE))
pie_chart_real_2015 <-
plot_ly(type = "pie",
data = data_mandates_plus_2015 %>% group_by(Parteiblock) %>% summarise(sum(Mandate_real)),
values = `sum(Mandate_real)`,
labels = Parteiblock,
marker = list(colors = c("#ff3399", "#14b8b8", "#4d2800")),
text = paste0(party_blocks$Parteien_real[party_blocks$Parteiblock == Parteiblock],
"<br><br>Anzahl Mandate: ", `sum(Mandate_real)`,
"<br><br>Parteiblockstärke: ", round(as.numeric(Parteiblockstärke_real[Parteiblock]), digits = 1), " %"),
textinfo = "label+value",
hoverinfo = "text",
insidetextfont = list(family = "Liberation Serif",
color = "#ffffff"),
name = "Mandate real",
legendgroup = "Mandate",
direction = "counterclockwise",
#hole = 0.5,
opacity = 0.6,
pull = 0.02,
rotation = 122.5,
hoverinfo = "text",
domain = list(x = c(0, 0.48), y = c(0, 1))) %>%
add_trace(type = "pie",
data = data_mandates_plus_2015 %>% group_by(Parteiblock) %>% summarise(sum(Mandate_biproportional)),
values = `sum(Mandate_biproportional)`,
labels = Parteiblock,
marker = list(colors = c("#ff3399", "#14b8b8", "#4d2800")),
text = paste0(party_blocks$Parteien_biproportional[party_blocks$Parteiblock == Parteiblock],
"<br><br>Anzahl Mandate: ", `sum(Mandate_biproportional)`,
"<br><br>Parteiblockstärke: ", round(as.numeric(Parteiblockstärke_biproportional[Parteiblock]), digits = 1), " %"),
textinfo = "label+value",
hoverinfo = "text",
insidetextfont = list(family = "Liberation Serif",
color = "#ffffff"),
name = "Mandate biproportional",
legendgroup = "Mandate",
direction = "counterclockwise",
#hole = 0.5,
pull = 0.02,
rotation = 117,
hoverinfo = "text",
domain = list(x = c(0.52, 1), y = c(0, 1))) %>%
layout(title = "Sitzverteilung im Nationalrat<br>「2015 - 2019」",
margin = list(l = 0, r = 0, t = 40, b = 0, pad = 0, autoexpand = TRUE),
width = 800,
height = 490,
showlegend = FALSE,
font = list(family = "Liberation Serif"),
annotations = list(list(x = 0.205 , y = 1, text = "offiziell", showarrow = F, xref='paper', yref='paper', font = list(size = 16)),
list(x = 0.82 , y = 1, text = "biproportional", showarrow = F, xref='paper', yref='paper', font = list(size = 16)))) %>%
config(displaylogo = FALSE,
showLink = FALSE,
displayModeBar = FALSE)
pie_chart_real_2015
plotly_POST(pie_chart_real_2015, filename = "DDJ-Blogeintrag 3/Pie Chart 2015", fileopt = "overwrite", sharing = "public")
# Anzahl (nicht) berücksichtigter (Pseudo-)WählerInnen/Wahlzettel berechnen (real vs. biproportional)
## real direkt, indirekt und nicht berücksichtigte berechnen
data_voter_consideration_2015 <-
data_tickets_2015 %>%
group_by(Kanton, Listenberücksichtigung) %>%
summarise(sum(Erhaltene_Stimmen_NZZ)) %>%
ungroup() %>%
dcast(Kanton ~ Listenberücksichtigung, value.var = "sum(Erhaltene_Stimmen_NZZ)") %>%
rename(real_direkt = direkt) %>%
rename(real_indirekt = indirekt) %>%
rename(real_nicht = nicht)
## biproportional direkt und nicht berücksichtigte berechnen
### (Pseudo-)WählerInnen/Wahlzettel pro Partei und Kanton berechnen
data_votes_nzz_2015 <-
data_tickets_2015 %>%
group_by(Kanton, Unterpartei_v3) %>%
summarise(sum(Erhaltene_Stimmen_NZZ)) %>%
ungroup() %>%
dcast(Kanton ~ Unterpartei_v3, value.var = "sum(Erhaltene_Stimmen_NZZ)")
### biproportional nicht berücksichtigte Parteien ermitteln
biprop_unconsidered_parties <- names(apportionment_biprob_2015_v3$Superapportionment$DivStdh200$apportionment[apportionment_biprob_2015_v3$Superapportionment$DivStdh200$apportionment == 0])
### direkt und nicht berücksichtigte (Pseudo-)WählerInnen/Wahlzettel pro Kanton berechnen
data_voter_consideration_2015$biproportional_direkt <- NA
data_voter_consideration_2015$biproportional_nicht <- NA
for ( i in data_votes_nzz_2015$Kanton ) {
biprop_unconsidered_parties_cantonal <- biprop_unconsidered_parties
# In "BE" "SD" raus, da dort berücksichtigt (an "EDU" geflossen)
if ( i == "BE" ) biprop_unconsidered_parties_cantonal <- biprop_unconsidered_parties_cantonal[biprop_unconsidered_parties_cantonal != "SD"]
data_voter_consideration_2015$biproportional_direkt[data_voter_consideration_2015$Kanton == i] <- sum(subset(data_votes_nzz_2015, Kanton == i)[, !(colnames(data_votes_nzz_2015) %in% biprop_unconsidered_parties_cantonal) & colnames(data_votes_nzz_2015) != "Kanton"], na.rm = TRUE)
data_voter_consideration_2015$biproportional_nicht[data_voter_consideration_2015$Kanton == i] <- sum(subset(data_votes_nzz_2015, Kanton == i)[, colnames(data_votes_nzz_2015) %in% biprop_unconsidered_parties_cantonal], na.rm = TRUE)
}
### (Pseudo-)WählerInnen/Wahlzettel-Total pro Kanton berechnen
data_voter_consideration_2015$total <- (data_tickets_2015 %>% group_by(Kanton) %>% summarise(sum(Erhaltene_Stimmen_NZZ)))$`sum(Erhaltene_Stimmen_NZZ)`
### Bereinigung/Rundung auf Ganzzahlen
data_voter_consideration_2015[is.na(data_voter_consideration_2015)] <- 0
data_voter_consideration_2015$total <- as.integer(round(data_voter_consideration_2015$total))
data_voter_consideration_2015$real_direkt <- as.integer(round(data_voter_consideration_2015$real_direkt))
data_voter_consideration_2015$real_indirekt <- as.integer(round(data_voter_consideration_2015$real_indirekt))
data_voter_consideration_2015$real_nicht <- as.integer(round(data_voter_consideration_2015$real_nicht))
data_voter_consideration_2015$biproportional_direkt <- as.integer(round(data_voter_consideration_2015$biproportional_direkt))
data_voter_consideration_2015$biproportional_nicht <- as.integer(round(data_voter_consideration_2015$biproportional_nicht))
# Choropleth Plots (Inspiration: https://gist.github.com/hrbrmstr/e3d0dc87eaacf7bbece7 | Kartendaten: https://github.com/ruedin/swisscantonsmod/)
switzerland <- readOGR(dsn = "./swisscantons", layer = "ch-cantons")
data_plot_switzerland <- fortify(switzerland)
data_voter_consideration_2015$id[c(1, 3, 2, 5, 6, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 18, 20, 21, 22, 24, 23, 26, 25)] <- 0:25
# data_voter_consideration_2015$Zentrum_Koordinate_x <- data.frame(gCentroid(switzerland, byid = TRUE))[c(1, 3, 2, 5, 6, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 18, 20, 21, 22, 24, 23, 26, 25), "x"]
# data_voter_consideration_2015$Zentrum_Koordinate_y <- data.frame(gCentroid(switzerland, byid = TRUE))[c(1, 3, 2, 5, 6, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 18, 20, 21, 22, 24, 23, 26, 25), "y"]
data_plot_switzerland <- merge(data_plot_switzerland, data_voter_consideration_2015, by = "id")
## Funktion zur Generierung eines interaktiven htmlwidgets-Plots mittels ggraph
plot_ggiraph <- function(ggplot_object) {
ggiraph(code = print(ggplot_object),
hover_css = "fill:orangered;r:6pt",
tooltip_offx = 20,
tooltip_offy = 0,
tooltip_opacity = 0.9,
width = "100%",
height = "700px")
}
## Funktion zum ggplot-theming definieren
theme_map <- function(base_size = 9, base_family = "") {
theme_bw(base_size = base_size, base_family = base_family) %+replace%
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid = element_blank(),
panel.margin = unit(0, "lines"),
plot.background = element_blank(),
plot.title = element_text(size = 9, hjust = 0.5, vjust=-1),
plot.subtitle = element_text(size = 7, hjust = 0.5),
legend.text = element_text(size = 6),
legend.title = element_text(size = 7),
legend.key.width = unit(30, "points"),
legend.title.align = 1,
legend.justification = c(0, 0),
legend.position = "bottom"
)
}
## offiziell nicht berücksichtigte Wahlzettel plotten mittels ggplot2
choropleth_plot_real <- ggplot(mapping = aes(data_id = Kanton,
tooltip = paste0("<span style=\"color: #ff4500;\"><strong>", Kanton, "</strong></span>",
"<br><br>Total Wahlzettel: <em>", total, "</em>",
"<br><br>Unberücksichtigte Wahlzettel",
"<br><span style=\"color: #ff4500;\">offiziell: </span><em>", real_nicht, "</em> bzw. <span style=\"color: #ff4500;\"><strong>", round((real_nicht / total) * 100, digits = 1), " %</strong></span>",
"<br><span style=\"color: #00e600;\">biproportional: </span><em>", biproportional_nicht, "</em> bzw. <span style=\"color: #00e600;\"><strong>", round((biproportional_nicht / total) * 100, digits = 1), " %</strong></span>",
"<br><br>Anzahl Sitze: ", colSums(data_mandates_2015[, Kanton])))) +
geom_map_interactive(data = subset(data_plot_switzerland, Kanton != "AR"),
map = subset(data_plot_switzerland, Kanton != "AR"),
mapping = aes(map_id = id,
x = long,
y = lat,
# group = group,
fill = (real_nicht / total) * 100),
color = "#ffffff",
size = 0.3) +
# Workaround zur korrekten Darstellung (AR muss nach SG geplottet werden; offenbar, weil es (wie AI) komplett von SG umschlossen ist (aber vor AI geplottet wird?))
geom_map_interactive(data = subset(data_plot_switzerland, Kanton == "AR"),
map = subset(data_plot_switzerland, Kanton == "AR"),
mapping = aes(map_id = id,
x = long,
y = lat,
# group = group,
fill = (real_nicht / total) * 100),
color = "#ffffff",
size = 0.3) +
# geom_text_interactive(data = data_voter_consideration_2015,
# mapping = aes(label = Kanton,
# x = Zentrum_Koordinate_x,
# y = Zentrum_Koordinate_y),
# size = 3) +
coord_map() +
scale_fill_viridis() +
labs(x = "",
y = "",
fill = "offiziell unberücksichtigte \nWahlzettel in % ",
title = "Offiziell unberücksichtigte Wahlzettel",
subtitle = "\nNationalratswahlen 「2015」") +
# ggtitle(expression(atop("Anteil unberücksichtigter Wahlzettel nach Kantonen", atop(italic("Nationalratswahlen 「2015」"), "")))) +
theme_map()
choropleth_plot_real
plot_ggiraph(choropleth_plot_real)
## biproportional nicht berücksichtigte Wahlzettel plotten mittels ggplot2
choropleth_plot_biprop <- ggplot(mapping = aes(data_id = Kanton,
tooltip = paste0("<span style=\"color: #ff4500;\"><strong>", Kanton, "</strong></span>",
"<br><br>Total Wahlzettel: <em>", total, "</em>",
"<br><br>Unberücksichtigte Wahlzettel",
"<br><span style=\"color: #ff4500;\">offiziell: </span><em>", real_nicht, "</em> bzw. <span style=\"color: #ff4500;\"><strong>", round((real_nicht / total) * 100, digits = 1), " %</strong></span>",
"<br><span style=\"color: #00e600;\">biproportional: </span><em>", biproportional_nicht, "</em> bzw. <span style=\"color: #00e600;\"><strong>", round((biproportional_nicht / total) * 100, digits = 1), " %</strong></span>",
"<br><br>Anzahl Sitze: ", colSums(data_mandates_2015[, Kanton])))) +
geom_map_interactive(data = subset(data_plot_switzerland, Kanton != "AR"),
map = subset(data_plot_switzerland, Kanton != "AR"),
mapping = aes(map_id = id,
x = long,
y = lat,
# group = group,
fill = (biproportional_nicht / total) * 100),
color = "#ffffff",
size = 0.3) +
# Workaround zur korrekten Darstellung (AR muss nach SG geplottet werden; offenbar, weil es (wie AI) komplett von SG umschlossen ist (aber vor AI geplottet wird?))
geom_map_interactive(data = subset(data_plot_switzerland, Kanton == "AR"),
map = subset(data_plot_switzerland, Kanton == "AR"),
mapping = aes(map_id = id,
x = long,
y = lat,
# group = group,
fill = (biproportional_nicht / total) * 100),
color = "#ffffff",
size = 0.3) +
# geom_text_interactive(data = data_voter_consideration_2015,
# mapping = aes(label = Kanton,
# x = Zentrum_Koordinate_x,
# y = Zentrum_Koordinate_y),
# size = 3) +
coord_map() +
# gleiche Skala sicherstellen
scale_fill_viridis(end = max(data_voter_consideration_2015$biproportional_nicht / data_voter_consideration_2015$total) /
max(data_voter_consideration_2015$real_nicht / data_voter_consideration_2015$total)) +
labs(x = "",
y = "",
fill = "biproportional unberücksichtigte \nWahlzettel in % ",
title = "Biproportional unberücksichtigte Wahlzettel",
subtitle = "\nNationalratswahlen 「2015」") +
# ggtitle(expression(atop("Anteil unberücksichtigter Wahlzettel nach Kantonen", atop(italic("Nationalratswahlen 「2015」"), "")))) +
theme_map()
choropleth_plot_biprop
plot_ggiraph(choropleth_plot_biprop)
# offiziell vs. biproportional gewählte KandidatInnen bestimmen
## offiziell Gewählte
data_elected_candidates_real_2015 <-
data_candidates_2015 %>%
filter(Gewählt == "G") %>%
select(Vorname, Name, Geburtsjahr, Partei, Kanton, Erhaltene_Stimmen)
### bereinigen
data_elected_candidates_real_2015$Name <- paste(data_elected_candidates_real_2015$Vorname, data_elected_candidates_real_2015$Name)
data_elected_candidates_real_2015$Vorname <- NULL
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Partei == "GPS"] <- "Grüne"
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Partei == "GLP"] <- "glp"
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Partei == "MCR"] <- "MCG"
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Partei == "PdA"] <- "AL | PdA | solidaritéS"
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Name == "Christoph Eymann"] <- "LDP"
data_elected_candidates_real_2015$Partei[data_elected_candidates_real_2015$Name == "Karl Vogler"] <- "CSP Obwalden"
## biproportional Gewählte
subapportionment_v3 <- apportionment_biprob_2015_v3$Subapportionment1$apportionment
data_elected_candidates_biprop_2015_raw <- data.frame()
### Listennummern der Listen mit einem Mandat je Kanton bestimmen und daraufhin KandidatInnen mit den meisten Stimmen je Listennummer-Konglomerat bestimmen
for ( canton in rownames(subapportionment_v3) ) {
elected_parties <- colnames(subapportionment_v3)[subapportionment_v3[canton, ] != 0]
for ( party in elected_parties ) {
mandate_list_numbers <- unique(data_tickets_2015$Listen_Nr_numerisch[data_tickets_2015$Kanton == canton & data_tickets_2015$Unterpartei_v3 == party])
possible_candidates <- arrange(subset(data_candidates_2015, Kanton == canton & Listen_Nr_numerisch %in% mandate_list_numbers), desc(Erhaltene_Stimmen))
possible_candidates$Partei <- party
nr_of_seats <- subapportionment_v3[canton, party]
data_elected_candidates_biprop_2015_raw <- rbind(data_elected_candidates_biprop_2015_raw, possible_candidates[1:nr_of_seats, ])
}
}
### bereinigen
data_elected_candidates_biprop_2015 <-
data_elected_candidates_biprop_2015_raw %>%
select(Vorname, Name, Geburtsjahr, Partei, Kanton, Erhaltene_Stimmen)
data_elected_candidates_biprop_2015$Name <- paste(data_elected_candidates_biprop_2015$Vorname, data_elected_candidates_biprop_2015$Name)
data_elected_candidates_biprop_2015$Vorname <- NULL
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Partei == "GPS"] <- "Grüne"
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Partei == "GLP"] <- "glp"
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Partei == "MCR"] <- "MCG"
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Partei == "PdA"] <- "AL | PdA | solidaritéS"
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Name == "Christoph Eymann"] <- "LDP"
data_elected_candidates_biprop_2015$Partei[data_elected_candidates_biprop_2015$Name == "Karl Vogler"] <- "CSP Obwalden"
## biproportional Abgewählte bestimmen
data_candidates_out <-
anti_join(data_elected_candidates_real_2015, data_elected_candidates_biprop_2015) %>%
arrange(Partei, Kanton, Name)
## biproportional neu Gewählte bestimmen
data_candidates_in <-
anti_join(data_elected_candidates_biprop_2015, data_elected_candidates_real_2015) %>%
arrange(Partei, Kanton, Name)
# interaktive HTML-Tabelle mit den Ab- und den neu Gewählten erstellen mittels DT
datatable(data_candidates_out,
autoHideNavigation = TRUE,
rownames = FALSE,
options = list(dom = "ftipr"))
datatable(data_candidates_in,
autoHideNavigation = TRUE,
rownames = FALSE,
options = list(dom = "ftipr"))
# Diverse Berechnungen
## Durchschnittsalter der Parlamentarier real vs. biproportional?
mean(rep(2016, 200) - data_elected_candidates_real_2015$Geburtsjahr)
mean(rep(2016, 200) - data_elected_candidates_biprop_2015$Geburtsjahr) # Differenz von 1 Jahr!
## der/die jüngste ParlamentarierIn?
2016 - max(data_elected_candidates_real_2015$Geburtsjahr)
2016 - max(data_elected_candidates_biprop_2015$Geburtsjahr)
## der/die älteste ParlamentarierIn?
2016 - min(data_elected_candidates_real_2015$Geburtsjahr)
2016 - min(data_elected_candidates_biprop_2015$Geburtsjahr) # genau gleich!
## Durchschnittsalter der 10 jüngsten ParlamentarierInnen?
mean(rep(2016, 10) - arrange(data_elected_candidates_real_2015, desc(Geburtsjahr))$Geburtsjahr[1:10])
mean(rep(2016, 10) - arrange(data_elected_candidates_biprop_2015, desc(Geburtsjahr))$Geburtsjahr[1:10]) # Differenz von über 5 Jahren!
## Differenz zwischen offizieller Anzahl gültig Stimmender und derjenigen beim Biprop-NZZ-Verfahren berechnen
(ballot_papers_2015$voters_participating - ballot_papers_2015$empty_ballot_papers - ballot_papers_2015$spoiled_ballot_papers) - sum(apportionment_biprob_2015_v3$Superapportionment$input$votes)
## Gesamtzahl nicht berücksichtigter Stimmen beim Biprop-NZZ-Verfahren berechnen (auf 2 verschiedene "Arten")
sum(apportionment_biprob_2015_v3$Superapportionment$input$votes[apportionment_biprob_2015_v3$Superapportionment$DivStdh200$apportionment == 0])
sum(data_voter_consideration_2015$biproportional_nicht)
## Gesamtzahl nicht berücksichtigter Stimmen beim offiziellen Wahlverfahren berechnen
sum(data_voter_consideration_2015$real_nicht) # mehr als das 3.5-fache als beim Doppelproporz (und dort konnten aufgrund von Mehrdeutigkeiten noch nicht einmal alle Listenverbindungen berücksichtigt werden; würden diese auch noch berücksichtigt, wäre es mehr als das 5.5-fache)
## Gesamtzahl hypothetisch nicht berücksichtigter Stimmen beim Biprop-NZZ-Verfahren berechnen, wenn alle mit Listenverbindung berücksichtigt würden
round(sum(data_tickets_2015$Erhaltene_Stimmen_NZZ[data_tickets_2015$Unterpartei_v3 %in% biprop_unconsidered_parties & data_tickets_2015$Listenverbindung == ""]))
## Gesamtzahl ungültiger Stimmen
ballot_papers_2015$spoiled_ballot_papers
## checken, obs gegenläufige Sitzverschiebungen auf 1. Ebene gab
### maximale Stimmenzahlen je Kanton bestimmen
data_votes_maxima <-
data_candidates_2015 %>%
group_by(Kanton) %>%
summarise(Stimmenmaximum = max(Erhaltene_Stimmen))
### die entsprechenden KandidatInnen eruieren
data_candidates_votes_maxima <- inner_join(data_candidates_2015,
data_votes_maxima,
by = c("Kanton" = "Kanton", "Erhaltene_Stimmen" = "Stimmenmaximum"))
### checken, ob alle 26 Bestplatzierten im Doppelproporz weiterhin gewählt würden
anti_join(data_candidates_votes_maxima, data_elected_candidates_biprop_2015) # jap!
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment