Skip to content

Instantly share code, notes, and snippets.

@mschnetzer
Last active April 9, 2020 12:21
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mschnetzer/c839f9fc49fd692416c2c3b63987ddce to your computer and use it in GitHub Desktop.
Save mschnetzer/c839f9fc49fd692416c2c3b63987ddce to your computer and use it in GitHub Desktop.
Wenn Deutschland so verteilt wäre wie Vermögen (https://twitter.com/matschnetzer/status/1178930993186693121)
library(tidyverse)
library(msthemes)
library(sf)
# GeoJSON: http://opendatalab.de/projects/geojson-utilities/
geodat <- st_read("landkreise_simplify200.geojson", quiet=TRUE, stringsAsFactors=FALSE) %>%
mutate(
center = map(geometry, st_centroid),
centercoord = map(center, st_coordinates),
ccordx = map_dbl(centercoord, 1),
ccordy = map_dbl(centercoord, 2)
)
geodat$area <- st_area(geodat)
total <- sum(geodat$area)
# Vermögensdaten: https://www.diw.de/documents/publikationen/73/diw_01.c.575768.de/dp1717.pdf
arbreaks <- total*c(0, 0.331, 0.638, 0.977, 1)
ardf <- geodat %>% arrange(desc(ccordy)) %>%
mutate(csarea = cumsum(area)) %>%
mutate(gruppe = cut(csarea, breaks=arbreaks))
ardf %>% ggplot() +
geom_sf(aes(fill=gruppe),color="black",size=0.07) +
coord_sf(datum=NA) +
expand_limits(x=c(1,20)) +
annotate("text",label="Dem Top 1% würde etwa\n ein Drittel der Fläche gehören", size=2.5, family="IBMPlexSans", hjust=0.5, x=3.5, y=54.5) +
annotate("text",label="Die reichsten 2-10% würden auch\n fast ein Drittel der Fläche besitzen", size=2.5, family="IBMPlexSans", hjust=0.5, x=17, y=50) +
annotate("text",label="Die nächsten 40% hätten\n ein weiteres Drittel der Fläche", size=2.5, family="IBMPlexSans", hjust=0.5, x=4.5, y=48.5) +
annotate("text",label="Die ärmere Hälfte der Bevölkerung\n teilt sich nur 2,3% der Fläche", size=2.5, family="IBMPlexSans", hjust=0.5, x=17, y=47.5) +
geom_curve(aes(x=3,xend=7,y=54.1,yend=53.1), curvature = 0.1, ncp=8, size=0.1, arrow=arrow(length=unit(0.01, "npc"), type="closed")) +
geom_curve(aes(x=17.3,xend=15,y=50.4,yend=50.9), curvature = 0.1, ncp=8, size=0.1, arrow=arrow(length=unit(0.01, "npc"), type="closed")) +
geom_curve(aes(x=4,xend=6,y=48.9,yend=49.5), curvature = -0.1, ncp=8, size=0.1, arrow=arrow(length=unit(0.01, "npc"), type="closed")) +
geom_curve(aes(x=14.5,xend=12,y=47.3,yend=47.5), curvature = -0.1, ncp=8, size=0.1, arrow=arrow(length=unit(0.01, "npc"), type="closed")) +
scale_fill_manual(values = msc_palette,
labels = c("Top 1%","Reichste 2-10%","Nächste 40%","Ärmere 50%")) +
theme_ms() +
labs(title="Wenn Deutschland so verteilt wäre wie Vermögen...",
caption = "Quelle: HFCS 2014; Bach/Thiemann/Zucco 2018. Grafik: @matschnetzer",
x="",y="") +
theme(legend.title = element_blank(),
legend.position = "top",
legend.key.size = unit(0.3 , "cm"),
plot.title = element_text(margin = margin(b=0.3,unit="cm"))) +
ggsave("areager.png", dpi=1200, unit="in", width=6, height=5.5)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment