Inspired by https://www.behance.net/gallery/23151677/Data-Visualization-on-Inequality-of-Society

Data source https://www.bfs.admin.ch/bfs/de/home/statistiken/kataloge-datenbanken/tabellen.assetdetail.3742124.html

library(tidyverse)
library(readxl)
library(scales)
data_file <- "je-d-20.03.01.01.01.xlsx"

data <- tibble()
for (yr in 2007:2018) {
  temp <- read_excel(data_file, 
                     skip = 6,
                     sheet = as.character(yr)) %>% 
    rename(Region = 1) %>% 
    select(Region, contains("Dezil"), contains("Quartil"), contains("Median")) %>% 
    filter(Region %in% c("Genferseeregion", "Mittelland", "Nordwestschweiz", "Zürich",
                         "Ostschweiz", "Zentralschweiz", "Tessin")) %>% 
    mutate_at(vars(2:6), as.numeric) %>% 
    mutate(Jahr = yr)
  
  data <- bind_rows(data, temp)
}

data_plotready <- data %>% 
  pivot_longer(cols = c(contains("Dezil"), contains("Quartil"), contains("Median")), 
               names_to = "Anteil", values_to = "Wert") %>% 
  mutate(Anteil_num = case_when(Anteil == "1. Dezil" ~ 0.1,
                                Anteil == "1. Quartil" ~ 0.25,
                                Anteil == "Median" ~ 0.5,
                                Anteil == "3. Quartil" ~ 0.75,
                                Anteil == "9. Dezil" ~ 0.9,
                                T ~ 0),
         Anteil_num_scaled = abs(Anteil_num-0.5)) %>% 
  mutate(upper_lower = case_when(Anteil == "1. Dezil" ~ "lower",
                                 Anteil == "1. Quartil" ~ "lower",
                                 Anteil == "Median" ~ "lower",
                                 Anteil == "3. Quartil" ~ "upper",
                                 Anteil == "9. Dezil" ~ "upper",
                                 T ~ NA_character_)) %>% 
  mutate(dup_helper = if_else(Anteil == "Median", 2, 1)) %>% 
  uncount(dup_helper, .id = "new") %>% 
  mutate(upper_lower = if_else(new == 2, "upper", upper_lower)) %>% 
  select(-new)
data_plotready %>% 
  filter(Jahr %in% c(2018, 2008)) %>% 
  ggplot(aes(x = Anteil_num_scaled, y = Wert, color = factor(Jahr))) +
  geom_point(size = 3) +
  geom_path(aes(group = interaction(upper_lower, Jahr)), size = 1, alpha = 0.7) +
  # scale_y_log10(labels = number_format(big.mark = "'"), 
  #               breaks = seq(from = 20000, to = 110000, by = 15000)) +
  scale_y_continuous(labels = number_format(big.mark = "'"), 
                     breaks = seq(from = 20000, to = 110000, by = 15000)) +
  # scale_color_manual(values = c("blue", "green")) +
  scale_colour_brewer(palette = "Set2") +
  labs(title = "Entwicklung der Einkommensschere",
       subtitle = "Referenzpunkte: 1. Dezil, 1. Quartil, Median, 3. Quartil, 9. Dezil",
       y = "Verfügbares Äquivalenzeinkommen in Franken",
       x = "", color = "",
       caption = "Data: BfS") +
  facet_wrap(~Region, nrow = 1, strip.position = "bottom") +
  theme_minimal() +
  theme(axis.line.x = element_blank(),
        axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

Interesting: Nordwestschweiz is the only region with lower incomes on the lower end 2018 vs. 2008. Also quite interesting is Tessin where the extremes are less amplified than 10 years ago.

next up