Vorbemerkungen

Dieses Dokument beschreibt die Vorprozessierung und explorative Analyse des Datensatzes, der Grundlage des auf srf.ch veröffentlichten Artikel So geben Schweizer Haushalte ihr Geld aus ist.

SRF Data legt Wert darauf, dass die Datenvorprozessierung und -Analyse nachvollzogen und überprüft werden kann. SRF Data glaubt an das Prinzip offener Daten, aber auch offener und nachvollziehbarer Methoden. Zum anderen soll es Dritten ermöglicht werden, auf dieser Vorarbeit aufzubauen und damit weitere Auswertungen oder Applikationen zu generieren.

Bei den verwendeten Daten handelt es sich einerseits um die Haushaltsbudgeterhebung des Bundesamtes für Statistik Haushaltsbudgeterhebung und andererseits um Daten zu den Verbrauchsausgaben der europäischen Haushalte von Eurostat.

Die Endprodukte des vorliegenden Scripts, neben der vorliegenden explorativen Analyse, sind JSON-Files für die Visualisierungen:

  • habe_uebersicht.json: 10 aggregierte Kategorien der HABE-Statistik
  • international_verkehr.json: Schweizer Ausgaben für den Verkehr im internationalen Vergleich
  • habe_nahrungsmittel.json: Struktur der HABE-Kategorie Nahrungsmittel
  • international_nahrungsmittel.json: Schweizer Ausgaben für den Nahrungsmittel im internationalen Vergleich
  • diverse Plots

R-Script & Daten

Die Vorprozessierung und Analyse wurde im Statistikprogramm R vorgenommen. Das zugrunde liegende Script sowie die prozessierten Daten können unter diesem Link heruntergeladen werden. Durch Ausführen von main.Rmd kann der hier beschriebene Prozess nachvollzogen und der für den Artikel verwendete Datensatz generiert werden. Dabei werden Daten aus dem Ordner input eingelesen und Ergebnisse in den Ordner output geschrieben.

Verwendet wird R Version 3.4.4. Wenn der Code nicht funktioniert, könnte es daran liegen, dass die installierte R Version eine ältere ist und deshalb aus Kompatibilitätsgründen ältere Packages installiert werden, als die von uns verwendeten. Manchmal hilft es, das Skript mehrmals auszuführen, wenn ein Fehler auftritt. Besonders bei Package-Installationsproblemen kann es helfen, die R-Session mehrmals neuzustarten und den Code nochmals auszuführen. Allenfalls müssen noch Third-Party-Libraries wie z.B. libgdal-dev installiert werden.

Debug-Informationen: This report was generated on 2018-11-20 10:44:25. R version: 3.4.4 on x86_64-pc-linux-gnu. For this report, CRAN packages as of 2018-07-10 were used.

GitHub

Der Code für die vorliegende Datenprozessierung ist auf https://github.com/srfdata/2018-11-habe zur freien Verwendung verfügbar.

Weitere Projekte

Code & Daten von SRF Data sind unter http://srfdata.github.io verfügbar.

Haftungsausschluss

Die veröffentlichten Informationen sind sorgfältig zusammengestellt, erheben aber keinen Anspruch auf Aktualität, Vollständigkeit oder Richtigkeit. Es wird keine Haftung übernommen für Schäden, die durch die Verwendung dieses Scripts oder der daraus gezogenen Informationen entstehen. Dies gilt ebenfalls für Inhalte Dritter, die über dieses Angebot zugänglich sind.

Originalquelle

Die Originaldaten zur Haushaltsbudgeterhebung stammen vom Schweizerischen Bundesamt für Statistik. Sie umfassen die Jahre 2006 bis 2016. Für die Auswertung sind vor allem die Daten für das Jahr 2016 von Interesse.

Die Originaldaten zu den Verbrauchsausgaben der europäischen Haushalte stammen von Eurostat. Die hier berücksichtigtigen Daten umfassen das Jahr 2015. Daten liegen vor für 24 der 28 EU-Länder (Stand 2015, es fehlen Frankreich, Belgien, Portugal und das Vereinigte Königreich) sowie für die Türkei. Weitere Informationen zu den Daten sind hier zu finden.

Vorbereitungen

## [1] "package package:rmarkdown detached"
## Loading required package: knitr
## Loading required package: rstudioapi

Packages definieren

# von https://mran.revolutionanalytics.com/web/packages/checkpoint/vignettes/using-checkpoint-with-knitr.html
# alle Packages, die nicht gebraucht werden, 
# können hier entfernt werden (auskommentieren reicht nicht!)
# Wichtig: wenn neues Package installiert werden soll, 
# scanForPackages = T setzen im checkpoint() call im nächsten Chunk
cat("
library(rstudioapi)
library(tidyverse) # ggplot2, dplyr, tidyr, readr, purrr, tibble
library(magrittr) # pipes
library(scales) # scales for ggplot2
library(jsonlite) # json
library(readxl) # excel
library(lintr) # code linting, auf keinen Fall entfernen ;-)
library(sf) # spatial data handling, bei Installationsproblemen: https://github.com/datacarpentry/r-raster-vector-geospatial/issues/138 oder https://stackoverflow.com/questions/44973639/trouble-installing-sf-due-to-gdal (Mac)
library(styler) # code formatting
library(googlesheets) # googlesheets (replace with tidyverse/googlesheets4 asap)
library(rmarkdown) # muss für automatisches knitting 
# in deploy.sh eingebunden werden",
file = "manifest.R")

Packages installieren

if (!require(checkpoint)) {
  if (!require(devtools)) {
    install.packages("devtools", repos = "http://cran.us.r-project.org")
    require(devtools)
  }
  devtools::install_github("RevolutionAnalytics/checkpoint",
                           ref = "v0.3.2",
                           repos = "http://cran.us.r-project.org")
  require(checkpoint)
}
## Loading required package: checkpoint
## 
## checkpoint: Part of the Reproducible R Toolkit from Microsoft
## https://mran.microsoft.com/documents/rro/reproducibility/
# nolint start
if (!dir.exists("~/.checkpoint")) {
  dir.create("~/.checkpoint")
}
# nolint end
checkpoint(snapshotDate = package_date,
           project = path_to_wd,
           verbose = T,
           scanForPackages = F, # hier ggf. auf F setzen, um Wartezeit zu verkürzen
           use.knitr = F,
           R.version = R_version) # wenn eine "ähnliche" Version von R
## Skipping package scanning
## checkpoint process complete
## ---
 # installiert ist (3.4.4 in diesem Fall), kann dieses
 # Argument hier entfernt und die vorhandene R-Version
 # verwendet werden - vorausgesetzt, die hier verwendeten
 # Packages funktionieren mit dieser.
rm(package_date, R_version)

Packages laden

source("manifest.R")
## ── Attaching packages ─────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.0.0     ✔ purrr   0.2.5
## ✔ tibble  1.4.2     ✔ dplyr   0.7.6
## ✔ tidyr   0.8.1     ✔ stringr 1.3.1
## ✔ readr   1.1.1     ✔ forcats 0.3.0
## ── Conflicts ────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
## 
## Attaching package: 'jsonlite'
## The following object is masked from 'package:purrr':
## 
##     flatten
## Linking to GEOS 3.6.2, GDAL 2.2.3, proj.4 4.9.3
unlink("manifest.R")
sessionInfo()
## R version 3.4.4 (2018-03-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 18.04.1 LTS
## 
## Matrix products: default
## BLAS: /opt/R/R-3.4.4/lib64/R/lib/libRblas.so
## LAPACK: /opt/R/R-3.4.4/lib64/R/lib/libRlapack.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=de_CH.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=de_CH.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=de_CH.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=de_CH.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rmarkdown_1.10     googlesheets_0.3.0 styler_1.0.2      
##  [4] sf_0.6-3           lintr_1.0.2        readxl_1.1.0      
##  [7] jsonlite_1.5       scales_0.5.0       magrittr_1.5      
## [10] forcats_0.3.0      stringr_1.3.1      dplyr_0.7.6       
## [13] purrr_0.2.5        readr_1.1.1        tidyr_0.8.1       
## [16] tibble_1.4.2       ggplot2_3.0.0      tidyverse_1.2.1   
## [19] checkpoint_0.4.0   rstudioapi_0.7     knitr_1.20        
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_0.2.4 reshape2_1.4.3   haven_1.1.2      lattice_0.20-35 
##  [5] colorspace_1.3-2 htmltools_0.3.6  yaml_2.1.19      rlang_0.2.1     
##  [9] e1071_1.6-8      pillar_1.2.3     DBI_1.0.0        foreign_0.8-69  
## [13] glue_1.2.0       withr_2.1.2      modelr_0.1.2     bindrcpp_0.2.2  
## [17] bindr_0.1.1      plyr_1.8.4       munsell_0.5.0    gtable_0.2.0    
## [21] cellranger_1.1.0 rvest_0.3.2      psych_1.8.4      evaluate_0.10.1 
## [25] rex_1.1.2        class_7.3-14     parallel_3.4.4   broom_0.4.5     
## [29] Rcpp_0.12.17     classInt_0.2-3   backports_1.1.2  mnormt_1.5-5    
## [33] hms_0.4.2        digest_0.6.15    stringi_1.2.3    grid_3.4.4      
## [37] rprojroot_1.3-2  cli_1.0.0        tools_3.4.4      lazyeval_0.2.1  
## [41] crayon_1.3.4     pkgconfig_2.0.1  xml2_1.2.0       spData_0.2.9.0  
## [45] lubridate_1.7.4  assertthat_0.2.0 httr_1.3.1       R6_2.2.2        
## [49] units_0.6-0      nlme_3.1-131.1   compiler_3.4.4
rm(list = ls(all.names = TRUE))

Zusätzliche Scripts laden

# falls Logik auf andere Scripts ausgelagert werden soll (z.B. der Übersichtlichkeit halber), hier einkommentieren
knitr::read_chunk("scripts/my_script.R")
source("scripts/my_script.R")

Daten prozessieren

Daten von Eurostat einlesen

# Daten von Eurostat einlesen und Variablen umbenennen
eurostat <- read.csv2("input/hbs_str_t211_1_Data.csv", 
                      sep = ",")
eurostat %<>%
  select(1, 3:6) %>%
  rename(year = TIME,
         country_EU = GEO,
         category_EU = COICOP,
         unit_EU = UNIT,
         percent_EU = Value) %>%
  mutate(country_EU = as.character(country_EU)) %>%
  # Einige Kategorien werden doppelt ausgewiesen, weil sie deckungsgleiche Unterkategorien aufweisen. Diese werden herausgefiltert.
  distinct()

# Da die Daten von Eurostat komischerweise nicht mit den jeweiligen, offiziellen COICOP-Codes referenziert werden, wird ein Codebuch eingelesen. Es weist jeder Kategorie den offiziellen Code zu. Dies vereinfacht später, diese Daten mit den deutschsprachigen Daten des BFS zu verbinden.
eurostat_code <- read_excel("input/COICOP_Code.xlsx", 
                            sheet = 1,
                            col_names = F)

# Spalten umbenennen
eurostat_code %<>%
  rename(code_EU = X__1,
         category_EU = X__2)

# Die Daten von Eurostat werden nun mit dem Codebuch verbunden, so dass jede Kategorie einen eindeutigen Namen "category_EU" und einen eindeutigen Code "code_EU" aufweist.
eurostat %<>%
  left_join(eurostat_code, by = "category_EU") %>%
  mutate(percent_EU = as.numeric(as.character(percent_EU)) / 10)
## Warning: Column `category_EU` joining factor and character vector, coercing
## into character vector
## Warning in evalq(as.numeric(as.character(percent_EU))/10, <environment>):
## NAs introduced by coercion
rm(eurostat_code)

# Englische Ländernamen recoden
country_replacement_german <- c(
  "Austria" = "Österreich",
  "Belgium" = "Belgien",
  "Bulgaria" = "Bulgarien",
  "Croatia" = "Kroatien",
  "Cyprus" = "Zypern",
  "Czech Republic" =  "Tschechien",
  "Denmark" = "Dänemark",
  "Estonia" = "Estland",
  "Finland" = "Finnland",
  "Former Yugoslav Republic of Macedonia, the" = "Mazedonien",
  "France" = "Frankreich",
  "Germany" = "Deutschland",
  "Greece" = "Griechenland",
  "Hungary" = "Ungarn",
  "Ireland" = "Irland",
  "Italy" = "Italien",
  "Latvia" = "Lettland",
  "Lithuania" = "Litauen",
  "Luxembourg" = "Luxemburg",
  "Netherlands" = "Niederlande",
  "Norway" = "Norwegen",
  "Poland" = "Polen",
  "Romania" = "Rumänien",
  "Slovakia" = "Slowakei",
  "Slovenia" = "Slowenien",
  "Spain" = "Spanien",
  "Sweden" = "Schweden",
  "Turkey" = "Türkei",
  "United Kingdom" = "Vereinigtes Königreich")

eurostat %<>%
  mutate(
  country_EU = str_replace_all(country_EU,
                           country_replacement_german))

Daten des BFS einlesen

# Daten einlesen
habe <- read_excel("input/je-d-20.02.01.02.01.xlsx", 
                   sheet = 1,
                   range = anchored("A12", dim = c(NA, NA)))

# Ausgewiesener Wert für das Bruttoeinkommen speichern
brutto_CH <- as.numeric(habe[1, "X__22"])

# Ausgewiesener Wert für die Konsumausgaben speichern
konsumausgaben <- as.numeric(habe[5, "X__22"])

# In der BFS-Statistik befinden sich der Name und der Code jeweils in der gleichen Zelle. Zudem befinden sich die Zellen in unterschiedlichen Spalten, je nachdem auf welcher Ebene (Kategorie, Unterkategorie, etc.) man sich befindet. Nachfolgend werden die Namen und die Codes in zwei Variablen "category_CH" und "code_CH" aufgetrennt. Zudem wird eine neue Variable "level" erstellt, die die jeweilige Ebene angibt.
habe %<>%
  # Relevante Spalten auswählen
  select(1:5, 22:24) %>%
  # In einer neuen Variable wird nun die Ebene ("level") erfasst
  mutate(level = case_when(
    !is.na(X__1) ~ 1,
    !is.na(X__2) ~ 2,
    !is.na(X__3) ~ 3,
    !is.na(X__4) ~ 4,
    !is.na(X__5) ~ 5,
    TRUE ~ 0),
    level = as.factor(level)) %>%
  # Nun werden die Kategorien geparsed
  mutate(category_string = glue::glue("{X__1}{X__2}{X__3}{X__4}{X__5}", 
                                      .na = "")) %>% 
  mutate(code_CH = str_match(category_string, 
                          "(\\d+\\.?\\d*):\\s(.*)")[, 2],
         category_CH = str_match(category_string, 
                              "(\\d+\\.?\\d*):\\s(.*)")[, 3]) %>% 
  # Relevante Spalten auswählen
  select(code_CH, category_CH, 6:8, level) %>%
  # Spalten umbenennen
  rename(amount_CH = X__22,
         quality_CH = X__23,
         percent_CH_total = X__24) %>%
  # Zeilen ohne Wert löschen
  filter(!is.na(category_CH))

# Es wird eine neue Variable "percent_CH_consum" erstellt, welche die jeweiligen Ausgaben als prozentualer Anteil der Konsumausgaben darstellt. Dies ist später für den europäischen Vergleich wichtig.
habe %<>%
  mutate(percent_CH_consum = 
           as.numeric(amount_CH) / 
           konsumausgaben * 100,
         percent_CH_total = 
           as.numeric(percent_CH_total) * 100,
         amount_CH = as.numeric(amount_CH))
## Warning in evalq(as.numeric(amount_CH)/konsumausgaben * 100,
## <environment>): NAs introduced by coercion
## Warning in evalq(as.numeric(percent_CH_total) * 100, <environment>): NAs
## introduced by coercion
## Warning in evalq(as.numeric(amount_CH), <environment>): NAs introduced by
## coercion
# Überkategorien hinzufügen
habe %<>%
  mutate(group = substr(code_CH, 1, 1),
         group = case_when(
           group == "5" ~ "Konsum",
           group == "6" ~ "Konsum",
           group == "3" ~ "Obligatorische Ausgaben",
           group == "4" ~ "Sonstiges",
           group == "8" ~ "Sonstiges",
           TRUE ~ "0"))

# Plausibilitätsüberprüfung: Ergeben die jeweiligen Levels jeweils 100% - Sparbeitrag?
habe %>% 
  group_by(level) %>% 
  summarize(total = sum(percent_CH_total, na.rm = T))
## # A tibble: 5 x 2
##   level total
##   <fct> <dbl>
## 1 1      90.6
## 2 2      90.6
## 3 3      90.6
## 4 4      90.6
## 5 5      90.6

Daten vereinheitlichen

Nicht alle Kategorien der Eurostat-Daten sind vergleichbar mit den BFS-Daten. Aus diesem Grund wurde manuell eine Auswahl getroffen für jene Kategorien, die kompatibel sind.

# Die BFS-Codes als CSV speichern.
referenz <- habe %>%
  select(code_CH)
write.csv(referenz, file = "output/referenz.csv")

# Diese BFS-Codes wurden im CSV manuell mit jenen Eurostat-Codes ergänzt, die für beide Datenquellen kompatibel sind. Das manuell ergänzte CSV wird nun wieder eingelesen und dient nun als Referenztabelle, um später die BFS- und Eurostat-Codes zu matchen.
referenz <- read.csv("input/referenz.csv") %>%
  select(2:3) %>%
  mutate(code_CH = as.character(code_CH)) %>%
  filter(!is.na(code_EU))

# Dank dem Dataframe "Referenz" können nun die Eurostat-Daten und die BFS-Daten zusammengeführt werden. Es werden zwei Dataframes erstellt. Ein Dataframe "data_comparison", um die einzelnen Länder mit der Schweiz zu vergleichen und ein Dataframe "data_countries", um alle Länder miteinander zu vergleichen. 

# Der Datensatz "data_comparison" wird erstellt. Mit ihm ist es möglich, einzelne Länder mit der Schweiz zu vergleichen.
data_comparison <- habe %>%
  # Wir nehmen eine Right_join, weil wir nur jene Kategorien behalten wollen, die wir in "Referenz"" ausgewählt haben und für die Vergleiche zulässig sind
  right_join(referenz, by = "code_CH") %>%
  inner_join(eurostat, by = "code_EU") %>%
  distinct() %>%
  select("code_CH":"percent_CH_consum",
         "country_EU", "percent_EU")
rm(referenz)

# Der Datensatz "data_countries" wird erstellt. Mit ihm ist es möglich, alle Länder (inkl. Schweiz) miteinander zu vergleichen. Dazu müssen zuerst die Daten der EU und Schweiz in die gleiche Dataframe-Struktur gebracht werden.

# Eurostat-Daten in die richtige Dataframe-Struktur bringen
data_countries_EU <- data_comparison %>%
  select(code_CH,
         category_CH,
         level,
         percent_EU,
         country_EU) %>%
  rename(percent_consum = percent_EU) %>%
  mutate(dummy_switzerland = 0)

# BFS-Daten in die richtige Dataframe-Struktur bringen
data_countries_CH <- data_comparison %>%
  select(code_CH, category_CH, level, percent_CH_consum) %>%
  mutate(country_EU = "Schweiz") %>%
  distinct() %>%
  rename(percent_consum = percent_CH_consum) %>%
  mutate(dummy_switzerland = 1)

# Die Daten im Dataframe "data_countries" zusammenführen
data_countries <- data_countries_EU %>%
  bind_rows(data_countries_CH) %>%
  rename(country = country_EU) %>%
  mutate(dummy_switzerland = as.factor(dummy_switzerland))
rm(data_countries_CH, data_countries_EU)

Visualisierungen

Plot: Wofür geben die Schweizer ihr Geld aus?

In diesem Plot wird sichtbar, wofür Schweizer Haushalte ihr Geld ausgeben.

plot <- ggplot(
  habe %>%
    filter(level == 2), 
  aes(
    x = reorder(category_CH, -amount_CH),
    y = amount_CH,
    fill = group)
) +
  geom_col() +
  labs(x = "",
       y = "Ausgaben in Franken", 
       title = "Wofür geben Schweizer ihr Geld aus?") +
  theme(axis.text.x = element_text(angle = 40, hjust = 1))
plot

rm(plot)

Der grösste Posten ist Wohnen und Energie, gefolgt von den Steuern. Für beide Ausgabenpunkte wenden die Haushalte im Durchschnitt mehr als 1000.- CHF monatlich auf. Für einen übersichtlichere Darstellung muss die Anzahl Kategorien in einem nächsten Schritt reduziert werden.

Kategorien einschränken und berechnen

TODO: Beschreibung anpassen

Manuell eine Auswahl für 11 “sinnvolle” Kategorien treffen.

Obligatorische Ausgaben * Steuern * Sozialversicherungsausgaben * Krankenkasse Konsum * Wohnen und Energie * Verkehr * Nahrungsmittel * Unterhaltung, Erholung und Kultur * Sonstige Konsumausgaben Sonstiges (Spenden, Alimente, Übriges) Sparbetrag

Die letzten drei der obigen 11 Kategorien existieren in dieser Form nicht im Datensatz und müssen erst berechnet werden.

# Dazu werden in einem ersten Schritt manuell alle Spalten ausgewählt, die zur Berechnung der neuen Kategorien benötigt werden. 

habe_select <- habe %>%
  filter(code_CH == 50 |
           code_CH == 51 | 
           code_CH == 53 | 
           code_CH == 57 |
           code_CH == 62 |
           code_CH == 66 |
           code_CH == 30 |
           code_CH == 31 |
           code_CH == 32 |
           code_CH == 33 |
           code_CH == 35 |
           code_CH == 40) %>%
  mutate(amount_CH = as.numeric(amount_CH))

# Den Wert für "Monetäre Transferausgaben" recoden zur Gruppe "Sonstiges"
habe_select %<>%
  mutate(group = case_when(
    code_CH == "35" ~ "Sonstiges",
    TRUE ~ group)) %>%
  arrange(code_CH)

# Die drei neuen Kategorien berechnen
SonstigeKonsumausgaben <- (habe_select %>% 
                             filter(level == 1 & group == "Konsum") %>% 
                             pull(amount_CH)) -
                            (habe_select %>% 
                               filter(level == 2 & group == "Konsum") %>%
                               pull(amount_CH) %>% 
                               sum())
Sonstiges <- habe_select %>% 
  filter(group == "Sonstiges") %>% 
  pull(amount_CH) %>% 
  sum()

Sparbetrag <- brutto_CH - habe_select %>% 
  filter(level == 1) %>% 
  pull(amount_CH) %>% 
  sum()


# Variablen, die nur für die Berechnung der neuen Kategorien benötigt wurden, entfernen
habe_select %<>%
  filter(!code_CH == 50 &
         !code_CH == 30 &
         !code_CH == 35 &
         !code_CH == 40 &
         !code_CH == 80) %>%
  select(category_CH:amount_CH, group)

# Den Dataframe um die neu berechneten Kategorien ergänzen
habe_select_add <-
  as.data.frame(c("Sonstige Konsumausgaben", "Sonstiges", "Sparbetrag")) %>%
  cbind(c(SonstigeKonsumausgaben, Sonstiges, Sparbetrag)) %>%
  cbind(c("Konsum", "Sonstiges", "Sparbetrag")) %>%
  rename(category_CH = 1,
         amount_CH = 2,
         group = 3)

habe_select %<>%
  rbind(habe_select_add)

rm(habe_select_add)

# Der Dataframe "habe_select" sollte nun die 11 definierten Kategorien enthalten. Um zu überprüfen, ob kein Fehler unterlaufen ist, dient folgender Test: Dieser Wert muss annähernd 0 ergeben (Rundungsdifferenzen möglich), sonst stimmt das Dataframe nicht!
test <- brutto_CH - habe_select %>% pull(amount_CH) %>% sum()
if (abs(test) > 0.01){
  stop("Achtung: Fehler!")
}
# Prozentualer Anteil der Bruttoeinnahmen berechnen
habe_select %<>%
  mutate(percent_CH = amount_CH / brutto_CH * 100)
total_percent <- habe_select %>% pull(percent_CH) %>% sum()
if (abs(total_percent - 100) > 0.01){
  stop("Achtung: Fehler!")
}
# Kategorienamen vereinfachen und für Übersetzung vorbereiten
category_replacements <- c(
  "Sozialversicherungsbeiträge" = "socialSecurity",
  "Steuern" = "taxes",
  "Krankenkassen: Prämien für die Grundversicherung" = "healthInsurance",
  "Nahrungsmittel und alkoholfreie Getränke" = "foodAndDrinks",
  "Gast- und Beherbergungsstätten" = "restaurantsAndHotels",
  "Wohnen und Energie" = "rentAndEnergey",
  "Verkehr" = "carAndPublicTransport",
  "Unterhaltung, Erholung und Kultur" = "entertainment",
  "Sonstige Konsumausgaben" = "otherConsumption",
  "Sonstiges" = "miscellaneous",
  "Sparbetrag" = "savings"
)

group_replacements <- c(
  "Obligatorische Ausgaben" = "obligatory",
  "Konsum" = "consumption",
  "Sonstiges" = "miscellaneous",
  "Sparbetrag" = "savings"
)

habe_select %<>% mutate(
  category_CH = str_replace_all(category_CH, category_replacements),
  group = str_replace_all(group, group_replacements)
)

# Als JSON speichern (Für den 1. Chart im Artikel)
write_json(
  path = "output/habe_uebersicht.json",
  habe_select %>%
    mutate(percent_CH = percent_CH / 100) %>%
    rename(category = category_CH, amount = amount_CH, percent = percent_CH))

Plot: Die Schweiz im Vergleich mit…

Mit diesem Plot kann man die Schweiz mit einem europäischen Land vergleichen und herausfinden, bei welchen Ausgabenpunkten die Unterschiede am grössten sind.

# Vergleich nach Ländern
#country <- "Italien"
country <- "Kroatien"

plot <- ggplot(
  data_comparison %>%
    filter(country_EU == country,
           level == 2), 
  aes(
    x = percent_EU,
    y = percent_CH_consum)
) +
  geom_point() +
  labs(x = country, 
       y = "Schweiz", 
       title = paste("Die Schweiz im Vergleich mit", country)) +
  geom_text(aes(label = ifelse(percent_EU > 7
                               | percent_CH_consum > 7,
                             as.character(category_CH), "")),
            hjust = 0.5,
            vjust = -0.4,
            size = 2.5) +
  coord_fixed(ratio = 1) +
  theme_minimal()
plot

Beispiel Kroatien: Wohnen und Energie ist in beiden Ländern der grösste Posten. In Kroatien wird hingegen ein viel grösserer Anteil der Konsumausgaben für Nahrungsmittel ausgegeben (24 %) als in der Schweiz (12 %). Dafür geben Schweizer mehr für Erholung und Kultur aus. Dieser Plot wird im Artikel nicht verwendet, hilft aber bei der Auswertung der Daten.

Plot: Gesamtübersicht

Der Plot bietet eine grobe Übersicht, in welchen Ländern es im Vergleich zur Schweiz besonders starke Unterschiede gibt.

# Gesamtübersicht
plot <- ggplot(
  data_comparison %>%
    filter(level == 2,
           !is.na(percent_EU)),
  aes(
    x = percent_EU,
    y = percent_CH_consum)
) +
  geom_point() +
  labs(x = "Prozentualer Anteil der Ausgaben im Land", 
       y = "Prozentualer Anteil der Ausgaben in der Schweiz", 
       title = paste("Die Schweiz im Vergleich")) +
  facet_wrap(~country_EU) +
  # geom_text(aes(label=ifelse(percent_EU > 8 | percent_CH_consum > 5,
  #                         as.character(category_CH),'')),
  #          hjust=0.5,
  #          vjust=-0.4,
  #          size = 2) +
  coord_fixed(ratio = 1)
plot

Dieser Plot wird im Artikel nicht verwendet, hilft aber bei der Auswertung der Daten.

Plot: Ausgaben für Konsumgüter im europäischen Vergleich

Der nachfolgende Plot zeigt, wie gross der Anteil der Konsumausgaben für einen spezifische Kategorie in den unterschiedlichen Ländern ist.

# Nach Konsumgut
#consum <- "Nahrungsmittel"
consum <- "Verkehr"

cbPalette <- c("#999999", "#C70039")

plot <- ggplot(
  data_countries %>%
    filter(category_CH == consum,
           !is.na(percent_consum)), 
  aes(x = reorder(country, -percent_consum),
      y = percent_consum,
      fill = dummy_switzerland)
) +
  geom_col() +
  labs(x = "Land", 
       y = "Anteil in %", 
       title = paste("Ausgaben für", consum, "als Anteil der Konsumausgaben")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = cbPalette) +
  guides(fill = FALSE)
plot

Daten zum obigen Plot für die Kategorien “Verkehr” und “Nahrungsmittel” als JSON speichern.

# Subset für die Daten für Kategorie "Verkehr"
data_countries_select <- data_countries %>%
  filter(category_CH == "Verkehr",
           !is.na(percent_consum)) %>%
  select(category_CH,
         percent_consum,
         country, 
         dummy_switzerland)

# Ersetze Ländernamen beim Export durch 2-stellige Kürzel (Übersetzbarkeit)
country_replacements <- c(
  "Schweiz" = "CH",
  "Österreich" = "AT",
  "Belgien" = "BE",
  "Bulgarien" = "BG",
  "Kroatien" = "HR",
  "Zypern" = "CY",
  "Tschechien" = "CZ",
  "Dänemark" = "DK",
  "Estland" = "EE",
  "Finnland" = "FI",
  "Ehem. Jugoslawien" = "YU",
  "Frankreich" = "FR",
  "Deutschland" = "DE",
  "Griechenland" = "GR",
  "Ungarn" = "HU",
  "Irland" = "IS",
  "Italien" = "IT",
  "Malta" = "MT",
  "Lettland" = "LV",
  "Litauen" = "LT",
  "Luxemburg" = "LU",
  "Niederlande" = "NL",
  "Norwegen" = "NO",
  "Polen" = "PL",
  "Rumänien" = "RO",
  "Slowakei" = "SK",
  "Slowenien" = "SI",
  "Spanien" = "ES",
  "Schweden" = "SE",
  "Türkei" = "TR",
  "Vereinigtes Königreich" = "GB"
)

# Als JSON speichern (für den 2. Chart im Artikel)
write_json(
  path = "output/international_verkehr.json",
  data_countries_select %>%
    mutate(percent_consum = percent_consum / 100) %>%
    select(percent = percent_consum, country) %>%
    mutate(country = str_replace_all(country, country_replacements)))

# Subset für die Daten für Kategorie "Nahrungsmittel"
data_countries_select <- data_countries %>%
  filter(category_CH == "Nahrungsmittel",
           !is.na(percent_consum)) %>%
  select(category_CH,
         percent_consum,
         country,
         dummy_switzerland)

# Als JSON speichern (für den 4. Chart im Artikel)
write_json(
  path = "output/international_nahrungsmittel.json",
  data_countries_select %>%
    mutate(percent_consum = percent_consum / 100) %>%
    select(percent = percent_consum, country) %>%
    mutate(country = str_replace_all(country, country_replacements)))

Plot: Nahrungsmittel

In einem weiteren Plot wird dargestellt, wie sich die Kategorie “Nahrungsmittel” zusammensetzt.

plot <- ggplot(
  habe %>%
    filter(level == 4,
           substr(code_CH, 1, 3) == "511"), 
  aes(
    x = reorder(category_CH, -percent_CH_total),
    y = percent_CH_total * 100)
) +
  geom_col() +
  labs(x = "",
       y = "Betrag in CHF", 
       title = "Nahrungsmittel: Wofür geben Schweizer ihr Geld aus?") +
  theme(axis.text.x = element_text(angle = 25, hjust = 1))
plot

rm(plot)

Daten zum obigen Plot für die Kategorien “Nahrungsmittel” als JSON speichern

# Subset für die Daten für Kategorie "Nahrungsmittel"
habe_select <- habe %>%
  filter(level == 4,
         substr(code_CH, 1, 3) == "511") %>%
  select(category_CH, amount_CH, percent_CH_total)

# Ersetze Kategorien beim Export durch 2-stellige Kürzel (Übersetzbarkeit)
food_categories_replacements <- c(
  "Brot und Getreideprodukte" = "bakery",
  "Fleisch" = "meat",
  "Fisch" = "fish",
  "Milch, Käse und Eier" = "dairy",
  "Speisefette und -öle" = "fatAndOils",
  "Früchte" = "fruit",
  "Gemüse" = "vegetables",
  "Zucker, Konfitüren, Honig, Schokolade und Süsswaren" = "sweets",
  "Saucen, Salz, Gewürze, Suppen und sonstige Nahrungsmittel" = "miscellaneous"
)

# Als JSON speichern (für den 3. Chart im Artikel)
write_json(
  path = "output/habe_nahrungsmittel.json",
  habe_select %>%
    mutate(percent_CH_total = percent_CH_total / 100) %>%
    select(percent = percent_CH_total, category = 
             category_CH, amount = amount_CH) %>%
    mutate(category = str_replace_all(category, food_categories_replacements)))

Linting

Der Code in diesem RMarkdown wird mit lintr automatisch auf den Wickham’schen tidyverse style guide überprüft.

lintr::lint("main.Rmd", linters = 
              lintr::with_defaults(
                commented_code_linter = NULL,
                trailing_whitespace_linter = NULL
                )
            )
## main.Rmd:27:3: style: Place a space before left parenthesis, except in a function call.
## if(R_version != paste0(version$major, ".", version$minor)){
##   ^
## main.Rmd:139:1: style: lines should not be more than 80 characters.
## library(sf) # spatial data handling, bei Installationsproblemen: https://github.com/datacarpentry/r-raster-vector-geospatial/issues/138 oder https://stackoverflow.com/questions/44973639/trouble-installing-sf-due-to-gdal (Mac)
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:168:1: style: lines should not be more than 80 characters.
##            scanForPackages = F, # hier ggf. auf F setzen, um Wartezeit zu verkürzen
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:211:1: style: lines should not be more than 80 characters.
##   # Einige Kategorien werden doppelt ausgewiesen, weil sie deckungsgleiche Unterkategorien aufweisen. Diese werden herausgefiltert.
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:358:1: style: lines should not be more than 80 characters.
##   # Wir nehmen eine Right_join, weil wir nur jene Kategorien behalten wollen, die wir in "Referenz"" ausgewählt haben und für die Vergleiche zulässig sind
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~