Vorbemerkungen

In diesem Dokument werden einmal täglich alle Facebook-Werbeanzeigen (“Ads”) Schweizer Parteien ausgewertet. Kontext: https://www.srf.ch/news/schweiz/wahlen-2019/wahlen-2019-der-facebook-wahlkampf-nimmt-fahrt-auf

Zuletzt aktualisiert um 2019-10-28 06:00:04 mit Daten, die zwischen 00:00 und 03:00 akquiriert wurden.

ACHTUNG: Die Daten, die aus der Ad Library zurückgegeben werden, sind aus verschiedensten Gründen lückenhaft und teils möglicherweise fehlerhaft (siehe dazu diesen und diesen Bericht). Bei der Interpretation der untenstehenden Auswertungen ist deshalb Vorsicht geboten. Darüber hinaus wird jegliche Haftung für die nachfolgenden Angaben ausgeschlossen (siehe “Haftungsausschluss”).

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.

Die Endprodukte des vorliegenden Scripts, neben der vorliegenden explorativen Analyse, sind:

  • output/ads.csv: Die verschiedenen Zeitstände von Ads inkl. der Angaben, die im Frontend der Ad Library angezeigt werden, exkl. demographischer Angaben (Datenbeschreibung siehe unten).

Für eine Beschreibung der Vorgehensweise siehe das Unterkapitel “Vorgehensweise”.

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.

SRF Data verwendet das rddj-template von Timo Grossenbacher als Grundlage für seine R-Scripts. Entstehen bei der Ausführung dieses Scripts Probleme, kann es helfen, die Anleitung von rddj-template zu studieren.

Debug-Informationen: This report was generated on 2019-10-28 06:00:04. R version: 3.5.3 on x86_64-pc-linux-gnu. For this report, CRAN packages as of 2019-03-01 were used.

GitHub

Der Code für die vorliegende Datenprozessierung ist auf https://github.com/srfdata/2019-08-fb-ad-library zur freien Verwendung verfügbar.

Weitere Projekte

Code & Daten von SRF Data sind unter https://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 Originalquelle ist die Facebook Ad Library API. Um nachzuvollziehen, wie diese täglich angefragt wird, siehe das Script im Ordner analysis/scripts/api_bot.R.

Vorgehensweise

  • Täglich um Mitternacht wird die Facebook Ad Library mit dem Script in analysis/scripts/api_bot.R gemäss hunderten von Suchbegriffen durchsucht (“Crawl-Vorgang”).
  • Die Suchbegriffe sind in analysis/input/pages.csv aufgeführt und umfassen die Page-IDs aller bisherigen ParlamentarierInnen (soweit bekannt) sowie die Page-IDs der nationalen und kantonalen Partei-Sektionen.
  • Zusätzlich werden noch weitere Freitext-Suchbegriffe von Parteinamen verwendet, um möglichst viele weitere Ergebnisse zu erhalten (siehe analysis/scripts/api_bot.R ca. ab Zeile 55).
  • Nach dem Crawl-Vorgang werden die API-Antworten im vorliegenden Script eingelesen, vorprozessiert (im Script analysis/scripts/preprocess.R und ausgewertet. Dabei werden verschiedene Grafiken erstellt und die aufbereiteten Daten in ein CSV gegossen (siehe Datenbeschreibung).
  • Für die Auswertungen werden aus Gründen der Vergleichbarkeit jeweils nur die Daten der kantonalen und nationalen Partei-Sektionen (=API-Resultate, die auf Anfrage einer Page-ID retourniert wurden) verwendet. Zum Teil werden auch nur Daten der nationalen Sekretariate verwendet, dies ist jeweils angegeben.

output/ads.csv Datenbeschreibung

Attribut Typ Beschreibung
page_name:spend.upper_bound* mixed Angaben, die direkt von der API übernommen werden (Datenbeschreibung)
search_expression character Der initiale Suchausdruck, für den die API die Ad zurückgegeben hat (i.d.R. eine Page-ID)
kanton character Kanton der Sektion / des/der KandidatIn, falls bekannt und zutreffend
region character Sprachregion, falls bekannt und zutreffend (hilfreich bei nationalen Pages)
partei character Kanonischer Parteiname, falls bekannt und zutreffend
account_art character Art der Page: “Kantonale Sektion”, “Nationale Partei”, “Person” (bisherige ParlamentarierInnen) oder NA (für Resultate, die durch Freitext-Suchbegriffe erhalten wurden)
ad_uuid integer Eindeutige ID der Ad in diesem Datensatz (Achtung: Kann sich von Tag zu Tag ändern)
crawl_timestamp* character Zeitpunkt des Crawl-Vorgangs

*Alle Zeitangaben sind in UTC+2 (zentraleuropäische Sommerzeit CEST).

Inhaltlich zeigt der Datensatz alle Zeitstände (crawl_timestamp) einer Ad (ad_uuid), bei denen die von der API gelieferten Daten zuletzt konsistent waren. In anderen Worten: Werden von der API andere Daten geliefert (zum Beispiel neue Angaben zu Preis und Impressions, da sich diese über die Zeit ändern können), erhält der Datensatz einen neuen Eintrag mit einem neuen crawl_timestamp aber der gleichen ad_uuid, da es sich um die gleiche Ad mit aktualisierten Informationen handelt. So lassen sich Änderungen über die Zeit nachvollziehen.

Vorbereitungen

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

Packages definieren

# from https://mran.revolutionanalytics.com/web/packages/checkpoint/vignettes/using-checkpoint-with-knitr.html
# if you don't need a package, remove it from here (commenting is probably not sufficient)
# tidyverse: see https://blog.rstudio.org/2016/09/15/tidyverse-1-0-0/
cat("
library(rstudioapi)
library(tidyverse) # ggplot2, dplyr, tidyr, readr, purrr, tibble
library(magrittr) # pipes
library(lubridate) # dates
library(scales) # scales for ggplot2
library(jsonlite) # json
library(lintr) # code linting
library(rmarkdown)",
file = "manifest.R")

Packages installieren

# if checkpoint is not yet installed, install it (for people using this
# system for the first time)
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", # could be adapted later,
                           # as of now (beginning of July 2017
                           # this is the current release on CRAN)
                           repos = "http://cran.us.r-project.org")
  require(checkpoint)
}
# nolint start
if (!dir.exists("~/.checkpoint")) {
  dir.create("~/.checkpoint")
}
# nolint end
# install packages for the specified CRAN snapshot date
checkpoint(snapshotDate = package_date,
           project = path_to_wd,
           verbose = T,
           scanForPackages = F,
           use.knitr = F,
           R.version = R_version)
rm(package_date)

Packages laden

source("manifest.R")
unlink("manifest.R")
sessionInfo()
## R version 3.5.3 (2019-03-11)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 16.04.6 LTS
## 
## Matrix products: default
## BLAS: /opt/R/R-3.5.3/lib/R/lib/libRblas.so
## LAPACK: /opt/R/R-3.5.3/lib/R/lib/libRlapack.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rmarkdown_1.15   lintr_1.0.3      jsonlite_1.6     scales_1.0.0    
##  [5] lubridate_1.7.4  magrittr_1.5     forcats_0.4.0    stringr_1.3.1   
##  [9] dplyr_0.8.0.1    purrr_0.3.2      readr_1.3.1      tidyr_0.8.2     
## [13] tibble_2.0.1     ggplot2_3.1.0    tidyverse_1.2.1  checkpoint_0.4.0
## [17] rstudioapi_0.10  knitr_1.24      
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.0       cellranger_1.1.0 plyr_1.8.4       pillar_1.3.1    
##  [5] compiler_3.5.3   tools_3.5.3      digest_0.6.20    evaluate_0.14   
##  [9] nlme_3.1-137     gtable_0.2.0     lattice_0.20-38  pkgconfig_2.0.2 
## [13] rlang_0.4.0      rex_1.1.2        cli_1.1.0        yaml_2.2.0      
## [17] haven_2.1.0      xfun_0.9         withr_2.1.2      xml2_1.2.2      
## [21] httr_1.4.1       hms_0.4.2        generics_0.0.2   grid_3.5.3      
## [25] tidyselect_0.2.5 glue_1.3.1       R6_2.4.0         readxl_1.3.0    
## [29] modelr_0.1.4     backports_1.1.4  htmltools_0.3.6  rvest_0.3.2     
## [33] assertthat_0.2.1 colorspace_1.4-0 stringi_1.2.3    lazyeval_0.2.1  
## [37] munsell_0.5.0    broom_0.5.1      crayon_1.3.4

Theme definieren

# some constants
default_font_color <- "#4e4d47"
default_background_color <- "#f5f5f2"
default_font_family <- "SRG SSR Type Text"

theme_srf <- function(...) {
  theme_minimal() +
  theme(
    text = element_text(family = default_font_family,
                        color = default_font_color),
    # add a subtle grid
    panel.grid.major = element_line(color = "#dbdbd9", size = 0.2),
    panel.grid.minor = element_blank(),
    # background colors
    plot.background = element_rect(fill = default_background_color,
                                   color = NA),
    panel.background = element_rect(fill = default_background_color,
                                    color = NA),
    legend.background = element_rect(fill = default_background_color,
                                     color = NA),
    # borders and margins
    plot.margin = unit(c(.5, .5, .2, .5), "cm"),
    panel.border = element_blank(),
    # panel.spacing = unit(c(-.1, 0.2, .2, 0.2), "cm"),
    # titles
    legend.title = element_text(size = 11),
    legend.text = element_text(size = 9, hjust = 0,
                               color = default_font_color),
    plot.title = element_text(size = 15, hjust = 0.5,
                              color = default_font_color),
    plot.subtitle = element_text(size = 10, hjust = 0.5,
                                 color = default_font_color,
                                 margin = margin(b = -0.1,
                                                 t = -0.1,
                                                 l = 2,
                                                 unit = "cm"),
                                 debug = F),
    # captions
    plot.caption = element_text(size = 7,
                                hjust = .5,
                                margin = margin(t = 0.2,
                                                b = 0,
                                                unit = "cm"),
                                color = "#939184"),
    ...
  )
}

Daten einlesen

In scripts/preprocess.R werden die Daten zuerst korrekt typisiert.

Dann werden sie so dedupliziert, dass jeweils nur die letzt gecrawlte Version einer Ausprägung einer Ad bestehen bleibt. Wenn sich also während mehreren Crawl-Vorgängen an einer Ausprägung einer Ad (Ausprägung: Z.B. momentane Anzahl Impressions) nichts ändert, wird nur der jüngste Crawl-Vorgang beibehalten.

Danach werden die eindeutigen Ads extrahiert (mehrere “Versionen” einer Ad, wie sie im Ad Library Frontend vorkommen, werden als einzelne Ads gezählt).

load("input/ignore/tmp/ads.RData")
load("input/ignore/tmp/reg_dist.RData")
load("input/ignore/tmp/dem_dist.RData")

Auswertungen

Plotting-Funktionen

# party colors
big_8_colors <- c(
  "SVP" = "#4B8A3E",
  "SP" = "#F0554D",
  "Grüne" = "#84B547",
  "Grünliberal" = "#C4C43D",
  "FDP" = "#3872B5",
  "EV" = "#DEAA28",
  "CVP" = "#D6862B",
  "BDP" = "#E6C820",
  "Total" = "#4E4D47"
)

plot_total <- function(data, grouping_var, measurement_var) {
  data %>% 
    filter(!is.na(!!sym(grouping_var))) %>%
    group_by(Partei, !!sym(grouping_var)) %>% 
    summarise(summarized_var = sum(!!sym(measurement_var))) %>% 
    ggplot(aes(x = !!sym(grouping_var), y = summarized_var, fill = Partei)) +
    geom_bar(stat = "identity") +
    facet_grid(~ Partei) +
    scale_fill_manual(values = big_8_colors) +
    theme_srf() +
    labs(color = "", caption = "CC-BY-SA SRF Data 2019")
}

plot_share <- function(data, grouping_var, measurement_var) {
  data %>% 
    filter(!is.na(!!sym(grouping_var))) %>%
    group_by(Partei, !!sym(grouping_var)) %>% 
    summarise(summarized_var = sum(!!sym(measurement_var))) %>% 
    mutate(share = summarized_var / sum(summarized_var)) %>%
    ggplot(aes(x = !!sym(grouping_var), y = share, fill = Partei)) +
    geom_bar(stat = "identity") +
    geom_text(aes(y = share, label = scales::percent(round(share, 3))), 
            position = position_dodge(width = 0.5), 
            vjust = 0.5, color = "black", size = 3) +
    scale_y_continuous(labels = scales::percent) +
    facet_grid(~ Partei) +
    scale_fill_manual(values = big_8_colors) +
    theme_srf() +
    labs(color = "", caption = "CC-BY-SA SRF Data 2019")
}

Für die nachfolgenden Auswertungen werden jeweils nur die Daten von nationalen und kantonalen Partei-Sektionen verwendet. Zusätzliche Daten, die durch Suchbegriffe und Page-IDs bisherhiger ParlamentarierInnen anfallen, werden nicht miteinbezogen.

Zusammenfassende Auswertungen (jeweils nur letzter Stand)

ads_to_analyze <- ads %>% 
  # only keep cantonal and national sections, not candidates
  filter(!is.na(`Account-Art`)) %>% 
  filter(`Account-Art` != "Person") %>% 
  group_by(ad_uuid) %>% 
  arrange(desc(scrape_date)) %>% 
  slice(1) %>% 
  ungroup()

Gesamtanzahl Ads nach Page / Partei / Total

ads_to_analyze %>% 
  count(page_name) %>% 
  arrange(desc(n)) %>% 
  knitr::kable()
page_name n
FDP 3034
PLR 1971
FDP Kanton Zürich 116
CVP / PDC / PPD 91
Grünliberale 83
BDP Kanton Bern 63
Grüne Schweiz 47
BDP Schweiz 41
Les Verts suisses 34
SP Schweiz 25
FDP.Die Liberalen Basel-Stadt 19
PS Suisse 15
Vert’libéraux 15
FDP.Die Liberalen Baselland 13
Grüne Kanton Solothurn 10
CVP Kanton Aargau 7
Grünliberale Kanton Zürich 6
Grüne Kanton Bern - Verts canton de Berne 5
Grüne Zürich 5
SP Basel-Stadt 5
CVP Uri 2
PBD Suisse 2
ads_to_analyze %>% 
  count(Partei) %>% 
  arrange(desc(n)) %>% 
  knitr::kable()
Partei n
FDP 5153
BDP 106
Grünliberal 104
Grüne 101
CVP 100
SP 45
ads_to_analyze %>% 
  count() %>% 
  knitr::kable()
n
5609

Minimal- und Maximalausgaben nach Page / Partei

Alle Angaben in CHF.

ads_to_analyze %>% 
  group_by(page_name) %>% 
  summarize(min_spent = sum(spend.lower_bound, na.rm = TRUE),
            max_spent = sum(spend.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_spent)) %>% 
  knitr::kable()
page_name min_spent max_spent
FDP 5900 320466
CVP / PDC / PPD 55400 234509
PLR 4400 211229
FDP Kanton Zürich 27400 112784
Grünliberale 18100 66017
Grüne Schweiz 13200 54953
Les Verts suisses 9200 42266
Grüne Zürich 3100 12495
Vert’libéraux 3300 11185
SP Schweiz 2200 9075
FDP.Die Liberalen Basel-Stadt 1800 7981
Grünliberale Kanton Zürich 1500 7494
BDP Kanton Bern 200 7037
BDP Schweiz 300 5259
FDP.Die Liberalen Baselland 500 3287
PS Suisse 300 2685
SP Basel-Stadt 700 2195
CVP Kanton Aargau 100 1093
Grüne Kanton Solothurn 0 990
Grüne Kanton Bern - Verts canton de Berne 100 895
CVP Uri 0 198
PBD Suisse 0 198

Total nach Partei (inkl. Kantonalsektionen)

ads_to_analyze %>% 
  group_by(Partei) %>% 
  summarize(min_spent = sum(spend.lower_bound, na.rm = TRUE),
            max_spent = sum(spend.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_spent)) %>% 
  knitr::kable()
Partei min_spent max_spent
FDP 40000 655747
CVP 55500 235800
Grüne 25600 111599
Grünliberal 22900 84696
SP 3200 13955
BDP 500 12494

Total nach Partei (ohne Kantonalsektionen)

ads_to_analyze %>% 
  filter(`Account-Art` == "Nationale Partei") %>% 
  group_by(Partei) %>% 
  summarize(min_spent = sum(spend.lower_bound, na.rm = TRUE),
            max_spent = sum(spend.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_spent)) %>% 
  knitr::kable()
Partei min_spent max_spent
FDP 10300 531695
CVP 55400 234509
Grüne 22400 97219
Grünliberal 21400 77202
SP 2500 11760
BDP 300 5457
Gesamt

Mit kantonalen Sektionen

# Gesamtausgaben
ads_to_analyze %>% 
  summarize(min_spent = sum(spend.lower_bound, na.rm = TRUE),
            max_spent = sum(spend.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_spent)) %>% 
  knitr::kable()
min_spent max_spent
147700 1114291
Visualisierung

Ohne kantonale Sektionen.

ads_to_analyze %>% 
  group_by(Partei) %>% 
  filter(`Account-Art` == "Nationale Partei") %>% 
  summarize(min_spent = sum(spend.lower_bound, na.rm = TRUE),
            max_spent = sum(spend.upper_bound, na.rm = TRUE)) %>%
  arrange(desc(min_spent)) %>% 
  mutate(Partei = fct_reorder(Partei, min_spent, last)) %>% 
  ggplot() +
  geom_segment(aes(x = min_spent, y = Partei,
  xend = max_spent, yend = Partei), size = 1) +
  geom_point(aes(x = min_spent, y = Partei, color = "Mindestens"), 
             size = 2, shape = 15) +
  geom_point(aes(x = max_spent, y = Partei, color = "Höchstens"), 
             size = 2, shape = 15) +
  labs(x = "Ausgaben [CHF]", y = "Partei", color = "", 
       title = "FB Ad Library: Ausgaben nach Partei",
       subtitle = "Ohne kantonale Sektionen",
       caption = "CC-BY-SA SRF Data 2019") +
  theme_srf() +
  scale_x_continuous(labels = function(x) 
    format(x, big.mark = "'", scientific = FALSE))

Minimal- und Maximal-Impressions nach Page / Partei

Parteien zuerst mit, dann ohne kantonale Sektionen.

ads_to_analyze %>% 
  group_by(page_name) %>% 
  summarize(min_impressions = sum(impressions.lower_bound, na.rm = TRUE),
            max_impressions = sum(impressions.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(min_impressions)) %>% 
  knitr::kable()
page_name min_impressions max_impressions
CVP / PDC / PPD 8853000 15956913
Grünliberale 5403000 11101918
FDP Kanton Zürich 3159000 7873884
FDP 2204000 9640966
Vert’libéraux 2056000 3664986
Grüne Schweiz 1476000 3872953
PLR 1114000 5088029
Les Verts suisses 1078000 2745966
Grüne Zürich 815000 1759995
FDP.Die Liberalen Basel-Stadt 376000 1114981
SP Schweiz 268000 850975
Grünliberale Kanton Zürich 245000 709994
FDP.Die Liberalen Baselland 111000 524987
BDP Schweiz 87000 338959
SP Basel-Stadt 76000 214995
PS Suisse 65000 297985
CVP Kanton Aargau 51000 224993
BDP Kanton Bern 28000 172937
Grüne Kanton Bern - Verts canton de Berne 12000 61995
Grüne Kanton Solothurn 4000 25990
CVP Uri 1000 5998
PBD Suisse 1000 5998
ads_to_analyze %>% 
  group_by(Partei) %>% 
  summarize(min_impressions = sum(impressions.lower_bound, na.rm = TRUE),
            max_impressions = sum(impressions.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(min_impressions)) %>% 
  knitr::kable()
Partei min_impressions max_impressions
CVP 8905000 16187904
Grünliberal 7704000 15476898
FDP 6964000 24242847
Grüne 3385000 8466899
SP 409000 1363955
BDP 116000 517894
ads_to_analyze %>% 
  filter(`Account-Art` == "Nationale Partei") %>% 
  group_by(Partei) %>% 
  summarize(min_impressions = sum(impressions.lower_bound, na.rm = TRUE),
            max_impressions = sum(impressions.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(min_impressions)) %>% 
  knitr::kable()
Partei min_impressions max_impressions
CVP 8853000 15956913
Grünliberal 7459000 14766904
FDP 3318000 14728995
Grüne 2554000 6618919
SP 333000 1148960
BDP 88000 344957
Visualisierung

Ohne kantonale Sektionen.

ads_to_analyze %>% 
  filter(`Account-Art` == "Nationale Partei") %>% 
  group_by(Partei) %>% 
  summarize(min_impressions = sum(impressions.lower_bound, na.rm = TRUE),
            max_impressions = sum(impressions.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_impressions)) %>% 
  mutate(Partei = 
           fct_reorder(Partei, min_impressions, last)) %>% 
  ggplot() +
  geom_segment(aes(x = min_impressions, y = Partei,
  xend = max_impressions, yend = Partei), size = 1) +
  geom_point(aes(x = min_impressions, y = Partei, 
                 color = "Mindestens"), 
             size = 2, shape = 15) +
  geom_point(aes(x = max_impressions, y = Partei, 
                 color = "Höchstens"), 
             size = 2, shape = 15) +
  labs(x = "Impressions", y = "Partei", color = "", 
       title = "FB Ad Library: Impressions nach Partei",
       subtitle = "Ohne kantonale Sektionen",
       caption = "CC-BY-SA SRF Data 2019") +
  theme_srf() +
  scale_x_continuous(labels = function(x) 
    format(x, big.mark = "'", scientific = FALSE))

Gesamt

Mit kantonalen Sektionen

ads_to_analyze %>% 
  summarize(min_impressions = sum(impressions.lower_bound, na.rm = TRUE),
            max_impressions = sum(impressions.upper_bound, na.rm = TRUE)) %>% 
  arrange(desc(max_impressions)) %>% 
  knitr::kable()
min_impressions max_impressions
27483000 66256397

Auswertungen über die Zeit

Anzahl Ads gestartet, pro Woche

ads_to_analyze %>% 
  # Neue Variable: week_number
  mutate(week_number = isoweek(ad_delivery_start_time)) %>% 
  group_by(week_number, Partei) %>% 
  # Neue Ads pro Woche: week_ads
  summarise(week_ads = sum(n())) %>% 
  ggplot(aes(x = week_number, y = week_ads, fill = Partei)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = big_8_colors) +
  labs(x = "Kalenderwoche", y = "Anzahl neue Ads", color = "", 
       title = "FB Ad Library: Anzahl gestartete Ads pro Woche",
       caption = "CC-BY-SA SRF Data 2019") +
  theme_srf()

Auswertungen der demographischen Zielgruppen

Jeweils nationale und kantonale Sektionen zusammengenommen.

# only latest version of every ad -> uuids of ads_to_analyze
dem_dist_ads <- ads_to_analyze %>% 
  left_join(dem_dist, by = "uuid")

# views: How many people (age/gender) saw the ad
dem_dist_ads %<>% 
  mutate(views.lower_bound = impressions.lower_bound * percentage,
         views.upper_bound = impressions.upper_bound * percentage,
         costs.lower_bound = spend.lower_bound * percentage,
         costs.upper_bound = spend.upper_bound * percentage
         )

Geschlecht

plot_total(dem_dist_ads, "gender", "costs.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Geschlecht", y = "Mindest-Ausgaben in CHF", 
       title = "FB Ad Library: Ausgaben nach Geschlecht",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben") 

# total impressions by gender
plot_total(dem_dist_ads, "gender", "views.lower_bound") +  
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Geschlecht", y = "Mindest-Impressions", 
       title = "FB Ad Library: Impressions nach Geschlecht",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")

# Share of costs by gender
plot_share(dem_dist_ads, "gender", "costs.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Geschlecht", y = "Anteil der Mindest-Ausgaben", 
       title = "FB Ad Library: Anteil der Ausgaben nach Geschlecht",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

# Share of impressions by gender
plot_share(dem_dist_ads, "gender", "views.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Geschlecht", y = "Anteil der Mindest-Impressions", 
       title = "FB Ad Library: Anteil Impressions nach Geschlecht",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")

Alter

# omit age group 13-17 (FDP)
dem_dist_ads %<>%
  filter(!age == "13-17")


# total costs per age group
plot_total(dem_dist_ads, "age", "costs.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Altersgruppe", y = "Mindest-Ausgaben in CHF", 
       title = "FB Ad Library: Ausgaben nach Altersgruppe",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben") 

# total impressions per age group
plot_total(dem_dist_ads, "age", "views.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Altersgruppe", y = "Mindest-Impressions", 
       title = "FB Ad Library: Impressions nach Altersgruppe",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")  

# share of costs by age group
plot_share(dem_dist_ads, "age", "costs.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Altersgruppe", y = "Anteil der Mindest-Ausgaben", 
       title = "FB Ad Library: Anteil der Ausgaben nach Altersgruppe",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

# share of impressions by age group
plot_share(dem_dist_ads, "age", "views.lower_bound") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Altersgruppe", y = "Anteil der Mindest-Impressions", 
       title = "FB Ad Library: Anteil Impressions nach Altersgruppe",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")

Auswertungen der regionalen Zielgruppen (nach Kantonen)

Hierfür werden nur die nationalen Sektionen verwendet, da nicht alle kantonalen Sektionen mitmachen und es somit zu Verzerrungen kommen würde.

# Rename Cantons, consistent names
canton_names <- c(
  "^Basel-City$" = "Basel-Stadt",
  "^Canton of Geneva$" = "Genf",
  "^Canton of Glarus$" = "Glarus",
  "^Canton of Nidwalden$" = "Nidwalden",
  "^Canton of Obwalden$" = "Obwalden",
  "^Canton of St. Gallen$" = "St. Gallen",
  "^Fribourg$" = "Freiburg",
  "^Neuchâtel$" = "Neuenburg",
  "^Ticino$" = "Tessin",
  "^Valais$" = "Wallis",
  "^Vaud$" = "Waadt",
  "^Unknown$" = NA_character_
)

reg_dist %<>%
  mutate(region = str_replace_all(region, canton_names)) %>% 
  mutate(percentage = as.numeric(percentage))
  

# join the dfs
reg_dist_ads <- ads_to_analyze %>% 
  left_join(reg_dist, by = "uuid") %>% 
  # only retain national party sections
  filter(`Account-Art` == "Nationale Partei")

# views = How many people (canton) saw the ad
reg_dist_ads %<>% 
  mutate(views.lower_bound = impressions.lower_bound * percentage,
         views.upper_bound = impressions.upper_bound * percentage,
         costs.lower_bound = spend.lower_bound * percentage,
         costs.upper_bound = spend.upper_bound * percentage
         )
# total costs by canton
plot_total(reg_dist_ads, "region", "costs.lower_bound") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Mindest-Ausgaben", 
       title = "FB Ad Library: Ausgaben nach Kanton", 
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

# total impressions by canton
plot_total(reg_dist_ads, "region", "views.lower_bound") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Mindest-Impressions", 
       title = "FB Ad Library: Impressions nach Kanton",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")

# Share of costs by canton
plot_share(reg_dist_ads, "region", "costs.lower_bound") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Anteil der Mindest-Ausgaben", 
       title = "FB Ad Library: Anteil Ausgaben nach Kanton", 
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

# Share of impressions by canton
plot_share(reg_dist_ads, "region", "views.lower_bound") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Anteil der Mindest-Impressions", 
       title = "FB Ad Library: Anteil Impressions nach Kanton",
       subtitle = "Gerechnet wird mit den Mindest-Impressions")

# normalize with count of NR-Sitze
canton_names2 <- c(
  "^Bern / Berne$" = "Bern",
  "^Fribourg / Freiburg$" = "Freiburg",
  "^Graubünden / Grigioni / Grischun$" = "Graubünden",
  "^Ticino$" = "Tessin",
  "^Vaud$" = "Waadt",
  "^Valais / Wallis$" = "Wallis",
  "^Neuchâtel$" = "Neuenburg",
  "^Genève$" = "Genf"
)
# data source: BFS, 2015
canton_voters <- 
  read_delim("input/eligible_voters_cantons.csv", delim = ";") %>% 
  rename(region = kanton_bezeichnung) %>% 
  filter(region != "Schweiz") %>% 
  mutate(region = str_replace_all(region, canton_names2)) %>% 
  select(region, wahlberechtigte)

reg_dist_ads_normalized <- reg_dist_ads %>%
  group_by(Partei, region) %>% 
  summarise(Ausgaben = sum(costs.lower_bound)) %>% 
  left_join(canton_voters, by = "region") %>% 
  ungroup()

# share of cantons, normalized by seats
reg_dist_ads_normalized %<>% 
  filter(!is.na(region)) %>%
  mutate(costs_per_1000_voters_in_chf = 
           round( (Ausgaben / wahlberechtigte) * 1000, 1)) %>% 
  select(Partei, region, costs_per_1000_voters_in_chf) %>% 
  group_by(Partei) %>% 
  arrange(desc(costs_per_1000_voters_in_chf))

plot_total(reg_dist_ads_normalized,
           "region", 
           "costs_per_1000_voters_in_chf") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Mindest-Ausgaben pro tausend Wahlberechtigte in CHF", 
       title = "FB Ad Library: Ausgaben pro tausend Wahlberechtigte",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

reg_dist_total <- reg_dist_ads_normalized %>% 
  group_by(region) %>% 
  summarize(total = sum(costs_per_1000_voters_in_chf)) %>% 
  mutate(Partei = as.factor("Total")) %>% 
  mutate(region = as.factor(region)) %>% 
  mutate(region = fct_reorder(region, total))

reg_dist_total %>% 
  plot_total("region", "total") +
  coord_flip() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  labs(x = "Kanton", y = "Mindest-Ausgaben pro tausend Wahlberechtigte in CHF", 
       title = "FB Ad Library: Ausgaben pro tausend Wahlberechtigte",
       subtitle = "Gerechnet wird mit den Mindest-Ausgaben")

rm(canton_voters)

Daten-Export

Datenbeschreibung siehe oben.

ads %>% 
  select(-uuid) %>% 
  select(page_name:ad_creative_link_description, 
         impressions.lower_bound:spend.upper_bound, search_expression,
         Kanton:`Account-Art`, ad_uuid, crawl_timestamp = scrape_date) %>%
  rename(kanton = Kanton, region = Region, 
         partei = Partei, account_art = `Account-Art`) %>% 
  arrange(ad_uuid) %>% 
  write_csv(path = "output/ads.csv")

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
                )
            )
# if you have additional scripts and want them to be linted too, add them here
# lintr::lint("scripts/my_script.R")