-
-
Save anneumann1/ac439481c6e1b01a72d4954f337cd6ec to your computer and use it in GitHub Desktop.
Tidytuesday
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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