knitr::opts_chunk$set( error = FALSE, message = FALSE, warning = FALSE, collapse = TRUE, tidy = 'styler', fig.asp = 0.6, fig.width = 8, out.width = '100%', comment = "#>" )
Für die folgenden Analysen werden zwei R Pakete benötigt:
library(lisr) library(tidyverse)
data <- map_df(2014:2023, get_lis_babynames)
colnames(data)
# top.10_boys <- data %>% # filter(GESCHLECHT == 'm') %>% # group_by(YEAR) %>% # slice_max(n = 10, order_by = ANZAHL) %>% # ungroup() %>% # pull(VORNAME) %>% # unique() # # top.10_girls <- data %>% # filter(GESCHLECHT == 'w') %>% # group_by(YEAR) %>% # slice_max(n = 10, order_by = ANZAHL) %>% # ungroup() %>% # pull(VORNAME) %>% # unique() 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)
#| fig.asp = 1.5 ggplot(df.top.10_boys, aes(x = YEAR, y = RANK, colour = as.character(YEAR))) + coord_flip() + scale_y_continuous(breaks = seq(1, 10, 1), sec.axis = dup_axis()) + scale_x_reverse(breaks = rev(seq(2014, 2023, 1))) + # geom_line(aes(group = VORNAME), linetype = 3) + geom_text(aes(label = VORNAME), fill = "#1e1e1e", 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, 2023.1)) + labs(title = 'Most popular male babynames', subtitle = 'Leipzig, Germany')
#| fig.asp = 1.5 ggplot(df.top.10_girls, aes(x = YEAR, y = RANK, colour = as.character(YEAR))) + coord_flip() + scale_y_continuous(breaks = seq(1, 10, 1), sec.axis = dup_axis()) + scale_x_reverse(breaks = rev(seq(2014, 2023, 1))) + # geom_line(aes(group = VORNAME), linetype = 3) + geom_text(aes(label = VORNAME), fill = "#1e1e1e", 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, 2023.1)) + labs(title = 'Most popular female babynames', subtitle = 'Leipzig, Germany')
library(DT) tab <- data %>% filter(YEAR == 2023) %>% mutate(GESCHLECHT = ifelse(GESCHLECHT == 'w', 'female', 'male'), GESCHLECHT = factor(GESCHLECHT, levels = c('female', 'male')), YEAR = as.factor(YEAR)) %>% select(Year = YEAR, Geschlecht = GESCHLECHT, Name = VORNAME, Number = ANZAHL) %>% arrange(Year) datatable(tab, rownames = FALSE, options = list( autoWidth = TRUE, columnDefs = list(list(className = 'dt-center', width = '200px', targets = "_all")) ), colnames = c('Year', 'Sex', 'Name', 'Number'), filter = 'top')
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.