Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Tidytuesday
library(readr)
library(ggtext)
##Download files
migrazensus_v0_1 <-read_csv("/migrazensus_v0.1.csv",
col_types = cols(landid = col_number(),
bevoelkerung = col_number(), wahlberechtigte = col_number(),
wbmighintergrund_anteil = col_number(),
wbmighintergrund_absolut = col_number(),
mighintergrund_anteil = col_number(),
mighintergrund_absolut = col_number(),
wahlberechtigte_2017 = col_number(),
waehler = col_number(), gueltige_1 = col_number(),
gueltige_2 = col_number(), cdu_1 = col_number(),
cdu_2 = col_number(), spd_1 = col_number(),
spd_2 = col_number(), linke_1 = col_number(),
linke_2 = col_number(), gruene_1 = col_number(),
gruene_2 = col_number(), csu_1 = col_number(),
csu_2 = col_number(), fdp_1 = col_number(),
fdp_2 = col_number(), afd_1 = col_number(),
afd_2 = col_number(), gemeinden = col_number(),
flaeche = col_number(), bevoelkerung_strktr = col_number(),
bevoelkerung_deutsche = col_number(),
bevoelkerung_auslaender = col_number(),
bevdichte = col_number(), geburtensaldo = col_number(),
wanderungssaldo = col_number(), unter18 = col_number(),
v18b24 = col_number(), v25b34 = col_number(),
v35b59 = col_number(), v60b74 = col_number(),
ue75 = col_number(), boden_siedlung_verkehr = col_number(),
boden_vegetation_wasser = col_number(),
wohnungen_neu = col_number(), wohnungen_bestand = col_number(),
wohnflaeche_wohnung = col_number(),
wohnflaeche_einwohner = col_number(),
pkw = col_number(), pkw_elektro_hybrid = col_number()))
##load shapefile
library(rgdal)
wahlk<-read_sf(dsn="Geometrie_Wahlkreise_20DBT_geo.shp", options = "ENCODING=UTF-8")
##merge
names(wahlk)[2]<-"wkname_2021"
merge<-merge(wahlk,migrazensus_v0_1,by="wkname_2021")
merge$migant<-merge$wbmighintergrund_anteil*100
a<-merge %>%
select(wknr_2021, wkname_2021,wbmighintergrund_absolut, wahlberechtigte,mighintergrund_absolut,land,cdu_1, spd_1,gruene_1,fdp_1,linke_1,afd_1,csu_1)%>%
mutate( wbmighintergrund_absolut = round(wbmighintergrund_absolut),
wahlberechtigte = round(wahlberechtigte),
mighintergrund_absolut = round(mighintergrund_absolut),
potmig=wbmighintergrund_absolut/mighintergrund_absolut*100)
library(scales)
library(glue)
library(cowplot)
library(rnaturalearth)
library(extrafont)
loadfonts(device = "win")
##load map of Germany
worldmap <- ne_countries(scale = 'medium', type = 'map_units',
returnclass = 'sf')
germany <- worldmap[worldmap$name == 'Germany',]
##Prepare map for eligibility ratio description
df <- data.frame(
label = "The <span style = 'color:grey50'>**eligibility-ratio**</span> describes how\n
many people with migrant background are eligible to vote as\n
a % of the total migrant population")
##Create map
karte<-
a%>%
ggplot()+
geom_sf(germany,mapping=aes(size=0),size=1.5,col="grey50",show.legend = FALSE)+
geom_sf(aes(fill=ifelse(round(potmig) >=50, "grey50", "grey20")),color = "grey20")+
geom_textbox(data=df,aes(16,55,label=label, fill = "grey20"),color = "white",width = grid::unit(0.23, "npc"),hjust=0,vjust=1)+
annotate(geom = "segment", x = 7.5, xend=15,y=50, yend = 50,col="grey50",linetype="dashed")+
annotate(geom="label",x=14,y=50,label = "eligibility-ratio>60%", hjust = "left",fill="grey20",col="grey50")+
xlim(6, 25) + ylim(47, 55)+
scale_fill_identity()+
ggcharts::theme_hermit(ticks = "x", grid = "X") +
theme(text=element_text(size=10, family="Source Serif Pro ExtraLight"),
plot.title = ggtext::element_markdown(),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.text = element_text(color = "black"),
legend.title = element_text(colour="white", size=10,
face="bold"),
legend.key = element_rect(fill = "black"),
title = element_text(colour = "white"))
karte<-plot_grid(karte,legend1, rel_widths=c(0.4,0), rel_heights = c(1,1, 1,1,0.001),ncol=1)
##Create legend
rowid<-c(1,2,3,4,5,6)
values<-c(1,2,3,4,5,6)
df1<-rbind(rowid, values)%>%
as.data.frame()
df11<-t(df1)%>%
as.data.frame()
legend1<-
ggplot(df11, aes(x = rowid, y = values)) +
geom_tile(aes(width = rowid*0.75,height = rowid *0.75 , fill = as.factor(values))) +
coord_fixed() +
labs(title ="Darker spots on the map\n to your left correspond\nto higher number of votes")+
scale_fill_manual(values = c("#FFFFCC", "#ffff99", "#ffff66","#ffff33", "#ffcc33","#ffcc00")) +
annotate(geom = "segment", x = 1, xend=1,y=.7, yend = .3,col="grey50",linetype="dashed")+
annotate(geom = "segment", x = 2, xend=2 ,y=1.3, yend = .3,col="grey50",linetype="dashed")+
annotate(geom = "segment", x = 3, xend=3,y=1.9, yend = .3,col="grey50",linetype="dashed")+
annotate(geom = "segment", x = 4.5, xend=4.5,y=2.5, yend = 0.3,col="grey50",linetype="dashed")+
annotate(geom = "segment", x = 6, xend=6,y=3.1, yend = .3,col="grey50",linetype="dashed")+
annotate(geom = "segment", x = 7.1, xend=7.1,y=3.7, yend = 0.3,col="grey50",linetype="dashed")+
annotate(geom="text",x=1,y=.2,label = "0-20000\n", hjust = "left",col="grey50",
angle = 90)+
annotate(geom="text",x=2,y=.2,label = "20000-40000\n", hjust = "left",col="grey50",
angle = 90)+
annotate(geom="text",x=3,y=.2,label = "40000-60000\n", hjust = "left",col="grey50",
angle = 90)+
annotate(geom="text",x=4.5,y=.2,label = "60000-80000\n", hjust = "left",col="grey50",
angle = 90)+
annotate(geom="text",x=6,y=.2,label = "80000-100000\n", hjust = "left",col="grey50",
angle = 90)+
annotate(geom="text",x=7.1,y=.2,label = ">100000\n", hjust = "left",col="grey50",
angle = 90)+
theme_void() +
theme(legend.position = "none",
text=element_text(size=7, family="Source Serif Pro ExtraLight"),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.text = element_text(color = "black"),
legend.title = element_text(colour="white", size=10,
face="bold"),
legend.key = element_rect(fill = "black"),
title = element_text(colour = "grey80"),
plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
plot.margin = unit(c(0.5,0.6,.5,.6),"cm"))
##Assemble the second half of the plot together
karte<-plot_grid(karte,legend1, rel_widths=c(0.4,0), rel_heights = c(1,1, 1,1,0.001),ncol=1)
### Quick calculation of the current Eligibility ratio (37%).
sum(a$wbmighintergrund_absolut)/sum(a$mighintergrund_absolut)*100
##Erststimmen
##Find out which party had the highest share of first votes in 2017
a$maxparty<-pmax(a$cdu_1, a$spd_1,a$gruene_1,a$fdp_1,a$linke_1,a$afd_1,a$csu_1)
##Now we want to find the maximum number of votes a migrant party can obtain from all eligible voters with a migrant background.
##So: Number of eligible voters with a migrant background=maximum number of votes the migrant party can obtain from the community.
##Here, we assume all people with migrant background who are eligible to vote, cast their vote (no non-voters).
##If the number of votes obtained by the migrant party outnumbers the winning party in 2017, the migrant party wins the constituency.
a$direktmand<-ifelse(a$wbmighintergrund_absolut>a$maxparty,"win","lose")
##Create map
mapinplot<-
a%>%
ggplot()+
geom_sf(germany,mapping=aes(size=0),size=1.5,col="yellow",show.legend = FALSE)+
geom_sf(aes(fill=ifelse(wbmighintergrund_absolut >maxparty, "yellow", "grey20")),color = "grey20")+
scale_fill_identity()+
ggcharts::theme_hermit(ticks = "x", grid = "X") +
theme(text=element_text(size=10, family="Source Serif Pro ExtraLight"),
plot.title = ggtext::element_markdown(),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.text = element_blank(),
legend.title = element_blank(),
legend.key = element_blank(),
title = element_text(colour = "white"))
library(ggparliament)
migrazensus_v0_1$maxparty<-pmax(migrazensus_v0_1$cdu_1, migrazensus_v0_1$spd_1,migrazensus_v0_1$gruene_1,migrazensus_v0_1$fdp_1,migrazensus_v0_1$linke_1,migrazensus_v0_1$afd_1,migrazensus_v0_1$csu_1)
migrazensus_v0_1$direktmand<-ifelse(migrazensus_v0_1$wbmighintergrund_absolut>migrazensus_v0_1$maxparty,"win","lose")
##Distribution of the seats in the federal parliament
seat<-migrazensus_v0_1%>%
dplyr::group_by(direktmand)%>%
dplyr::summarise(freq=n())
rest<-c("rest",299)
seat<-rbind(rest,seat)
layout<-parliament_data(election_data = seat,
parl_rows = 10,
group = seat$direktmand,
type = "classroom",
party_seats = as.numeric(seat$freq))
bar<-migrazensus_v0_1%>%
dplyr::filter(direktmand!="lose")%>%
select(wbmighintergrund_absolut,wkname_2021)%>%
mutate(y=wbmighintergrund_absolut/100000)%>%
arrange(y)
#add coordinates
x<-c(60,60,60,60)
bar<-cbind(x,bar)
##Create parliament
bundest<-
ggplot() +
geom_parliament_seats(layout, mapping=aes(x, y, colour = direktmand),size = 3) +
labs(colour ="Direktmandat") +
theme_ggparliament(legend = TRUE) +
# geom_col(data=bar,aes(x,-y),fill="yellow",width = 0.02)+
scale_color_manual(values=c( '#CCFFFF', '#CCCCCC','yellow'))+
labs(title = "What if all eligible voters with migrant background\n voted for a migrant party MP?",
subtitle="Current eligibility ratio: 37%")+
annotate(geom = "text", x = 30, y = 12, label = "Second Vote\n299 seats", hjust = "left",col="#CCcccc")+
annotate(geom = "text", x =55, y = 14, label = "First Vote\n295 seats", hjust = "left",col="#CCffff")+
annotate(geom = "text", x =59, y = 14, label = "Migrant Party\n4 MPs", hjust = "left",col="yellow")+
annotate(geom = "text", x = -0.8,y = -9, label="")+
theme(text=element_text(size=10, family="Source Serif Pro ExtraLight"),
plot.title = element_text(hjust = 0.5),
plot.subtitle=element_text(hjust = 0.5),
# plot.title = ggtext::element_markdown(),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_blank(),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.position = "none",
title = element_text(colour = "white"))+
coord_polar(theta="x")
##Combine map and plot
gga<-ggdraw(bundest) +
draw_plot(mapinplot, .40, .36, .2, .2)
##Erststimme aller Personen mit Migrationshintergrund
##We now assume that every eligible and non-eligible person with a migrant background can vote
##So: All persons with a migrant background= maximum number of votes a migrant party can obtain from the community
migrazensus_v0_1$direktmandII<-ifelse(migrazensus_v0_1$mighintergrund_absolut>migrazensus_v0_1$maxparty,"win","lose")
a$direktmandwinlose<-ifelse(a$mighintergrund_absolut>a$maxparty,"win","lose")
a$direktmandII<-pmax(a$cdu_1, a$spd_1,a$gruene_1,a$fdp_1,a$linke_1,a$afd_1,a$csu_1,a$mighintergrund_absolut)
##Assign colors to the map
a<-a%>%mutate(direktmandcat = case_when(direktmandII >= 0 & direktmandII <= 20000 ~ '#ffffcc',
direktmandII > 20000 & direktmandII <= 40000 ~ '#ffff99',
direktmandII > 40000 & direktmandII <= 60000 ~ '#ffff66',
direktmandII > 60000 & direktmandII <= 80000 ~ '#ffff33',
direktmandII > 80000 & direktmandII <= 100000 ~ '#ffcc33',
direktmandII > 100000 ~ '#ffcc00'))
##Create parliament
mapinplotII<-
a%>%
ggplot()+
geom_sf(germany,mapping=aes(size=0),size=1.5,col="yellow",show.legend = FALSE)+
geom_sf(aes(fill=ifelse(mighintergrund_absolut >maxparty, direktmandcat, "grey20")),color="grey20")+
scale_fill_identity()+
ggcharts::theme_hermit(ticks = "x", grid = "X") +
theme(text=element_text(size=10, family="Source Serif Pro ExtraLight"),
plot.title = ggtext::element_markdown(),
axis.title.y = element_text(color = "white"),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.text = element_blank(),
legend.title = element_blank(),
legend.key = element_blank(),
legend.position = "None",
title = element_text(colour = "white"))
#Find out where the 150 MPs are coming from -> just fyi
mps<-migrazensus_v0_1%>%
dplyr::group_by(direktmandII,land)%>%
dplyr::summarise(freq=n())%>%
dplyr::filter(direktmandII!="lose")
seatII<-migrazensus_v0_1%>%
dplyr::group_by(direktmandII)%>%
dplyr::summarise(freq=n())
seatII<-rbind(rest,seatII)
layoutII<-parliament_data(election_data = seatII,
parl_rows = 10,
type = 'classroom',
party_seats = as.numeric(seatII$freq))
##Prepare pointrange. Each line will be attached to a yellow point representing a seat won by the migrant party.
##The length of the line corresponds to the maximum number of votes obtained by the migrant party
xycoord<-layoutII%>%
filter(!direktmandII=="lose")%>%
filter(!direktmandII=="rest")%>%
select(x,y)%>%
arrange(x)
barII<-migrazensus_v0_1%>%
dplyr::filter(direktmandII!="lose")%>%
select(mighintergrund_absolut,wkname_2021)%>%
mutate(migrpart=mighintergrund_absolut/100000)%>%
arrange(mighintergrund_absolut)
barII<-cbind(barII,xycoord)
##Create parliament
bundestII<-
ggplot() +
geom_parliament_seats(layoutII, mapping=aes(x, y, colour = direktmandII),size = 3) +
labs(colour ="Direktmandat") +
theme_ggparliament(legend = TRUE) +
scale_color_manual(values=c( '#CCFFFF', '#CCCCCC','yellow'))+
geom_pointrange(barII,mapping=aes(x,y,ymin=y,ymax=y-migrpart),col="yellow")+
labs(title ="What if eligible and non-eligible voters with migrant background\n voted for a migrant party MP?",
subtitle = "In other words: what if the eligibility ratio = 100%?")+
annotate(geom = "text", x =59, y = 14, label = "Migrant Party\n150 MPs", hjust = "left",col="yellow")+
annotate(geom = "text", x = -0.8,y = -8, label="")+
theme(text=element_text(size=10, family="Source Serif Pro ExtraLight"),
plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
# plot.title = ggtext::element_markdown(),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_blank(),
panel.grid.minor = element_blank(),
strip.background =element_rect(fill="grey20"),
strip.text = element_text(colour = 'black'),
panel.background = element_rect(fill = "grey20", color = NA),
plot.background = element_rect(fill = "grey20", color = NA),
panel.grid.major = element_blank(),
legend.position = "none",
title = element_text(colour = "white"))+
coord_polar(theta="x")
##Assemble the first part of the plot
ggb<-ggdraw(bundestII) +
draw_plot(mapinplotII,scale=1 ,.4, .35, .2, .1859)
##Assemble everything together
library(ggpubr)
figure2<-ggarrange(gga,ggb,ncol=1,nrow=2)
figure3<-ggarrange(figure2,karte,ncol=2,nrow = 1)
figure4<-annotate_figure(figure3, top = text_grob("How voters with a migrant background can be a determining factor in\n German federal elections\n",
color = "grey80", face = "bold", size = 14,family = "Source Serif Pro ExtraLight"))
cowplot::ggdraw(figure4) +
theme(plot.background = element_rect(fill="grey20", color = NA))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment