Statistik in Leipzig: Hexagonaler Stadtplan

Als ich vor einigen Jahren zum ersten Mal eine Tile Grid Map der USA sah, kam bei mir die Idee auf, eine solche im Deutschen als “Kachelkarte” oder “hexagonaler Karte” bezeichnete Karte für meine Heimatstadt Leipzig zu programmieren. Vor einigen Tagen habe ich mit dem R-Paket {tilemaps} eine Möglichkeit entdeckt, die insgesamt 63 Leipziger Ortsteile als Hexagone darzustellen. Die 63 Ortsteile verteilen sich auf 10 Stadtbezirke, welche in der nachfolgenden Karte farblich markiert sind.

Hexagonaler Stadtplan der Stadt Leipzig

Hexagonaler Stadtplan der Stadt Leipzig

“Kachelkarten” lassen sich u.a. für die Visualisierung statistischer Angaben verwenden. Die folgende Abbildung zeigt die Verteilung von Straftaten (ingesamt) auf die einzelnen Ortsteile (absolute Zahlen) aus dem Jahr 2023. Die Daten habe ich mit dem von mir entwickelten R-Paket {lisr} aus dem “Leipzig Informations-System” importiert.

Leipzig: Anzahl Straftaten im Jahr 2023

Leipzig: Anzahl Straftaten im Jahr 2023

ANHANG: R-Code

Im Anhang dokumentiere ich den R-Code, mit dem die Daten importiert, umgeformt und visualisiert wurden.

knitr::opts_chunk$set(echo = FALSE,
                      message = FALSE,
                      warning = FALSE
                      )

# remotes::install_github("nrkoehler/lisr")
library(lisr)
library(tilemaps)
library(sf)
library(ggfittext)
library(tidyverse)


colsbz <- c(
  "gold", # Nordwest
  "#fe8f24", # Nord
  "#ffc126", # Nordost
  "steelblue1", # Altwest
  "#4481fd", # West
  "#f6dcb4", # Zentrum
  "#dcafa9", # Ost
  "seagreen3", # Suedwest
  "yellowgreen", # Sued
  "limegreen" # Suedost
)

df.OT <- get_lis_shapefile(shape = "Ortsteile")

df.CRIME <- get_lis_kd(kategorie_nr = 12) %>% 
  filter(SACHMERKMAL == "Straftaten insgesamt") %>% 
  select(Name = GEBIET, '2023') %>% 
  rename(Crime_Total = 2)

df.OT <- df.OT %>% 
  inner_join(df.CRIME, by = "Name")

set.seed(2011) #2022, 2017, 2011
data <- df.OT %>%
  mutate(NR = as.numeric(str_sub(OT, 1, 1)),
         BZ = factor(NR, levels = c(8, 9, 1, 7, 6, 0, 2, 5, 4, 3),
                     labels = c("Nordwest ", "Nord", "Nordost" , "Alt-West", "West", "Mitte", "Ost", "S\u00fcdwest ", 'S\u00fcd', "S\u00fcdost")
         )) %>% 
  mutate(tile_map = generate_map(geometry, square = FALSE, flat_topped = FALSE, prop = 0.2,
                                 interpolate = 0))

df.cent <- st_boundary(data$tile_map) %>% 
  st_coordinates() %>% 
  as_tibble() %>% 
  group_by(Name = L1) %>% 
  mutate(
    XMIN = min(X),
    XMAX = max(X),
    YMIN = min(Y),
    YMAX = max(Y)
  ) %>% 
  distinct(Name, XMIN, XMAX, YMIN, YMAX) %>% 
  ungroup() %>% 
  mutate(Name = str_replace(df.OT$Name, "-", "-\n"))

ggplot(data) +
  geom_sf(aes(geometry = tile_map, fill = BZ), alpha = 1, color = "white", linewidth = 0.4) +
  geom_fit_text(data = df.cent, aes(xmin = XMIN, xmax = XMAX, ymin = YMIN, ymax = YMAX, label = Name), reflow = F) +
  scale_fill_manual(values = colsbz) +
  theme_void() +
  theme(plot.title = element_text(color="white", face = "bold",
                                  hjust = 0.05, vjust=-2),
        plot.subtitle = element_text(color="grey", hjust = 0.06, vjust=-4),
        plot.caption = element_text(color="grey", vjust = 7, hjust = 0.98),
        legend.position = "bottom",
        legend.byrow = TRUE,
        legend.text=element_text(color="white"),
        plot.background = element_rect(fill="black", colour = "white")) +
  labs(fill = NULL, 
       title = "Stadt Leipzig",
       subtitle = "Stadtbezirke (10) und Ortsteile (63)",
       caption = "Quelle: LIS"
  )



ggplot(data) +
  geom_sf(aes(geometry = tile_map, fill = Crime_Total), alpha = 1, color = "grey", linewidth = 0.4) +
  geom_fit_text(data = df.cent, aes(xmin = XMIN, xmax = XMAX, ymin = YMIN, ymax = YMAX, label = Name), reflow = F) +
  scale_fill_gradient(low="white", high="red2") +
  theme_void() +
  theme(plot.title = element_text(color="black", face = "bold",
                                  hjust = 0.05, vjust=-2),
        plot.subtitle = element_text(hjust = 0.06, vjust=-4),
        plot.caption = element_text(vjust = 7, hjust = 0.98),
        legend.position = "top",
        legend.byrow = TRUE) +
  labs(fill = "Anzahl Straftaten im Jahr 2023", 
       title = "Stadt Leipzig",
       caption = "Quelle: LIS"
  )

Statistik in Leipzig: Geburten und Einwohner

In meiner zweiten Blogpost zum Themengebiet “Statistik in Leipzig” beschäftige ich mich mit der Bevölkerungsentwicklung in Leipzig. Im Besonderen geht es um die Anzahl der Geburten und die Geburtenrate für den Zeitraum 2000 bis 2025. Die Daten habe ich mit dem R-Paket {lisr} aus dem “Leipzig-Informationssystem” (LIS) abgefragt.

Abbildung 1 zeigt, dass die Anzahl der Einwohner in den Jahren 2000 bis 2025 stetig gestiegen ist. Lebten im Jahr 2000 noch 479,996 Menschen in der Stadt an der Pleiße, so waren es im Jahr 2025 633,592. Dies Entspricht einem Zugewinn von 153,596 Einwohnern. Im gesamten Zeitraum überstieg die Anzahl der Frauen die Anzahl der Männer, wobei sich beide Zahlen tendenziell annäherten.

plot of chunk population-vis

Die Anzahl der Geburten stieg von 2001 (3,773 Neugeborene) bis 2016 (6,982 Neugeborene) kontinuierlich an. Seitdem ist die Anzahl der Geburten rückläufig, wobei der Rückgang in den Jahren 2022 und 2023 besonders stark war. Im Jahr 2024 wurden in Leipzig nur noch 4,811 Kinder geboren. Ingesamt wurden im Zeitraum der Jahre 2001 bis 2024 in Leipzig 63,098 Mädchen und 66,780 Jungen geboren.

plot of chunk births-vis

Die Geburtenrate gibt an, wie viele Kinder in einem bestimmten Zeitraum (z.B. Jahr) pro 1.000 Einwohner geboren wurden. Sie kann mit der folgenden Formel berechnet werden:

Anzahl Neugeborene / Anzahl Einwohner * 1.000

Im Zeitraum der Jahre 2001 bis 2024 lag die durchschnittliche Geburtenrate in Leipzig bei etwa 10 Neugeborenen pro 1.000 Einwohner. Während die Geburtenrate von 2001 bis 2016 fast kontinuierlich anstieg, ist seitdem ein stetiger Rückgang zu verzeichnen, der nach Beginn der COVID-19-Pandemie besonders stark ausgeprägt war.

plot of chunk birthrate-vis

ANHANG: R-Code

Im Anhang dokumentiere ich den R-Code, mit dem die Daten importiert, umgeformt und visualisiert wurden.

knitr::opts_chunk$set(echo = FALSE)

# remotes::install_github('nrkoehler/lisr')
library(lisr)
library(scales)
library(htmlTable)
library(geomtextpath)
library(tidyverse)

# import birth data
data.birth <- get_lis_move(rubrik_nr = 1, periode = "y")

# import population data

data.pop <- get_lis_pop(rubrik_nr = 1, periode = "y")


dfr.pop <- data.pop %>%
    slice(1:3) %>%
    select(KENNZIFFER, starts_with("20")) %>%
    mutate(KENNZIFFER = case_when(str_detect(KENNZIFFER, "^B") ~ "Total", str_detect(KENNZIFFER, "^M") ~ "Male", str_detect(KENNZIFFER, "^F") ~ "Female")) %>%
    pivot_longer(cols = starts_with("20"), values_to = "Number", values_transform = list(Number = as.integer), names_to = "Year") %>%
    mutate(KENNZIFFER = factor(KENNZIFFER, levels = c("Total", "Male", "Female")))


lst.pop <- tibble::lst(nmb.2000 = dfr.pop %>%
    filter(Year == "2000", KENNZIFFER == "Total") %>%
    pull(Number), nmb.2025 = dfr.pop %>%
    filter(Year == "2025", KENNZIFFER == "Total") %>%
    pull(Number), nmb.plus = nmb.2025 - nmb.2000)


ggplot(dfr.pop, aes(x = Year, y = Number, colour = KENNZIFFER)) + geom_point() + geom_line(aes(group = KENNZIFFER)) + scale_color_manual(values = c("black",
    "#1B5583", "#FA9BCB")) + scale_y_continuous(labels = comma, breaks = seq(0, 7e+05, 50000)) + theme_bw() + theme(legend.position = "bottom", axis.text.x = element_text(angle = 45,
    vjust = 0.5, hjust = 1), strip.text = element_text(colour = "white", face = "bold", size = 12), strip.background = element_rect(fill = "#4c4a4a")) + labs(x = NULL,
    y = NULL, colour = NULL, subtitle = "Abb. 1: Number of inhabitants in Leipzig, 2000-2025")


dfr.birth <- data.birth %>%
    filter(MERKMAL_1 == "Lebendgeborene") %>%
    select(KENNZIFFER, starts_with("20")) %>%
    mutate(KENNZIFFER = case_when(str_detect(KENNZIFFER, "^I") ~ "Total", str_detect(KENNZIFFER, "^M") ~ "Male", str_detect(KENNZIFFER, "^F") ~ "Female")) %>%
    pivot_longer(cols = starts_with("20"), values_to = "Number", names_to = "Year") %>%
    mutate(KENNZIFFER = factor(KENNZIFFER, levels = c("Total", "Male", "Female")))

dfr.birth.sum <- dfr.birth %>%
    group_by(KENNZIFFER) %>%
    summarise(BIRTH = sum(Number))


lst.birth <- tibble::lst(nmb.2001 = dfr.birth %>%
    filter(Year == "2001", KENNZIFFER == "Total") %>%
    pull(Number), nmb.2024 = dfr.birth %>%
    filter(Year == "2024", KENNZIFFER == "Total") %>%
    pull(Number), nmb.max = dfr.birth %>%
    filter(KENNZIFFER == "Total") %>%
    pull(Number) %>%
    max(), yr.max = dfr.birth %>%
    filter(KENNZIFFER == "Total", Number == max(Number)) %>%
    pull(Year), nmb.min = dfr.birth %>%
    filter(KENNZIFFER == "Total") %>%
    pull(Number) %>%
    min(), yr.min = dfr.birth %>%
    filter(KENNZIFFER == "Total") %>%
    filter(Number == min(Number)) %>%
    pull(Year), nmb.total = dfr.birth.sum[1, 2] %>%
    as.numeric(), nmb.boys = dfr.birth.sum[2, 2] %>%
    as.numeric(), nmb.girls = dfr.birth.sum[3, 2] %>%
    as.numeric(), nmb.diff = nmb.boys - nmb.girls)


ggplot(dfr.birth, aes(x = Year, y = Number, colour = KENNZIFFER)) + geom_point() + geom_line(aes(group = KENNZIFFER)) + scale_color_manual(values = c("black",
    "#1B5583", "#FA9BCB")) + theme_bw() + theme(legend.position = "bottom", axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1), strip.text = element_text(colour = "white",
    face = "bold", size = 12), strip.background = element_rect(fill = "#4c4a4a")) + labs(x = NULL, y = NULL, colour = NULL, subtitle = "Abb. 2: Number of births in Leipzig, 2001-2024")



dfr.birthrate <- dfr.birth %>%
    filter(KENNZIFFER == "Total") %>%
    rename(nmb_birth = Number) %>%
    left_join(dfr.pop, by = c("KENNZIFFER", "Year")) %>%
    rename(nmb_pop = Number) %>%
    mutate(Birthrate = nmb_birth/nmb_pop * 1000)

lst.br <- tibble::lst(br.mean = sum(dfr.birthrate$nmb_birth)/sum(dfr.birthrate$nmb_pop) * 1000)



ggplot(dfr.birthrate, aes(x = Year, y = Birthrate)) + geom_point() + geom_line(aes(group = 1), colour = "red3") + geom_texthline(yintercept = lst.br$br.mean,
    label = "Mean birthrate", colour = "#4c4a4a") + scale_y_continuous(limits = c(4, 16), breaks = seq(0, 20, 2)) + theme_bw() + theme(legend.position = "bottom",
    axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1), strip.text = element_text(colour = "white", face = "bold", size = 12), strip.background = element_rect(fill = "#4c4a4a")) +
    labs(x = NULL, y = "birthrate", subtitle = "Abb. 3: Birthrate in Leipzig, 2001 - 2024")

Statistik in Leipzig: Vornamen 2014 – 2025

Das Amt für Statistik und Wahlen der Stadt Leipzig stellt auf seinen Internetseiten zahlreiche Statistiken zu verschiedenen Aspekten der städtischen Entwicklung zur Verfügung. Mit dem “Leipzig-Informationssystem” (LIS) ist zudem eine Vielzahl interessanter Daten über eine Schnittstelle (API) programmatisch erreichbar. Mit Hilfe meines R-Pakets {lisr} lassen sich die im LIS erhältlichen Daten bequem in das Statistikprogramm R importieren. In diesem Beitrag stelle ich die Leipziger Vornahmensstatistik der Jahre 2014 bis 2025 vor. In dieser Statistik werden die Vornamen aller in den entsprechenden Jahren in Leipzig geboren Kinder erfasst.

Im Folgenden visualisiere ich die Daten als Tabelle, Balkendiagramm und als Poster.

Gesamtstatistik

Ich beginne mit einer Tabelle, in welcher die 20 beliebtesten Babynames in Leipzig im Zeitraum 2014 bis 2025 unterteilt nach Geschlecht dargestellt werden. Die drei beliebtesten Mädchennamen waren Emma, Charlotte und Emilia und die drei beliebtesten Jungennamen waren Emil, Oskar und Paul.

Die 20 beliebtesten Maedchen- und Jungennamen, Leipzig, 2014-2025
Rank Girls Number Boys Number
1 Emma 588 Emil 649
2 Charlotte 488 Oskar 548
3 Emilia 478 Paul 527
4 Mia 457 Noah 491
5 Johanna 428 Karl 488
6 Clara 419 Ben 482
7 Ella 386 Anton 476
8 Hannah 357 Theo 439
9 Anna 349 Elias 385
10 Mila 346 Leon 374
11 Lina 309 Felix 368
12 Lea 303 Moritz 367
13 Ida 302 Jonas 367
14 Frieda 302 Theodor 362
15 Mathilda 296 Arthur 357
16 Hanna 293 Finn 333
17 Marie 279 Luca 317
18 Lena 277 Jakob 315
19 Sophia 272 Bruno 294
20 Leni 269 Maximilian 290

Namen neugeborener Mädchen

Die folgenden Balkendiagramme zeigen die Anzahl der Namen neugeborener Mädchen unterteilt nach Geburtsjahr.

Namen neugeborener Mädchen in Leipzig

Namen neugeborener Mädchen in Leipzig

Bei genauerer Betrachtung der Balendiagramme ist zu erkennen, dass in jedem Jahr mindestens zwei Vornamen mit derselben Häufigkeit vergeben wurden. Auf dem folgenden Poster werden diese Namen untereinander dargestellt (z.B. Clara und Lea im Jahr 2014).

Namen neugeborener Mädchen in Leipzig

Namen neugeborener Mädchen in Leipzig

Namen neugeborener Jungen

Die Namen neugeborener Jungen habe ich analog zu den Mädchennamen dargestellt.

Namen neugeborener Jungen in Leipzig

Namen neugeborener Jungen in Leipzig

Namen neugeborener Jungen in Leipzig

Namen neugeborener Jungen in Leipzig

Die Balkendiagramme deuten an, dass die Anzahl der Geburten in den letzten Jahren rückläufig war. Die Leipziger Geburtenstatistik werde ich in meinem nächsten Blog-Beitrag darstellen.

ANHANG: R-Code

Im Anhang dokumentiere ich den R-Code, mit dem die Daten importiert, umgeformt und visualisiert wurden. Die Tabelle wurde mit dem {huxtable}-Paket erzeugt, andere Pakete ({kableExtra}, {flextable}, {tinytable}) scheinen mit WordPress nicht zu funktionieren.

knitr::opts_chunk$set(echo = FALSE, cache = FALSE)

# remotes::install_github("nrkoehler/lisr")
library(lisr)
library(huxtable)
library(tidyverse)
library(tidytext)

data <- map_df(2014:2025, get_lis_babynames) 

df.top.10_boys <- data %>%
  filter(GESCHLECHT == 'm') %>%
  select(-GESCHLECHT) %>% 
  group_by(YEAR) %>% 
  mutate(RANK = rank(-ANZAHL, ties.method = "min")) %>% 
  ungroup() %>% 
  filter(RANK <= 10) %>% 
  arrange(YEAR, RANK) %>% 
  group_by(YEAR, RANK) %>% 
  nest() %>% 
  mutate(VORNAME = map_chr(data, ~toString(.x$VORNAME)),
         VORNAME = str_replace_all(VORNAME, ",", "\n"),
         ANZAHL = map_int(data, ~max(.x$ANZAHL))) %>% 
  select(VORNAME, YEAR, ANZAHL, RANK)

df.top.10_girls <- data %>%
  filter(GESCHLECHT == 'w') %>%
  select(-GESCHLECHT) %>% 
  group_by(YEAR) %>% 
  mutate(RANK = rank(-ANZAHL, ties.method = "min")) %>% 
  ungroup() %>% 
  filter(RANK <= 10) %>% 
  arrange(YEAR, RANK) %>% 
  group_by(YEAR, RANK) %>% 
  nest() %>% 
  mutate(VORNAME = map_chr(data, ~toString(.x$VORNAME)),
         VORNAME = str_replace_all(VORNAME, ",", "\n"),
         ANZAHL = map_int(data, ~max(.x$ANZAHL))) %>% 
  select(VORNAME, YEAR, ANZAHL, RANK)
df.girls <- data %>%
  filter(GESCHLECHT == "w") %>%
  select(-GESCHLECHT) %>%
  summarise(.by = c(VORNAME), NMB = sum(ANZAHL)) %>%
  top_n(20) %>%
  arrange(desc(NMB))

df.boys <- data %>%
  filter(GESCHLECHT == "m") %>%
  select(-GESCHLECHT) %>%
  summarise(.by = c(VORNAME), NMB = sum(ANZAHL)) %>%
  top_n(20) %>%
  arrange(desc(NMB))

df.total <- bind_cols(tibble(A = 1:20), df.girls, df.boys) %>% 
  set_names(., c("Rank", "Girls", "Number", "Boys", "Number"))


df.total %>% 
  as_huxtable() %>% 
  set_width(1) %>% 
  set_bold(row = 1, col = everywhere) %>% 
  set_align("centre") %>% 
  set_caption("Die 20 beliebtesten Maedchen- und Jungennamen, Leipzig, 2014-2025") %>% 
  huxtable::theme_grey()

# datatable(df.total, 
#           filter = 'none',
#           autoHideNavigation = TRUE,
#           options = list(pageLength = 20),
#           colnames = c("Girls", "Number", "Boys", "Number"),
#           caption = "Die 20 beliebtesten Maedchen- und Jungennamen, Leipzig, 2014-2025"
#           )



data %>%
  filter(GESCHLECHT == 'w') %>%
  select(-GESCHLECHT) %>% 
  summarise(.by = c(VORNAME, YEAR), NMB = sum(ANZAHL)) %>% 
  group_by(YEAR) %>% 
  top_n(10) %>% 
  arrange(NMB) %>% 
  ungroup() %>% 
  ggplot(., aes(x = reorder_within(VORNAME, NMB, YEAR), y = NMB)) +
  coord_flip() +
  geom_col(fill = "#FA9BCB", width = 0.8, colour = 'white') +
  scale_fill_distiller(palette = 3) +
  geom_text(aes(label = NMB), color = 'black', hjust = -0.6, size = 2) +
  scale_x_reordered() +
  facet_wrap(~YEAR, ncol = 2, scales = "free_y") +
  labs(x = NULL, y = NULL, fill = NULL) +
  tidyquant::theme_tq() +
  theme(legend.position = 'none') 
  

ggplot(df.top.10_girls,
       aes(x = YEAR, y = RANK, colour = as.character(YEAR))) +
  coord_flip() +
  scale_y_continuous(breaks = seq(1, 12, 1), sec.axis = dup_axis()) +
  scale_x_reverse(breaks = rev(seq(2014, 2025, 1))) +
  geom_text(aes(label = VORNAME), hjust = 'center') +
  hrbrthemes::theme_modern_rc() +
  theme(legend.position = 'none',
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
  expand_limits(x = c(2013.8, 2025.1)) +
    labs(title = 'Most popular female babynames',
       subtitle = 'Leipzig, Germany')

data %>%
  filter(GESCHLECHT == 'm') %>%
  select(-GESCHLECHT) %>% 
  summarise(.by = c(VORNAME, YEAR), NMB = sum(ANZAHL)) %>% 
  group_by(YEAR) %>% 
  top_n(10) %>% 
  arrange(NMB) %>% 
  ungroup() %>% 
  ggplot(., aes(x = reorder_within(VORNAME, NMB, YEAR), y = NMB)) +
  coord_flip() +
  geom_col(fill = "#1B5583", width = 0.8, colour = 'white') +
  geom_text(aes(label = NMB), color = 'black', hjust = -0.6, size = 2) +
  scale_x_reordered() +
  facet_wrap(~YEAR, ncol = 2, scales = "free_y") +
  labs(x = NULL, y = NULL, fill = NULL) +
  tidyquant::theme_tq() +
  theme(legend.position = 'none') 
  
ggplot(df.top.10_boys,
       aes(x = YEAR, y = RANK, colour = as.character(YEAR))) +
  coord_flip() +
  scale_y_continuous(breaks = seq(1, 12, 1), sec.axis = dup_axis()) +
  scale_x_reverse(breaks = rev(seq(2014, 2025, 1))) +
  geom_text(aes(label = VORNAME), hjust = 'center') +
  hrbrthemes::theme_modern_rc() +
  theme(legend.position = 'none',
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
  expand_limits(x = c(2013.8, 2025.1)) +
  labs(title = 'Most popular male babynames',
       subtitle = 'Leipzig, Germany')
Design a site like this with WordPress.com
Get started