The use of political ads on facebook in the run-up to the European Parliament elections 2019 in Austria
Roland Schmidt, @zoowalk
25 July 2019
1 Facebook’s Ad Library
A few months ago, in March 2019, Facebook opened its Ad library, which contains ‘data on every active and inactive ad about social issues, elections or politics’ (link). I didn’t really follow the pertaining developments in detail, but the release seems to be some sort of (belated) response to the, let’s say, ‘infamous’ use of social media when it comes to the spread of ‘fake news’ in the run-up to the US presidential elections and the Brexit referendum. While the library appears to have some shortcomings (more on this later, but also read this and this) and is certainly not enough to let FB off the hook, the data is a ‘peep-hole’ into the functioning of electoral campaigning on FB. Not only is information provided on the content and timing (creation/duration) of each political ad, the library also provides some information on the amount of money spent on each ad, the demographic and geographic composition of its audience as well as the entity/person who paid for the ad.
At least for the Austrian context, the elections to the European Parliament (EP) offered the first opportunity to dive into FB’s Ad library and see how Austrian candidates ran their campaign on the platform. Furthermore, the Austrian EP elections are particularly interesting since the run-up to the elections became ‘externally shocked’ (yea, there must be a better word) by the release of a secretly made video. It shows the Austrian Vice-Chancellor and leader of the extreme-right party FPÖ HC Strache in a private, alcohol fueled conversation in which he boasts, among other things, with his willingness to reward positive press reports with public contracts, to use his power to remove non-compliant journalists and how to circumvent party financing restrictions. The video not only led to his resignation and the eventual break-up of the ÖVP-FPÖ coalition government, it also became an almost dominant topic in parties’ campaigning to for EP seats. Digging into FB data may reveal how parties adjusted their campaigning on FB following the release of the video.
But before starting to analyse the data, some words of caution. I am by no means a social media expert. Aside from my erratic engagement on twitter, I don’t use any social media (I reactivated my FB account solely to access the API). There might be intricacies to Facebook’s data which I am not aware of. Second, while the code here (seems to) works, there are likely to be some more elegant ways to implement it. In any case, everything I do here would not be possible without the amazingly welcoming R community, including, but not limited to, @hrbrmstr, the #tidytuesday crew, @sharon000 and @brodriguesco, whose open-source posts I have been following for a while and which have been more than helpful.
More generally, this ‘blog’ (?) entry has a technical/procedural as well as a substantive purpose, with an emphasis on the former. The blog seeks first and foremost to present one of possibly many ways how to analyse FB’s ad library with R. If you’re not interested in R, simply close the the code snippets. As for the latter, it hopefully brings a few new insights on how Austrian candidates used FB during the EP election campaign.
2 Preparatory work
2.1 Getting data
Essentially, there are two ways how to get data from FB’s Ad Library: 1) The aggregated reports and 2) the data directly retrieved from the library via FB’s API. The former are by and large ‘ready to consume’ spread sheets providing mostly aggregate numbers on campaign ads. While providing already some interesting insights, it is less suitable if you are interested in doing further analysis on your own.
Accessing the API is rather straightforward, if you’re familiar with APIs and FB’s graph API. I wasn’t, but there you go. FB’s pertaining site provides a good starting point. Once you created your own app and obtained an access token, you can access the API with the wonderful httr package (and the other usual suspects).
#load packages (also for later analysis)
library(tidyverse)
library(lubridate)
library(scales)
library(lemon)
library(DT)
library(extrafont)
extrafont::loadfonts()
library(httr)#link to fb api
my_link<- "https://graph.facebook.com"
#define fields you are interested in
search_fields=c("ad_creation_time", "ad_delivery_start_time", "ad_delivery_stop_time",
"ad_creative_body",
"page_id",
"page_name",
"currency",
"spend",
"demographic_distribution",
"funding_entity",
"impressions",
"region_distribution") %>%
stringr::str_c(., collapse=", ")
#get the data from the first 'page' of data the api provides
page_one_response <- GET(my_link,
path = "/ads_archive",
query = list(access_token = my_token,
limit=100,
ad_active_status="ALL",
search_terms="''",
fields=search_fields,
ad_reached_countries="AT"))
page_one_content<- content(page_one_response)
x <- tibble(data=page_one_content$data)
df_imp <- x %>%
unnest_wider(data)
#get the link refering to the next page
next_link <- page_one_content$paging$`next`
#iterate over all pages until there is no further page
while(length(next_link)>0) {
next_response <- GET(next_link)
next_content<- content(next_response)
y <- tibble(data=next_content$data)
df_next <- y %>%
unnest_wider(data)
df_imp <- bind_rows(df_imp, df_next)
next_link <- next_content$paging$`next`
}The data retrieved via the API contains a myriad of different ads and creators, and not all are relevant for the interest here (EP elections). In the period examined here, from 1 May to 26 May (election date), there were 6537 ads created by 379 unique pages, i.e. those persons or organisations placing ads. For the sake of completeness, I include them all here in the table, sorted by the total number ads created from 1 May until the EP elections.
all_ads_in_period <- df_imp %>%
mutate(ad_creation_time=lubridate::ymd_hms(ad_creation_time) %>% lubridate::date(.)) %>%
filter(ad_creation_time %within% interval(as.Date("2019-05-01"),
as.Date("2019-05-26")))
df_all_creators <- all_ads_in_period %>%
group_by(page_name) %>%
summarise(n_ads=n()) %>%
arrange(desc(n_ads)) %>%
rename(page=page_name,
number_of_ads=n_ads)
NROW(all_ads_in_period)## [1] 6537## [1] 379library(kableExtra)
knitr::kable(df_all_creators, caption="Pages and total number of ads", ) %>%
kable_styling() %>%
scroll_box(height = "200px")| page | number_of_ads |
|---|---|
| Angelika Winzig | 1164 |
| SPÖ | 582 |
| Othmar Karas | 368 |
| Barbara M. Thaler | 313 |
| Lukas Mandl | 292 |
| Claudia Gamon | 226 |
| Greenpeace Österreich | 155 |
| Karoline Edtstadler | 130 |
| NR KLUB JETZT | 124 |
| Die Grünen | 100 |
| KSV Graz | 88 |
| Andreas Schieder | 84 |
| kontrast.at | 76 |
| Proud to be Jamaican | 75 |
| Volkspartei Niederösterreich | 67 |
| Harald Vilimsky | 66 |
| JUNOS Studierende | 65 |
| OÖVP - die Oberösterreichische Volkspartei | 64 |
| Sebastian Bohrn Mena | 61 |
| Wissensministerium | 56 |
| Die Grünen Steiermark | 55 |
| 1Europa | 52 |
| Die Tiroler Grünen | 49 |
| Europa-Wahl 2019 | 45 |
| NEOS | 45 |
| Die neue SPÖ Tirol | 43 |
| Pamela Rendi-Wagner | 43 |
| Sense Mesura | 43 |
| European Parliament | 42 |
| Stadt Wien | 40 |
| EPP - European People’s Party | 38 |
| Grüne Jugend - Grünalternative Jugend | 38 |
| Alma Zadic | 34 |
| GRAS - Grüne & Alternative Student_innen | 34 |
| KPÖ PLUS | 34 |
| FSG - Fraktion Sozialdemokratischer GewerkschafterInnen | 33 |
| GPA-djp | 32 |
| Günther Sidl | 32 |
| HC Strache | 29 |
| LET’S CEE Film Festival | 29 |
| SPÖ Kärnten | 29 |
| Alex Bernhuber | 28 |
| GRAS Innsbruck | 28 |
| Flamingos’ Life | 27 |
| Sozialdemokratische Partei Europas | 25 |
| Wochenblick | 25 |
| FPÖ Niederösterreich | 23 |
| Peter Hametner | 23 |
| Christian Dax | 22 |
| GRAS Linz - Grüne und Alternative Student_innen | 22 |
| Tierschutzvolksbegehren | 22 |
| Austrian World Summit | 21 |
| Evelyn Regner | 21 |
| Julia Herr | 21 |
| Peter Pilz | 21 |
| Sebastian Kurz | 21 |
| Die Innsbrucker Grünen | 20 |
| FPÖ | 20 |
| Junge Generation in der SPÖ | 20 |
| Amnesty International Austria | 19 |
| European Greens | 19 |
| Markus Hein | 19 |
| Wolfram Pirchner | 19 |
| Bruno Rossmann | 18 |
| European Commission | 18 |
| Earthsider | 17 |
| NEOS Niederösterreich | 16 |
| Unser Niederösterreich | 16 |
| Wandel | 16 |
| Simone Schmiedtbauer | 15 |
| Thomas Stelzer | 15 |
| Maximilian Krauss | 14 |
| Socialists and Democrats Group in the European Parliament | 14 |
| Werner Kogler | 14 |
| Österreichische Gesellschaft für Europapolitik | 13 |
| Thomas Drozda | 13 |
| Udo Landbauer | 13 |
| VSStÖ Innsbruck - Verband Sozialistischer StudentInnen Sektion Innsbruck | 13 |
| Die Grünen Oberösterreich | 12 |
| Lui Hofmann | 12 |
| Tiroler Volkspartei | 12 |
| Wirtschaftskammer | 12 |
| ALDE Party – Liberals and Democrats for Europe | 11 |
| FPÖ Tirol - die Tiroler Freiheitlichen | 11 |
| Freiheitliche Arbeitnehmer Oberösterreich | 11 |
| Gottfried Waldhäusl | 11 |
| Johann Gudenus | 11 |
| Maximilian Kurz | 11 |
| Michael Raml | 11 |
| Wirtschaftsbund Österreich | 11 |
| Keinen Millimeter | 10 |
| Miyinla | 10 |
| NEOS Wien | 10 |
| Norbert Hofer | 10 |
| Österreich&Europa | 10 |
| Sozialistische Jugend Steiermark | 10 |
| Speak & Listen Translator APP | 10 |
| Ahmed Husagić | 9 |
| bagru GRAS boku | 9 |
| Hermann Schützenhöfer | 9 |
| Herwig Mahr | 9 |
| Severin Mayr | 9 |
| SPÖ Wien | 9 |
| StuffVip | 9 |
| AktionsGemeinschaft Uni Wien | 8 |
| BuzzyRange | 8 |
| Sarah Wiener | 8 |
| Wilfried Haslauer | 8 |
| Christian Pirker | 7 |
| Dominik Nepp | 7 |
| KOSMO | 7 |
| Meine Abgeordneten | 7 |
| Steffi Krisper | 7 |
| Vote for a Woman / Stem op een Vrouw | 7 |
| ZARA - Zivilcourage und Anti-Rassismus-Arbeit | 7 |
| Arbeit&Wirtschaft Magazin | 6 |
| D.Franklin | 6 |
| Die Grünen Wien | 6 |
| Fighting Heroes | 6 |
| KPÖ Graz | 6 |
| Mario Kunasek | 6 |
| Politik muss wieder für die einfachen Menschen gemacht werden. | 6 |
| Salzburger Volkspartei | 6 |
| SPÖ Obersteiermark Ost | 6 |
| Wirtschaftsbund Niederösterreich | 6 |
| AwareGO | 5 |
| Beate Meinl-Reisinger | 5 |
| Christian Zoll | 5 |
| Christoph Wiederkehr | 5 |
| Europäisches Parlament Österreich | 5 |
| Herbert Kickl | 5 |
| KPÖ PLUS Salzburg | 5 |
| Michael Bernhard | 5 |
| Team Kurz | 5 |
| VSStÖ Wien | 5 |
| A Solution to Plastic Pollution - First International Online Summit | 4 |
| ALDE Group – Liberals and Democrats in the European Parliament | 4 |
| Bildungsverein #offenegesellschaft | 4 |
| Christofer Ranzmaier | 4 |
| Europäische Kommission - Vertretung in Österreich | 4 |
| Europe Thinx | 4 |
| FPÖ Linz | 4 |
| Freiheitliche Jugend | 4 |
| Georg Strasser | 4 |
| Gerald Loacker | 4 |
| I LOVE GERASDORF | 4 |
| KPÖ Wien | 4 |
| Master Chef Universal | 4 |
| Maysara Soliman | 4 |
| Michael Ludwig | 4 |
| NEOS Tirol | 4 |
| SPÖ Burgenland | 4 |
| SPÖ im Parlament | 4 |
| 塔防三國志 | 3 |
| Beate Hartinger-Klein | 3 |
| Big News Buzz | 3 |
| Bildungsverein der KPÖ Steiermark | 3 |
| Christine Haberlander | 3 |
| Dark Domain | 3 |
| Fine Acts | 3 |
| Grüne Jugend Steiermark | 3 |
| Josef Pühringer | 3 |
| Kialo | 3 |
| Markus Ornig | 3 |
| mymuesli | 3 |
| Newchic_Men | 3 |
| Now_Then | 3 |
| Nurten Yilmaz | 3 |
| Prosvijetljen.info | 3 |
| ServusTV | 3 |
| Solidarität - Für faire Löhne & Arbeitsbedingungen | 3 |
| Thomas Waitz | 3 |
| Volksmacht AT / Presse-Stelle | 3 |
| Vorarlberger Freiheitliche - FPÖ | 3 |
| VSStÖ Juridicum | 3 |
| VSStÖ Med Wien | 3 |
| wienerinnen.at | 3 |
| Adorbs | 2 |
| Alexander Van der Bellen | 2 |
| AUTOMATICA | 2 |
| Basarabia e România | 2 |
| Better Straw | 2 |
| Brut UK | 2 |
| Council of Europe - Directorate General Human Rights and Rule of Law | 2 |
| eq.eco | 2 |
| EU-Infothek | 2 |
| European Committee of the Regions | 2 |
| FILMLADEN | 2 |
| Freiheitliche Bauernschaft Oberösterreich | 2 |
| Freiheitliche Jugend Vorarlberg | 2 |
| FT Content Solutions | 2 |
| Grüne Bezirk Perg | 2 |
| Guitar Lovers | 2 |
| Highride | 2 |
| International Rescue Committee | 2 |
| Irmgard Griss | 2 |
| Junge Generation Wien | 2 |
| Junge ÖVP Mariahilf | 2 |
| KJÖ Graz | 2 |
| KWG - Regionaler Ökostrom aus Österreich | 2 |
| LuXembourg - Let’s make it happen | 2 |
| Markus Abwerzger | 2 |
| Markus Achleitner | 2 |
| Markus Wölbitsch | 2 |
| Max Hiegelsberger | 2 |
| MBRC | 2 |
| ModVans | 2 |
| Open Society Foundations | 2 |
| Orbex | 2 |
| Partei der Arbeit | 2 |
| Petra Steger | 2 |
| RIS - Socially RISponsible | 2 |
| scoop.me | 2 |
| SPÖ Stadtorganisation Amstetten | 2 |
| Stefan Hermann | 2 |
| SwatiManish | 2 |
| Toni Mahdalik | 2 |
| Volkspartei | 2 |
| VoteWatch Europe | 2 |
| VSStÖ - Verband sozialistischer Student_innen | 2 |
| Wirtschaftsbund Oberösterreich | 2 |
| Zodiac & Fate | 2 |
| #Post4Europe | 1 |
| ВОЛЯ - Българските Родолюбци | 1 |
| Глобальный еврейский онлайн центр Jewish.Ru | 1 |
| Журнал ЛЕХАИМ | 1 |
| План за рестартиране на демокрацията | 1 |
| Правда | 1 |
| 4IL | 1 |
| A1Sports | 1 |
| Academic Stories | 1 |
| Acamar Analysis and Consulting | 1 |
| Airis Meier Page | 1 |
| Alexa Goddard | 1 |
| AllatRa TV English | 1 |
| arbeit plus Salzburg | 1 |
| Atomic Shirts | 1 |
| Aufbruch Salzburg | 1 |
| Banque mondiale | 1 |
| Beijing Tourism | 1 |
| Belqees.Rights | 1 |
| Bettina Vollath | 1 |
| BIBER | 1 |
| Big day | 1 |
| Biker aus Leidenschaft | 1 |
| BSA Burgenland | 1 |
| Burschenschaft Hysteria | 1 |
| Canberra Short Film Festival | 1 |
| CLAYTON | 1 |
| CRIF | 1 |
| Daniela Holzinger-Vogtenhuber | 1 |
| DAS BÜNDNIS für Menschenrechte & Zivilcourage | 1 |
| David Stögmüller | 1 |
| Die Grünen Enns | 1 |
| Die Grünen Linz | 1 |
| Die GRÜNEN Salzburg | 1 |
| Diem25.official | 1 |
| dom-i-NEEK | 1 |
| Doris Hummer | 1 |
| Eettisen kaupan puolesta | 1 |
| ElectronicSpecifier | 1 |
| Elisabeth Olischar | 1 |
| Elke Kahr | 1 |
| EnergyXL | 1 |
| Erinnern&handeln | 1 |
| ETUC | 1 |
| EU Civil Protection & Humanitarian Aid - ECHO | 1 |
| Europäische Gesellschaft für gesundes Bauen und Innenraumhygiene | 1 |
| European Investment Bank | 1 |
| Eurozine | 1 |
| Familie Rockt | 1 |
| Farmers Corner | 1 |
| Fischfarm Schubert | 1 |
| FPÖ - Freiheitliche Studenten Tirol | 1 |
| FPÖ Bezirk Weiz | 1 |
| Free Quran Education | 1 |
| Freeture | 1 |
| Freiheitliche Jugend Kärnten | 1 |
| Furlong | 1 |
| garagErasmus Foundation | 1 |
| Gernot Blümel | 1 |
| GLB Steiermark | 1 |
| Gleicher Lohn für gleiche Arbeit | 1 |
| Globsec | 1 |
| GRAS Wien | 1 |
| Grimfrost | 1 |
| Grüne Jugend Vorarlberg | 1 |
| Grüne Meidling | 1 |
| Grüne Wirtschaft | 1 |
| Gütersloher Verlagshaus | 1 |
| HAKUA Shorts | 1 |
| Harry Koller | 1 |
| Helena Kirchmayr | 1 |
| HiBAR | 1 |
| Human Rights Tattoo | 1 |
| I Love Nursing | 1 |
| In Penzing zuhaus - SPÖ Penzing | 1 |
| INA D | 1 |
| Israel Under Fire | 1 |
| ITUC | 1 |
| Johannes Bachleitner, Bezirksrat | 1 |
| Junge Generation in der SPÖ Oberösterreich | 1 |
| Junge ÖVP | 1 |
| Junge Wirtschaft | 1 |
| Just a Bosnian Girl - The Modest Fashion and Lifestyle blog | 1 |
| Justice for Daphne Caruana Galizia | 1 |
| KJÖ Oberösterreich | 1 |
| Kolb GesmbH | 1 |
| Laurenz Pöttinger | 1 |
| Lowrider Custom Kennels | 1 |
| LUQEL | 1 |
| Malaysiakini | 1 |
| Mama Africa love | 1 |
| Marco Triller | 1 |
| Marvel Lover | 1 |
| MasterClass | 1 |
| Minnesota House DFL Campaign | 1 |
| MN Benito | 1 |
| Mr. Gugu & Miss Go | 1 |
| Ne u moje ime | 1 |
| NEMDIS | 1 |
| NEOPresse - Unabhängige Nachrichten | 1 |
| Newchic Men | 1 |
| Niko Swatek | 1 |
| NÖ.Regional.GmbH | 1 |
| Noosworks.com | 1 |
| ÖGB | 1 |
| On Trend Stuff | 1 |
| Österreich braucht Unternehmergeist | 1 |
| Pampers Russia | 1 |
| Paul Pasquali | 1 |
| POLITICO Europe | 1 |
| Queen’s University Belfast | 1 |
| Raimond Kaljulaid | 1 |
| Redstar73 Records | 1 |
| Regenbogenparade | 1 |
| Riparte il futuro | 1 |
| Routledge Politics, IR and Strategic Studies | 1 |
| Rroma Contact Point | 1 |
| RYOT | 1 |
| Sandra Krautwaschl | 1 |
| SBU Wirtschaftstreuhand und Steuerberatungs GmbH | 1 |
| Screems | 1 |
| Shelby Leigh | 1 |
| SONNENTOR | 1 |
| Soonfeed | 1 |
| Sozialdemokratischer Wirtschaftsverband Wien | 1 |
| SPÖ Felixdorf | 1 |
| SPÖ Hainfeld | 1 |
| SPÖ Niederösterreich | 1 |
| SPÖ Oberösterreich | 1 |
| Stefan Kaineder | 1 |
| Steirische Volkspartei | 1 |
| stern | 1 |
| Stop AAAS Ro | 1 |
| SummersRed | 1 |
| Susținători USR Austria | 1 |
| Sustainability Times | 1 |
| Talking Europe | 1 |
| The New Futurist | 1 |
| The New Humanitarian | 1 |
| the people’s poncho | 1 |
| Tobias Krammer | 1 |
| Tokyo Weekender | 1 |
| Tom MacDonald | 1 |
| TOP Bürgerliste Peuerbach | 1 |
| Tshirt Month7 | 1 |
| UNICEF Europe & Central Asia | 1 |
| United World İnternational | 1 |
| Uniunea Salvați România - USR | 1 |
| unzensuriert.at | 1 |
| USR Diaspora | 1 |
| VSStÖ Uni Wien | 1 |
| WahlSwiper | 1 |
| Weltkirche Kufstein | 1 |
| Wholesome Culture | 1 |
| Women-Liberty | 1 |
| World Cleanup Day | 1 |
| Zur Zeit | 1 |
2.2 Select candidates and period of interest
While it would be certainly interesting to screen all ads for their relevance to the elections, I limit my subsequent analysis to a handful of candidates which I deem particularly interesting. Hence, the caveat that the results presented here are not meant to provide an exhaustive analysis of parties’ campaign on FB. From all available ads I take only those of the candidates I am interested in and which were created (!) between 1 May and the 26 May, the day of the elections.
#select candidates of interest and assign to party
party_affiliation=list(greens=c("Werner Kogler", "Sarah Wiener", "Monika Vana"),
ovp=c("Othmar Karas", "Karoline Edtstadler", "Lukas Mandl", "Angelika Winzig",
"Simone Schmiedbauer"),
neos=c("Claudia Gamon", "Karin Feldinger","Stefan Windberger"),
spo=c("Andreas Schieder", "Eveyln Regner", "Günther Sidl"),
fpo=c("Harald Vilimsky", "HC Strache", "Petra Steger", "Georg Mayer"),
jetzt=c("1Europa", "Marion Krainer", "Johannes Voggenhuber"))
#create df
df_candidates<- party_affiliation %>%
map(., as_tibble) %>%
map_dfr(., bind_rows, .id="party") %>%
rename(candidate=value) %>%
mutate(party=stringr::str_to_upper(party))
#define party colors
fpo <- "#005DA8"
neos <- "#EA5290"
ovp <- "#5DC2CC"
spo <- "#FC0204"
greens <- "#A3C630"
jetzt <- "white"
#assign colors to candiadates
df_party_colors <- tibble(fpo=fpo, neos=neos, ovp=ovp, spo=spo, greens=greens,
jetzt=jetzt) %>%
tidyr::pivot_longer(everything(), values_to = "party_colors", names_to = "party")
df_party_colors <- df_candidates %>%
left_join(.,
df_party_colors %>% mutate(party=stringr::str_to_upper(party)),
by=c("party"))
#create named vector for later use in ggplot2
vec_candidate_colors = df_party_colors$party_colors
names(vec_candidate_colors) = df_party_colors %>%
mutate(candidate=paste0(stringr::word(candidate, -1), " (", party, ")")) %>%
pull(candidate)
df_vec_party_colors <- df_party_colors %>%
distinct(party, party_colors)
vec_party_colors <- df_vec_party_colors %>%
pull(party_colors)
names(vec_party_colors) <- df_vec_party_colors$party
my_caption <- "Roland Schmidt | @zoowalk | http://werk.statt.codes"
#define dates for event indicators
ibiza_video <- list(date=lubridate::dmy("17-05-2019"), color="red")
ep_elections <- list(date=lubridate::dmy("26-05-2019"), color="orange")
date_indicators <- list('Ibiza video'=ibiza_video,
'EP Elections'=ep_elections) %>%
map_df(., bind_rows, .id="event")
df_party_candidates <- df_candidates %>%
group_by(party) %>%
summarise(candidates=paste(candidate, collapse=", "))
knitr::kable(df_party_candidates, caption="Selected candidates", ) %>%
kable_styling() %>%
scroll_box(height = "200px")| party | candidates |
|---|---|
| FPO | Harald Vilimsky, HC Strache, Petra Steger, Georg Mayer |
| GREENS | Werner Kogler, Sarah Wiener, Monika Vana |
| JETZT | 1Europa, Marion Krainer, Johannes Voggenhuber |
| NEOS | Claudia Gamon, Karin Feldinger, Stefan Windberger |
| OVP | Othmar Karas, Karoline Edtstadler, Lukas Mandl, Angelika Winzig, Simone Schmiedbauer |
| SPO | Andreas Schieder, Eveyln Regner, Günther Sidl |
date_observation_start <- lubridate::ymd("2019-05-01") #start date
date_observation_end <- lubridate::ymd("2019-05-26") #eleciton date
df_x <- df_imp %>%
filter(page_name %in% df_candidates$candidate) %>%
mutate_at(vars(contains("time")), lubridate::ymd_hms) %>%
filter(ad_creation_time %within% interval(date_observation_start,
date_observation_end)) %>%
left_join(., df_candidates, by=c("page_name"="candidate")) %>%
mutate(candidate=stringr::word(page_name, -1)) %>%
mutate(candidate=paste0(candidate, " (", party, ")")) %>%
mutate(party=forcats::fct_infreq(party)) %>%
arrange(party) %>%
mutate(candidate=forcats::fct_inorder(candidate))
#add an unique identifier for each ad; helps merging different dataframes
df_x <- df_x %>%
group_by(page_name) %>%
mutate(ad_id=paste(stringr::str_remove_all(page_name, "[:space:]"),
lubridate::date(ad_creation_time),
row_number(), sep="-")) %>%
ungroup()
NROW(df_x)## [1] 2467With these ‘scope conditions’, I get 2467 ads. Now with our data filtered, we are finally good to go and dig (a little bit) deeper.
3 Number and value of ads
3.1 Number of ads
Let’s disaggregate the total number of ads according to each candidate’s Facebook page.
df_x %>%
group_by(page_name) %>%
summarise(n_ads=n()) %>%
left_join(., df_candidates, by=c("page_name"="candidate")) %>%
mutate(candidate=stringr::word(page_name, -1)) %>%
mutate(candidate=paste0(candidate, " (", party, ")")) %>%
ggplot()+
geom_bar(aes(x=reorder(candidate, n_ads),
y=n_ads,
fill=candidate),
color="transparent",
stat="identity")+
geom_text(aes(x=candidate,
y=1300,
label=n_ads),
hjust=1,
size=4,
color="grey80")+
labs(title="Number of Facebook ads in the run-up to 2019 EP elections",
x="page placing ad",
subtitle="Ads created between 1 May and 26 May 2019. Selected candidates.",
caption="Roland Schmidt | @zoowalk | http://werk.statt.codes")+
hrbrthemes::theme_ft_rc()+
theme(legend.position = "none",
axis.title.x = element_blank(),
panel.grid.major.y = element_blank())+
scale_fill_manual(values = vec_candidate_colors)+
scale_x_discrete(expand=expand_scale(mult=c(0, 0.0)))+
scale_y_continuous(expand=expand_scale(mult=c(0, 0)),
breaks=seq(250, 1000, 250),
minor_breaks = NULL)+
coord_flip()
Blimey. At least to me, this is some kind of a surprise. ÖVP’s Angelika Winzig’s site was way ahead of other candidates when it comes to the number of ads run. With more than 1,100 ads she/her page ran almost as many ads as all of the other included candidates together. Winzig prolific campaigning is insofar a surprise as she was not the main candidate of the ÖVP and at least to my purely subjective impression ran a rather unnoticeable campaign.
Overall, as far as the number of ads is concerned, candidates of the ÖVP were clearly the most prolific. Note also that there were also some candidates who did not have a own page running their ads (e.g. Johannes Voggenhuber). They are missing.
3.2 Spending
3.2.1 Total spending
But the mere number of ads alone doesn’t tell us much. Let’s see how much the different candidates/their pages spent on their ads. Unfortunately, here comes a in my view major and annoying limitation of FB’s API data into play. The data provided via the API does not stipulate the exact amount spent for a specific ad, but provides the lower and upper bound of a price interval in which the ad falls, e.g. 0-99€, 100-499€, 500-999€, 1000-4999€,…. While one may forgive this imprecision when dealing with only one cheap ad (0-99€), the shortcoming aggravates with more expensive ads (e.g. 5000-9999€) and furthermore as one aggregates intervals (the lower and upper bounds) for multiple ads. Hence, instead of an exact sum we are limited to pretty wide intervals in which the actual total amount spent on ads falls. I am not entirely clear why facebook doesn’t provide the exact amount per ad since it undermines the entire purpose of the library (if you happen to know a work-around how to get the exact numbers, let me know).
The interval bounds are stored in a list column (spend) which needs hence to be unnested. The unnest_wider function of the development version of tidyr is a convenient way to implement this and creates the two new columns spend_lower_bound and spend_upper_bound. In addition, I calculate the mid point for each ad’s interval (spend_mid). Aggregating these three values for all ads of a candidate results in the following totals:
df_x1 <- df_x %>%
unnest_wider(spend, names_sep = "_") %>%
mutate_at(vars(contains("bound")), as.numeric) %>%
mutate(spend_mid=(spend_upper_bound-spend_lower_bound)/2+spend_lower_bound) %>%
mutate(spend_interval=paste0(comma(spend_lower_bound),"-",comma(spend_upper_bound))) %>%
mutate(spend_interval=forcats::fct_reorder(spend_interval, spend_mid)) %>%
mutate(spend_interval=forcats::fct_expand(spend_interval, "5,000-9,999")) %>%
mutate(spend_interval=forcats::fct_relevel(spend_interval, "5,000-9,999", after=4))
#manually added 5,000 - 9,9999 interval since its missing in data; no add recroded for this
#interval
df_spend_total <- df_x1 %>%
group_by(candidate) %>%
summarise(spend_min_total=sum(spend_lower_bound, na.rm = T),
spend_mid_total=sum(spend_mid, na.rm=T),
spend_max_total=sum(spend_upper_bound, na.rm=T))
max_spend <- max(df_spend_total$spend_max_total)
df_spend_total %>%
ggplot()+
geom_errorbar(aes(x=reorder(candidate, spend_mid_total),
xend=reorder(candidate, spend_mid_total),
ymin=spend_min_total, ymax=spend_max_total,
color=candidate))+
geom_point(aes(x=reorder(candidate, spend_mid_total),
y=spend_mid_total,
color=candidate))+
geom_text(aes(x=reorder(candidate, spend_mid_total),
y=max(df_spend_total$spend_max_total)+50000,
label=paste(dollar(spend_min_total, prefix="€ "))),
size=4,
hjust=1,
color="grey70")+
geom_text(aes(x=reorder(candidate, spend_mid_total),
y=max(df_spend_total$spend_max_total)+100000,
label=paste(dollar(spend_mid_total, prefix="€ "))),
size=4,
hjust=1,
color="grey70")+
geom_text(aes(x=reorder(candidate, spend_mid_total),
y=max(df_spend_total$spend_max_total)+150000,
label=paste(dollar(spend_max_total, prefix="€ "))),
size=4,
hjust=1,
color="grey70")+
geom_text(data=data.frame(y = c(max_spend+50000,
max_spend+100000,
max_spend+150000),
label = c("min", "mid", "max")),
x=length(unique(df_spend_total$candidate))+1,
aes(y=y,
label=label),
size=4,
hjust=1,
vjust=1,
color="grey70")+
labs(title="Total spending on FB ads",
subtitle="Ads created between 1 May and 26 May 2019. Instead of exact amounts, Facebook's API only provides \nlower and upper bounds of each ad's price.",
caption="Roland Schmidt | @zoowalk | http://werk.statt.codes")+
hrbrthemes::theme_ft_rc()+
theme(axis.title = element_blank(),
panel.grid.major.y = element_blank(),
legend.position="none")+
scale_color_manual(values=vec_candidate_colors)+
scale_y_continuous(labels=scales::dollar_format(prefix="€"),
breaks=seq(0, 200000, 50000),
minor_breaks = seq(25000, 175000, 50000),
expand=expand_scale(mult=c(0, 0.02)))+
scale_x_discrete(expand=expand_scale(add=c(0,1.1)))+
coord_flip()
The above graph makes the shortcoming of the spending intervals clearly visible. For example, the total spending of ads run by the page of FPÖ candiate Harald ‘Taser’ Vilimsky fell anywhere between 44,100 € and 203,934 €. Such wide intervals not only render it difficult to make meaningful statements about a candidate’s expenditures, they also limit the ability to the make definite statements when comparing two candidates.
If we take the intervals’ mid points as points of reference, the page of Vilimsky from the exterem reight spent most money on ads, followed by the page of ÖVP’s Winzig. Again, at least to me, the prominent role of Winzig comes as a surprise. Vilimsky’s leading position here is insofar remarkable considering his comparably low number of ads. This can be explained if investigate into which spending category each ad actually fell.
3.2.2 Number of ads per category
ads_per_category <- df_x1 %>%
#unite(spend_interval, c("spend_lower_bound", "spend_upper_bound"), sep="-") %>%
group_by(candidate, spend_interval, .drop=F) %>%
summarise(n_ads=n()) %>%
arrange(candidate)
plot_ads_per_category<- ads_per_category %>%
ggplot()+
geom_bar(aes(x=spend_interval,
y=n_ads,
fill=candidate),
color="transparent",
stat="identity")+
geom_text(data=. %>% filter(n_ads>0),
aes(x=spend_interval,
y=n_ads,
label=n_ads),
nudge_x=0.05,
hjust=0)+
labs(title="Number of Facebook ads per spending category",
subtitle=paste0("Note different scales on x axis; ", "Period from ",
format(date(date_observation_start), "%a, %d %b %Y"), " to ",
format(date(date_observation_end), "%a, %d %b %Y")),
x="Number of ads",
y="Spending category",
caption="Roland Schmidt | @zoowalk | http://werk.statt.codes")+
scale_y_continuous(expand=expand_scale(mult=c(0, 0.2)),
breaks=waiver(),
minor_breaks = NULL)+
hrbrthemes::theme_ft_rc()+
scale_fill_manual(values=vec_candidate_colors) +
theme(axis.title=element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.y = element_blank(),
legend.position = "none")+
facet_wrap(vars(candidate),
scales = "free_x",
ncol=3)+
coord_flip()
plot_ads_per_category
Remarkably while some of his competitors invested in more, but cheaper ads, Vilimsky e.g. bought two ads of the most expensive category (10,000to 49,999 €). No other candidate bought ads falling into this category. A further noticeable detail from the above graphs, while candidates of the ÖVP were by and large among the more generous advertisers, they invested their money in many cheaper ads. While I can only speculate, these numbers would be in line with campaigns which feature many tailored ads for specific audiences in contrast to few, more general ads addressed to a wider crowd.
The bar graphs provide also some explenation for the wide spending intervals in the preceeding graph. Many candidates have the bulk of their ads from the least expensive category which spans from 0 to 99 Euros. When accummulating the lower bound of 0, the lower bound of the total interval remains 0, hence stretching the overall margin (whether it is likely that ads costed 0€ is another story). As for the most expensive ads, their category spans from 10,000€ to 49,999€ and hence introduces alreday an imprecission of +/- 20,000 € when aggregating.
3.2.3 Timeline
Facebook’s API provides us also with the date when the ad was created (what is different to the dates when an ad was running). Mapping the creation date and the price of each ad (here I use the mid-point of the price interval) may give us some idea of the dynamics of the electoral campaign.
ads_per_day <- df_x1 %>%
mutate(ad_created_day=lubridate::date(ad_creation_time)) %>%
group_by(candidate, ad_created_day, party) %>%
summarise(n_ads_per_day=n())
ads_time_line <- df_x1 %>%
mutate(ad_created_day=lubridate::date(ad_creation_time)) %>%
select(-spend_interval) %>%
group_by(candidate, ad_created_day, party) %>%
summarise_at(vars(contains("spend")), .funs=list(sum=~sum(., na.rm=T))) %>%
ungroup()
ads_time_line %>%
ggplot()+
geom_vline(data=date_indicators,
aes(xintercept=date, color=event),
labels=c("Ibiza video", "EP Elections"))+
geom_bar(aes(x=ad_created_day,
y=spend_mid_sum,
fill=candidate),
color="transparent",
stat="identity",
show.legend=F) +
geom_errorbar(aes(x=ad_created_day,
ymin=spend_lower_bound_sum,
ymax=spend_upper_bound_sum),
color="grey",
show.legend=F)+
labs(title="Amount spent on newly created ads per day",
x="day of creation of ad",
y="Amount in thousands (€)",
# caption=paste(my_caption),
subtitle=paste("Period from", format(date_observation_start, "%a, %d %b %y"),
"to",
format(date_observation_end, "%a, %d %b %y"))) +
hrbrthemes::theme_ft_rc()+
theme(panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
legend.title = element_blank(),
legend.justification = "right",
legend.position = "bottom",
panel.spacing = unit(0,"cm"))+
scale_x_date(breaks=scales::date_breaks(width="1 week"),
labels=scales::date_format("%b %d"))+
scale_y_continuous(minor_breaks = NULL,
labels = scales::comma_format(scale=0.001))+
scale_fill_manual(values=vec_candidate_colors)+
facet_rep_wrap(vars(candidate),
ncol=2,
repeat.tick.labels = c("all"))
Somewhat unsurprisingly, HC Strache stopped buying any FB’ads following the release of the ‘Ibiza video’. In contrast, his colleague Vilimsky placed ads worth in total between 14,600 Euros and 40,531.5 € between the scandal’s emergence and the elections.
vilimsky_post_ibiza<- ads_time_line %>%
filter(str_detect(candidate, "Vilimsky")) %>%
filter(ad_created_day %within% interval(ibiza_video$date,
date_observation_end)) %>%
summarise_at(vars(contains("spend")), .funs=list(total=~sum(., na.rm=T)))
vilimsky_post_ibiza## # A tibble: 1 x 3
## spend_lower_bound_sum_total spend_upper_bound_sum_tot~ spend_mid_sum_tot~
## <dbl> <dbl> <dbl>
## 1 14600 66463 40532.3.3 Number of ads running per day
A further angle to look at the campaign is to investigate into the number of running ads at any day during the observed period. The graph below gives the answer.
#checks
ads_ongoing<- df_x %>%
select(candidate, ad_delivery_start_time, ad_delivery_stop_time, party) %>%
mutate(ad_delivery_stop_time_rev=case_when(
is.na(ad_delivery_stop_time) ~ date_observation_end,
ad_delivery_stop_time > date_observation_end ~ date_observation_end,
TRUE ~ as.Date(ad_delivery_stop_time)
)
)
#ads with missing end date get today's date
ads_per_day<- df_x %>%
select(page_name, ad_delivery_start_time, ad_delivery_stop_time, party) %>%
mutate(ad_delivery_stop_time_rev=case_when(is.na(ad_delivery_stop_time) ~ date_observation_end,
ad_delivery_stop_time > date_observation_end ~ date_observation_end,
TRUE ~ lubridate::as_date(ad_delivery_stop_time)))
#pad timeline
ads_per_day <- ads_per_day%>%
select(page_name, ad_delivery_start_time, ad_delivery_stop_time_rev, party) %>%
mutate_at(vars(contains("delivery")), lubridate::date) %>%
group_by(page_name) %>%
mutate(ad_index=row_number()) %>%
pivot_longer(cols=contains("delivery"),
names_to = "start_end_date",
values_to = "dates") %>%
padr::pad(., interval="day",
by="dates",
group=c("page_name", "ad_index")) %>%
arrange(page_name, ad_index)
#summarise per day
ads_per_day <- ads_per_day %>%
group_by(page_name, dates) %>%
summarise(n_ads_day=n())
#add total ads per page
n_ads_per_page <- df_x %>%
group_by(page_name) %>%
summarise(n_ads=n())
ads_per_day <- ads_per_day %>%
left_join(., n_ads_per_page, by=c("page_name"))
#add party affiliation
ads_per_day <- ads_per_day %>%
mutate(candidate=stringr::str_extract(page_name, paste(df_candidates$candidate, collapse = "|"))) %>%
left_join(., df_candidates, by=c("candidate")) %>%
ungroup()
#define annotations
ads_per_day_annotation <- tibble::tribble(
~page_name, ~text_x, ~text_y, ~text, ~arrow_x, ~arrow_y,
"Andreas Schieder", "28/05/2019", 50, "Number drops before elections.", "20/05/2019", 20,
"HC Strache", "28/05/2019", 30, "Almost all ads end following Ibiza video", "20/05/2019", 20
) %>%
mutate_at(vars(contains("_x")), as.Date, format="%d/%m/%Y") %>%
mutate(text=str_wrap(text, width=15))
#labeller
labeller <- ads_per_day %>%
arrange(party) %>%
mutate(facet_label=paste0(stringr::str_to_upper(page_name)," (", party, ")",
"\ntotal number of ads: ", n_ads)) %>%
select(page_name, facet_label) %>%
distinct()
vec_labeller <- labeller$facet_label
names(vec_labeller) <- labeller$page_name
#plot
ads_per_day %>%
arrange(party) %>%
mutate(facet_label=paste0(stringr::str_to_upper(page_name)," (", party, ")",
"\ntotal number of ads: ", n_ads) %>%
as.factor %>% forcats::fct_inorder(.)) %>%
ggplot()+
labs(title="Number of ads running",
subtitle=glue::glue("Period from {date_observation_start} to {date_observation_end}; Note different scales on y-axis."),
caption=my_caption,
y="Number of ads running")+
geom_rect(xmin=lubridate::ymd("2019-05-27"),
xmax=Inf,
ymin=0,
ymax=Inf,
fill="#252a32",
color="#252a32")+
geom_text(data=ads_per_day_annotation,
aes(x=text_x,
y=text_y,
label=text,
group=page_name),
color="grey80",
lineheight=0.7,
family= "Roboto Condensed",
vjust=1,
hjust=0)+
geom_curve(data=ads_per_day_annotation,
aes(xend=arrow_x,
x=text_x,
yend=arrow_y,
y=text_y),
color="grey80",
arrow = arrow(length = unit(0.1,"cm")),
curvature = 0.2)+
geom_bar(aes(x=dates,
y=n_ads_day),
stat="identity")+
geom_vline(data=date_indicators,
aes(xintercept=date, color=event),
key_glyph=draw_key_path)+
hrbrthemes::theme_ft_rc()+
theme(panel.spacing = unit(0, "cm"),
legend.position = "bottom",
legend.justification = "right",
legend.title=element_blank(),
# strip.text = element_text(color=party),
panel.grid.minor.x = element_blank(),
axis.title.x=element_blank())+
scale_y_continuous(expand=expand_scale(mult=c(0,0.05)),
minor_breaks = NULL)+
scale_x_date(breaks=seq.Date(date_observation_end-lubridate::weeks(4), date_observation_end, by = "week"),
labels=scales::date_format("%b %d"),
expand=expand_scale(mult=c(0, 0.4))) +
facet_rep_wrap(vars(page_name),
labeller=labeller(page_name=vec_labeller),
repeat.tick.labels = c("all"),
scales = "free_y",
ncol=2)
Again, the sudden drop in Strache’s ads stands out. Remarkably though, there are a few other candidates whose numbers also dropped in the run-up to the elections (Wiener, Winzig, Schieder). I don’t have any definite answer for that and can hence only speculate. Maybe fewer ads mean that parties were concentrating their campaign on a some specific ads to get their main message across. To be clear, a lower number in ads doesn’t necessarily mean that fewer people see ads. It’s entirely possible to have few ads but with a similarly sized audience as with a higher number of ads. Furthermore, it might be that other pages (e.g. facebook pages of the political parties) scaled up their advertising activities.
4 Funding
Distinct from the page which runs the ads (i.e. candiates’ page), is an ad’s funding entity which is billed for the ads. With this information available, we not only can (roughly) calculate how much each funding entity contributed, but also how important each funding enttiy was to the ads run by an individual candidate’s campaign. However, since we only have the lower and upper bounds of an ad’s price, the calculation of a funding entity’s contribution is again limited to an interval rather than a precise number.
contribution_funder_page <- df_x1 %>%
select(candidate, contains("spend"), funding_entity) %>%
group_by(candidate, funding_entity) %>%
summarise_at(vars("spend_lower_bound",
"spend_upper_bound",
"spend_mid"), sum)
contribution_funder_page_plot <- contribution_funder_page %>%
ggplot()+
labs(title="Who paid for a candidate's ads?",
subtitle="Line ends are minimum and maximum possible values. Since FB's ad library only provides lower- and \nupper-bounds of an ad's price, the minimum and maximum bounds have to be aggregated.",
caption="Roland Schmidt|@zoowalk",
y="€ amount in thousands")+
geom_errorbar(aes(x=funding_entity,
ymin=spend_lower_bound,
ymax=spend_upper_bound,
color=candidate),
show.legend = FALSE)+
geom_point(aes(x=funding_entity,
y=spend_mid,
color=candidate),
show.legend = FALSE)+
scale_x_discrete(labels=function(x){stringr::str_wrap(x, 10)})+
scale_y_continuous(labels=scales::comma_format(scale=0.001))+
scale_color_manual(values=vec_candidate_colors)+
lemon::facet_rep_wrap(vars(candidate),
scales = "free_y",
repeat.tick.labels = c("all"),
ncol=2)+
hrbrthemes::theme_ft_rc()+
theme(axis.title.y = element_blank(),
panel.spacing = unit(0, "cm"),
panel.grid.major = element_blank(),
panel.grid.major.y = element_blank())+
coord_flip()
contribution_funder_page_plot
The above graph pertains partly to the ongoing debate about campaign and party financing. Obviously, while the person/organisation who paid for an ad (in FB’s terminology ‘funding entity’) may or may not be the source who actually financed an ad, the information available still provides some - at least to me - noteworthy details.
Interestingly, there is considerable variation within the ÖVP. Only the ads run by its leading candidate Othmar Karas were paid by the ÖVP ‘main’ party. Winzig’s entire FB campaign was paid by the Wirtschaftsbund, an ÖVP related association representing business interests. Edstadler’s ads were paid by the ÖVP Salzburg, the party’s regional branch of her home state. Finally, Lukas Mandl’s entire FB campaign was paid by a private association, VSM. Following the Ibiza scandle, the use of private associations to fund election campaigns became particularly scrutinised since it may provide an avenue to circumvent party financing restrictions.
As for the 1Europa/Jetzt, I have to admit that I have no idea who Peter Glawischnig is. And I have the feeling I am not alone with this.
5 Impressions
5.1 Impressions per candidate
The data provided by FB’s API includes also details on an ad’s ‘impression’ . An ad’s impression indicates how often an add appeared on a screen. Note that this is different from the number of unique persons who saw an ad. If a user sees an ad and subsequently the same ad reposted by one of his ‘friends’, the impression count would be two. Bearing this difference and the entailed limitations in mind, an ad’s impression can still provide a rough indication on how large an ad’s audience has been. This limitation is, however, further aggrevated by FB providing (again) only the lower and upper bounds of an interval in which an ad’s impression count falls. Similar to the above encountered shorcoming when aggregating spending intervals, the imprecision accummulates when aggregating the impressions of multiple ads.
But before simply accumulating ads’ impressions, one further aspect has to be accounted for. So far the analysis was based on all ads created in the period between 1 May and election date. When analysing the impressions, I am exclusively interested in the impressions created during this period, the run-up to the elections. There are however a few ads which were created and started to run in the run-up, but which continued to run beyond election date. Strictly speaking, when considering the impression of these ads, we cannot know whether the detailed impressions were triggered before or after election date. Including them may, at least theoretically, unduely inflate a candidate’s impression count. Hence, to err on the side of caution, I exclude these ads. Overall, there are only 50 ads which fall into this category (49 by Winzig, 1 by Steger).
impression_per_ad <- df_x1 %>%
ungroup() %>%
unnest_wider(impressions, names_sep="_") %>%
select(ad_id, candidate, contains("impressions")) %>%
select(-"impressions_...1") %>%
mutate_at(vars("impressions_lower_bound",
"impressions_upper_bound"),
as.numeric) %>%
mutate(impressions_category=paste(scales::comma(impressions_lower_bound),
"-",
scales::comma(impressions_upper_bound))) %>%
mutate(impressions_mid=(impressions_upper_bound-impressions_lower_bound)/2+impressions_lower_bound) %>%
mutate(impressions_category=as.factor(impressions_category) %>%
forcats::fct_reorder(., impressions_mid))
df_impression_per_candidate <- impression_per_ad%>%
group_by(candidate) %>%
summarise(sum_impressions_upper=sum(impressions_upper_bound, na.rm = T),
sum_impressions_lower=sum(impressions_lower_bound, na.rm = T),
sum_impressions_mid=sum(impressions_mid, na.rm = T))
plot_impressions_total <- df_impression_per_candidate %>%
ggplot()+
geom_errorbar(aes(x=reorder(candidate, sum_impressions_mid),
# y=sum_impressions_mid,
ymin=sum_impressions_lower,
ymax=sum_impressions_upper,
color=candidate),
show.legend = F)+
geom_point(aes(x=reorder(candidate, sum_impressions_mid),
y=sum_impressions_mid,
color=candidate),
show.legend = F)+
scale_color_manual(values=vec_candidate_colors)+
geom_text(aes(y=max(df_impression_per_candidate$sum_impressions_upper)+3000000,
x=candidate,
label=paste(format(round(sum_impressions_lower/1000000, 2), nsmal=2),
format(round(sum_impressions_mid/1000000, 2), nsmal=2),
format(round(sum_impressions_upper/1000000, 2), nsmal=2),
sep=" / ")),
family="Roboto Condensed",
size=3.5,
color="grey80",
hjust=0)+
geom_text(data=data.frame(),
aes(y=max(df_impression_per_candidate$sum_impressions_upper)+3000000,
x=length(df_impression_per_candidate$candidate)+0.5),
label=c("min / mid / max values"),
family="Roboto Condensed",
fontface="plain",
size=3.5,
color="grey80",
hjust=0)+
labs(title="Total number of impressions",
subtitle=glue::glue("Impression: 'The number of times your ads were on screen (Facebook)'; \nAds created between {format(date_observation_start,'%d %b %y')} and {format(date_observation_end, '%d %b %y')}"),
y="Number of impressions in millions",
caption=my_caption)+
scale_y_continuous(labels=scales::comma_format(scale=1/1000000, suffix="m"),
breaks=seq(0, 15000000, 5000000),
minor_breaks = seq(2500000, 12500000, 5000000),
expand=expand_scale(mult=c(0.05, 0.2)))+
hrbrthemes::theme_ft_rc()+
theme(axis.title.y=element_blank(),
panel.grid.major.y = element_blank())+
coord_flip()
plot_impressions_total
The analysis reveals (again) the strong campaign by Vilimsky and Winzig, but also a high overall impression of ads run by NEOS candiate Claudia Gamon. Taking the mid-points of the impression intervals, ads by Vilimisky’s page were seen 9 million times, Winzig’s around 6.26 million times, and Gamon’s around 6.06 million times. Contrasting Gamon’s impression count is particularly remarkable if we consider the number of ads placed and her total spending interval.
5.2 Ads per impression and spending interval
To get a more nuanced understanding of where ads’ impressions came from, we can check how many ads fall into which impression category. Furthermore, to see how impressions relate to spending, we can further distinguish ads as to their spending category.
impression_per_spending <- impression_per_ad %>%
left_join(., df_x1 %>% select(ad_id, contains("spend"))) %>%
group_by(candidate, impressions_category, spend_interval, .drop=F) %>%
summarise(n_obs=n())
impression_per_spending_plot <- impression_per_spending %>%
ggplot()+
geom_bar(aes(x=impressions_category,
y=n_obs,
color=spend_interval,
fill=spend_interval),
stat="identity",
position=position_stack(),
key_glyph="point")+
facet_wrap(vars(candidate),
scales = "free_x")+
labs(title="Number of ads per impression and spending interval",
subtitle=glue::glue("Impression: 'The number of times your ads were on screen (Facebook)'; Ads created between {format(date_observation_start,'%d %b %Y')} \nand {format(date_observation_end, '%d %b %Y')}; Note different scale on x axis."),
x="number of impressions",
y="number of ads",
caption=my_caption)+
coord_flip()+
hrbrthemes::theme_ft_rc()+
theme(legend.position = "top",
legend.justification = "left",
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank())+
scale_fill_viridis_d(name="Spending interval of ad (€)")+
scale_color_viridis_d(name="Spending interval of ad (€)")+
guides(fill=guide_legend(override.aes = list(size = 5), reverse=F, nrow=1),
color=guide_legend(nrow=1, reverse=F))
impression_per_spending_plot
The graph above reveals that much of Vilimsky’s total impressions count (or better the impressions of his ads) comes from a few ads in high impression categories. E.g. Vilimsky had four ads which fell into the 500,000 - 999,9999 impressions category, and nine which fell into the 200,000 - 499,999 impressions category. As the color indicator further reveals, the more impressions, the more expensive an ad had been. In short, relatively few, yet expensive ads did the heavy lifting. Strikingly (and very annoyingly), there is no information on the impressions of the two ads in the 10,000 - 49,999 Euro category (NA; i have no idea why this is the case, but I would be curious to know). Hence, the actual impression count of Vilimsky is likely to be higher. In stark contrast, if we look e.g. at the ads of the ÖVP candidates, the total of impressions is largely driven by the high number of ads in the lowest impression category.
6 Gender and age of audience
The list column demographic_distribution contains data on the composition of the audience of each ad in terms of genderand age. According to FB’s own definition, the meaning of audience is conceptualized as ‘people reached by the ad.’ Hence, we are talking about distinct indiviudals as the unit of observation and not, as in the case of impressions, about appearances on a screen.
With gender and age nested, the list column can be a somewhat cumbersome format to deal with. To get a better grip on the data, I unnest it by using first unnest_longer and then unnest_wider. This will provide us with three new columns: age, gender, and percentage. Below an example of one ad after transforming the nested list:
#unnest list
df_demographics_unnested <- df_x1 %>%
select(ad_id, demographic_distribution, candidate) %>%
unnest_longer(demographic_distribution) %>%
unnest_wider(demographic_distribution)
#create observation for each gender-age combination; otherwise means are wrong;
#fills missing age-gender combinations with 0
df_demographics_unnested <- df_demographics_unnested %>%
mutate(percentage=as.numeric(percentage)) %>%
mutate(gender=as.factor(gender),
age=forcats::fct_relevel(age, levels=c("13-17", "18-24", "25-34", "35-44", "45-54", "55-64", "65+")))
df_demographics_unnested <- df_demographics_unnested %>%
complete(ad_id, nesting(age, gender), fill=list(percentage=0)) %>%
group_by(ad_id) %>%
fill(candidate, .direction = c("downup")) %>%
ungroup()
#check
n_age <- length(levels(df_demographics_unnested$age))
n_gender <- length(levels(df_demographics_unnested$gender))
n_ads <- length(unique(df_demographics_unnested$ad_id))
n_age * n_gender * n_ads #49833## [1] 50757#ad impression of each ad (use mid-point)
df_demographics_unnested <- df_demographics_unnested %>%
left_join(., impression_per_ad %>% select(ad_id, impressions_mid))
#get one example
df_demographics_unnested %>%
filter(ad_id=="AndreasSchieder-2019-05-01-83") %>%
select(everything(), ad_id, -candidate)## # A tibble: 21 x 5
## ad_id age gender percentage impressions_mid
## <chr> <fct> <fct> <dbl> <dbl>
## 1 AndreasSchieder-2019-05-01-83 13-17 female 0 150000.
## 2 AndreasSchieder-2019-05-01-83 13-17 male 0 150000.
## 3 AndreasSchieder-2019-05-01-83 13-17 unknown 0 150000.
## 4 AndreasSchieder-2019-05-01-83 18-24 female 0 150000.
## 5 AndreasSchieder-2019-05-01-83 18-24 male 0 150000.
## 6 AndreasSchieder-2019-05-01-83 18-24 unknown 0 150000.
## 7 AndreasSchieder-2019-05-01-83 25-34 female 0.0531 150000.
## 8 AndreasSchieder-2019-05-01-83 25-34 male 0.267 150000.
## 9 AndreasSchieder-2019-05-01-83 25-34 unknown 0.00218 150000.
## 10 AndreasSchieder-2019-05-01-83 35-44 female 0.0645 150000.
## # ... with 11 more rowsThe table above takes one (1) ad ran by SPÖ candidate Andreas Schieder as an example. The percentage values sum up to 1 (100 %). The data in the three new columns hence provide a description of the composition of the audience for this specific ad in terms of the audience’s gender and age. In this case 6.4 % were female facebook users aged between 35 and 44 years; 19,7 % of those who had seen the ad were male FB users aged between 35 and 44 years etc.
Since the data on the composition of the audience doesn’t tell us anything on the size of the audience, I included the previously extracted information on each ads’ number of impressions (mid point of the interval). These numbers will serve later to compute the weigthed mean.
6.1 Audience per age group
6.1.1 Boxplot
To get a more fine grained understanding of each candidate’s overall audience, let’s contrast candidates’ audiences first by age and then by gender
df_age <- df_demographics_unnested %>%
group_by(candidate, age, impressions_mid, ad_id) %>%
summarise(sum_percentage=sum(percentage, na.rm = T))
df_age_stats <- df_age %>%
group_by(candidate, age) %>%
summarise(median_ad=median(sum_percentage, na.rm = T),
sd_ad=sd(sum_percentage, na.rm = T))
df_age %>%
ggplot()+
geom_boxplot(aes(x=age,
y=sum_percentage,
#weight=impressions_mid,
color=candidate,
),
fill="transparent")+
geom_text(data=df_age_stats,
aes(x=age,
label=paste0(round(median_ad*100, 1),
"\n(",
round(sd_ad*100, 1),
")")),
label.padding=0,
lineheight=0.8,
size=4,
y=1.3)+
labs(title="Distribution of ads'audience over age groups",
subtitle="Each ad has an audience of 100 % over all age groups. Each dot represents the age group's\nshare of the total 100 %. Top: Median and standard deviation (in brackets).",
y="Share of age group in ad's overall audience",
x="Age group",
caption=my_caption)+
facet_rep_wrap(candidate~.,
ncol=2,
# labeller=as_labeller(function(x) paste("age group:", x)),
repeat.tick.labels = T)+
scale_color_manual(values=vec_candidate_colors)+
scale_y_continuous(labels=scales::percent,
breaks=seq(0,1, .25),
expand = expand_scale(mult=c(0, 0.5)))+
hrbrthemes::theme_ft_rc()+
theme(panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
# panel.spacing.y = unit(0, "cm"),
axis.text.x = element_text(size = 10),
legend.position="none",
strip.text = element_text(colour = "white"),
panel.grid.minor.x = element_blank())
For those not familiar with boxplots, a few explanatory remarks upfront. The line inside of the box represents the median, or 50th quantile, of all observed values. The lower end of the box is the 25th quantile, the upper end the 75th. This means that inside of the box there are 50 % (25th to 75th quanitle) of all observations. Here one observation is the share of a certain age segment in an ad’s total audience over all age segments (100 %). The distance between the 25 % and 75 % is also called inter-quartile range. The lines, called whiskers, run from the box to the smallest/largest value no further than 1.5 times the inter-quartile range. Values which fall outside are outliers and are represented by the dots (for details see here .
There is obviously plenty of info in the graph above and I’ll only highlight that which appear most noteworthy to me. When it comes to the two youngest age segments (13-17, 18-24), the ads of SPÖ candidate Günther Sidl and Neos Claudia Gamon feature a comparabily high median share. These differences, however, disappear in subsequent age segments (25-34, 35-44). Generally, the age group 25 to 34 years features most candidates’ highest median share. Or, to put it differently, in no other age group ads were appearing on average as often as in this age group. The Green candidates Werner Kogler and Sarah Wiener feature in this age group the highest median shares (29 and 27.2 %).
The ads of Karoline Edtstadler, then secretary of state in the Ministry of Interior, feature a relative high median share of impressions in older age groups. This was a bit of a surprise to me considering her age (38). In the age categories above 45 Edtstadler’s median shares are the highest among all candidates.
What’s furthermore noteworthy is that ads of ÖVP candidates feature relatively many outliers. This means that the audience of the outlying ads were particularly concentrated in one age category. This might indicate that the ad was particularly tailored for a specific age group. That such ads are predominantly visible with ÖVP candidates might further suggest that some of their ads on Facebook were more ‘tailored’ than those of other parties.
6.1.2 Heatmap
# calculate weighted average
df_demographics_all_ads <- df_demographics_unnested %>%
group_by(candidate, gender, age) %>%
filter(!is.na(impressions_mid)) %>%
summarise(mean_percentage=mean(x=percentage,
w=impressions_mid,
na.rm = T)) %>%
mutate(indicator=case_when(str_detect(candidate, "Karas|Steger|Edtstadler") & gender=="male" & age %in% c("55-64", "45-54") ~ "1",
str_detect(candidate, "Karas") & gender=="male" & age %in% c("65+") ~ "1",
TRUE ~ as.character("0"))) %>%
ungroup()
#check: sum of all weighted means per candidate is 1
check <- df_demographics_all_ads %>%
group_by(candidate) %>%
summarise(sum_mean_percentage=sum(mean_percentage))
#plot
df_demographics_all_ads %>%
filter(gender %in% c("male", "female")) %>%
ggplot()+
geom_tile(aes(x=gender, y=age,
fill=mean_percentage))+
geom_text(aes(x=gender, y=age,
label=scales::percent(mean_percentage),
color=indicator),
size=4)+
scale_color_manual(values=c("1"="orange", "0"="grey"))+
labs(title="Average audience share by age and gender",
caption="Roland Schmidt | @zoowalk | http://werk.statt.codes")+
hrbrthemes::theme_ft_rc()+
theme(legend.position="none",
panel.grid = element_blank())+
lemon::facet_rep_wrap(vars(candidate),
repeat.tick.labels = T,
ncol=3)
The tile graph/heatmap above gives the composition of the audience of a candidate’s ads by age group and gender on average (weighted mean, the sum of all tiles amounts to 100 % what is the total audience (=total number of impressions). What is noteworthy is that the largest audience segment for all candidates have been male Facebook users in the age bracket of 25 to 34 years. Generally, there is an over-representation of male audience.
6.2 Audience’s gender
If we contrast the weighted mean values between the female and male share, we get the (average) female or male surplus of a candidate’s audience within each age group. As the figure below highlights, almost all candidates have more men than women in their ads’ audience. The male surplus is particularly pronounced in the 25 to 34 years age bracket and decreases the older the audience becomes. But there is one clearly deviant case: Sarah Wiener from the Green party. The political newcomer and Austria’s answer to Jamie Oliver has reached on average more women than men across all age groups.
df_female_male <- df_demographics_all_ads %>%
select(-indicator) %>%
pivot_wider(., names_from = "gender", values_from = "mean_percentage") %>%
mutate(diff_female_male=female-male)
df_female_male %>%
ggplot()+
geom_bar(aes(x=age, y=diff_female_male,
fill=ifelse(diff_female_male>0.000, "female surplus", "male surplus"),
color=ifelse(diff_female_male>0.000, "female surplus", "male surplus")),
stat="identity",
key_glyph= "point")+
labs(y="difference between female and male mean audience share (percentage points)",
title="Difference between female and male mean audience share",
subtitle=stringr::str_wrap("Almost all candidates feature a larger mean male audience share across all age segments. Difference of means weighted by impression count (mid-point) of each ad.", 75))+
scale_y_continuous(limits=c(-0.12,0.12),
labels=function(x) scales::percent(abs(x), accuracy = 1))+
facet_wrap(vars(candidate), nrow=3)+
coord_flip()+
hrbrthemes::theme_ft_rc()+
theme(panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "bottom",
legend.justification = "right",
legend.title=element_blank(),
axis.text.y = element_text(size=9))+
scale_fill_manual(values=c("female surplus"="orange",
"male surplus"="steelblue"))+
scale_color_manual(values=c("female surplus"="orange",
"male surplus"="steelblue"))+
guides(fill = guide_legend(override.aes = list(size = 5), reverse=T),
color=guide_legend(reverse=T))
*** # Regional distribution Similar to the boxplot on the demographic composition, the plot below presents the regional distribution of ads’ audiences. The line inside the box(plot) is again the median share. The regional shares of one ad amount to 100 % over all regions. In addition to the median regional share, the mean share weighted with each ad’s impression (how often an ad appeared on a screen) is presented.
df_region <- df_x1 %>%
mutate(ad_id=as_factor(ad_id)) %>%
select(ad_id, region_distribution, candidate) %>%
unnest_longer(region_distribution) %>%
unnest_wider(region_distribution)
df_region <- df_region %>%
mutate(percentage=as.numeric(percentage)) %>%
mutate(region=as_factor(region))
#create observation for every ad for every region
df_region <- df_region %>%
mutate(region=forcats::fct_infreq(region, ordered=T)) %>%
complete(ad_id, nesting(region), fill=list(percentage=0)) %>%
group_by(ad_id) %>%
arrange(candidate) %>%
fill(candidate, .direction = c("down")) %>%
filter(region %in% c("Upper Austria", "Lower Austria", "Burgenland",
"Carinthia", "Salzburg", "Styria", "Tyrol", "Vorarlberg",
"Vienna")) %>%
ungroup()
#median and weighted mean + indicator for coloring text
df_mean_median <- df_region %>%
left_join(.,
impression_per_ad %>% select(ad_id, impressions_mid),
by=c("ad_id")) %>%
group_by(candidate, region) %>%
summarise(ad_mean=weighted.mean(percentage,
w=impressions_mid,
na.rm=T),
ad_median=median(percentage, na.rm = T)) %>%
mutate_at(vars(contains("ad")), round, 2) %>%
mutate(indicator=case_when(candidate=str_detect(candidate, "Winzig") & region=="Upper Austria" ~ "1",
candidate=str_detect(candidate, "Karas|Edtstadler") & region=="Vienna" ~ "1",
candidate=str_detect(candidate, "Mandl") & region=="Lower Austria" ~ "1",
candidate=str_detect(candidate, "ÖVP") & region=="Salzburg" ~ "1",
TRUE ~ as.character("0")))
df_region %>%
ggplot()+
geom_boxplot(aes(x=candidate,
y=percentage,
color=candidate),
fill="transparent")+
geom_text(data=df_mean_median,
aes(x=candidate,
y=1.2,
color=indicator,
label=scales::percent(ad_median, suffix = "%", accuracy = 1)
),
check_overlap=T,size=3,
hjust=1)+
geom_text(data=df_mean_median,
aes(x=candidate,
y=1.35,
color=indicator,
label=scales::percent(ad_mean, suffix= "%", accuracy = 1)
),
check_overlap=T,
hjust=1,
size=3)+
geom_text(y=c(1.2),
x=length(unique(df_region$candidate))+1,
label=c("median"),
angle=45,
hjust=0.5,
check_overlap=T,
size=3)+
lemon::facet_rep_wrap(vars(region),
repeat.tick.labels = T,
ncol=2)+
geom_text(y=c(1.35),
x=length(unique(df_region$candidate))+1,
label=c("w. mean"),
angle=45,
hjust=0.5,
check_overlap=T,
size=3)+
coord_flip()+
labs(title="Regional distribution of ads' average audiences (Bundesland)",
subtitle="Ads created between 1 and 26 May.",
y="Regional share of an ad's audience",
caption=my_caption)+
hrbrthemes::theme_ft_rc()+
theme(panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
axis.text.y=element_text(size = 10),
legend.position="none",
panel.spacing = unit(0, "cm"),
axis.title.y = element_blank(),
strip.text = element_text(colour = "white"),
panel.grid.minor.y = element_blank())+
scale_color_manual(values=c(vec_candidate_colors, "1"="orange", "0" ="grey"))+
scale_y_continuous(labels=scales::percent,
breaks=seq(0, 1, .25),
expand = expand_scale(mult=c(0, 0.1)))+
scale_x_discrete(expand=expand_scale(mult=c(0.01, 0.15)))
Again, there is plenty of info in the graph, but a few details caught my attention (highlighted in orange). The plot on Upper Austria is rather remarkable since it reveals that the ads of ÖVP candidate Winzig were almost exclusively addressed to an audience in Upper Austria, her home region. The median audience share of her ads is 100, the mean weighted with each ad’s impression is 92. The scale of Winzig’s emphasis on one region is unique, however, the ads of her party colleague Lukas Mandl also feature a strong focus on the audience in one distinct region, in his case in Lower Austria. His ads had a median share of 100 and an weighted average of 49 in the region. For Mandl, his home region Lower Austria was clearly of predominant importance.
The picture becomes further nuanced when looking at the representation of the Viennese audience in candidates’ ads. Generally, the Viennese audience was strongly represented in almost all candidates’ ads with the notable exception of Winzig and Mandl. In contrast, the ads of their party colleagues Karas and Edtstadler featured a median Viennese audience share of 88 % and 69 %. Experts on social media campaign will be better placed to comment on this conclusively, but the mere numbers seem to suggest that the campaigns of the ÖVP candidates were coordinated to avoid regional overlaps and intra-party competition (with the exception of Karas and Edtstadler).
7 Conclusion
To conclude, FB’s API provides IMHO some interesting insights into parties’ campaigning on facebook. The available data however has some considerable limitations with no exact numbers on an ads’ costs and impressions. Furthermore, with an impression being merely the appearance on a screen and not the number of unique users, the validity of impressions as an inidcator for an ads reach is compromised. Nevertheless, with this caveats in mind, some light is shed on the otherwise elusive campaigns of political parties on facebook. By no means the above results are meant to be be conclusive. Further analysis may cast a wider net and seek to include also other pages which run relevant ads, e.g. the pages of parties.