Wahlen 2019: FB Ad Library

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.

Lizenz

2019-08-fb-ad-library von SRF Data ist lizenziert unter einer Creative Commons Namensnennung - Weitergabe unter gleichen Bedingungen 4.0 International Lizenz.

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")

Wahlen 2019: FB Ad Library

Täglich aktualisierte Auswertung

SRF Data, Timo Grossenbacher (timo.grossenbacher@srf.ch), Aline Metzler

August 2019

Vorbemerkungen

R-Script & Daten

GitHub

Lizenz

Weitere Projekte

Haftungsausschluss

Originalquelle

Vorgehensweise

`output/ads.csv` Datenbeschreibung

Vorbereitungen

Packages definieren

Packages installieren

Packages laden

Theme definieren

Daten einlesen

Auswertungen

Plotting-Funktionen

Zusammenfassende Auswertungen (jeweils nur letzter Stand)

Gesamtanzahl Ads nach Page / Partei / Total

Minimal- und Maximalausgaben nach Page / Partei

Gesamt

Visualisierung

Minimal- und Maximal-Impressions nach Page / Partei

Visualisierung

Gesamt

Auswertungen über die Zeit

Anzahl Ads gestartet, pro Woche

Auswertungen der demographischen Zielgruppen

Geschlecht

Alter

Auswertungen der regionalen Zielgruppen (nach Kantonen)

Daten-Export

Linting

Wahlen 2019: FB Ad Library

Täglich aktualisierte Auswertung

SRF Data, Timo Grossenbacher (timo.grossenbacher@srf.ch), Aline Metzler

August 2019

Vorbemerkungen

R-Script & Daten

GitHub

Lizenz

Weitere Projekte

Haftungsausschluss

Originalquelle

Vorgehensweise

output/ads.csv Datenbeschreibung

Vorbereitungen

Packages definieren

Packages installieren

Packages laden

Theme definieren

Daten einlesen

Auswertungen

Plotting-Funktionen

Zusammenfassende Auswertungen (jeweils nur letzter Stand)

Gesamtanzahl Ads nach Page / Partei / Total

Minimal- und Maximalausgaben nach Page / Partei

Gesamt

Visualisierung

Minimal- und Maximal-Impressions nach Page / Partei

Visualisierung

Gesamt

Auswertungen über die Zeit

Anzahl Ads gestartet, pro Woche

Auswertungen der demographischen Zielgruppen

Geschlecht

Alter

Auswertungen der regionalen Zielgruppen (nach Kantonen)

Daten-Export

Linting

`output/ads.csv` Datenbeschreibung