Die erforderlichen Bibliotheken laden

Installieren Sie die benötigten Bibliotheken in Ihrer R-Umgebung (sofern das noch nicht erfolgt ist), damit sie richtig geladen werden. Beachten Sie, dass das Skript mindestens R 4.0.x erfordert sowie mindestens das data.table-Package 1.12.x. Im Anschluss können sämtliche Bibliotheken mit folgendem Code geladen werden: 

library(httr)
library(jsonlite)
library(data.table)
library(stringr)
library(ggplot2)
library(magrittr)
library(svglite)
library(foreach)
library(doParallel)
corenum <- detectCores()

Die letzte Zeile ermittelt die Anzahl Rechenkerne auf Ihrem Rechner. Diese Information wird später über die Packages «foreach» und «doParallel» für parallelisierte Prozesse genutzt.

Daten über API-Suchanfragen abrufen

Das Abrufen der Daten kann längere Zeit dauern, da nur 100 Ergebnisse pro Abfrage abgefragt werden können. Für 20 000 Ergebnisse sind somit 200 einzelne API-Suchabfragen erforderlich. Web-Abfragen sind nicht rechenintensiv, werden aber durch den Datenverkehr im Netz verzögert. Um den Ablauf stark zu beschleunigen, parallelisieren wir die Prozesse mit dem «foreach»-Package. Beachten Sie auch, dass die API-Suche zurzeit höchstens 9999 Suchergebnisse anzeigt. Deshalb führen wir für jedes Jahrzehnt eine einzelne Abfrageschleife durch. Es handelt sich also um eine parallelisierte verschachtelte For-Schleife. Nach dem Durchlauf des Codeblocks speichern wir die abgerufenen Daten in einer lokalen Datei mit dem Namen FilmWochenSchau.RData als Backup, damit wir keine neue API-Abfrage durchführen müssen, falls wir die Datentabelle versehentlich verändern.

# The request function ----
makerequest <- function(skip,take,decade) {
  jsonrequest <- paste0('{
    "query":{
      "searchGroups":[
        {"searchFields":[
          {"key":"referenceCode","value":"J2.143#1996/386*"},
          {"key": "creationPeriod","value": "',decade,'-',decade+10,'"}
        ],"fieldOperator":1}
      ],
      "groupOperator":1
    },
    "paging":{"skip":', skip ,',"take":', take ,',"orderBy":"","sortOrder":""},
    "facetsFilters": [
      {
        "filters": ["level:\\"Dokument\\""],
        "facet": "level"
      },
      {
        "filters": [
          "aggregationFields.bestand:\\"Stiftung Schweizer Filmwochenschau (1942-1975)\\""
        ],
        "facet": "aggregationFields.bestand"
      }
    ]
  }')
  POST(
    url,
    body = minify(jsonrequest), 
    encode = "raw",
    content_type_json()
  )
}

url <- "https://www.recherche.bar.admin.ch/recherche/api/v1/entities/Search"

# Fetch all data by bunches of 100 ----
decadecounts <- data.table(decade = seq(1940,1970,by=10))
decadecounts[,count:= sapply(decade, function(x){
    res <- makerequest(1,1,x)
    fws <- content(res)
    fws$entities$paging$total
})]
cl <- parallel::makeCluster(corenum) 
doParallel::registerDoParallel(cl)
fws.datatable <- foreach(
  decade=decadecounts$decade,
  count=decadecounts$count,
  .packages = c("jsonlite","httr","data.table","magrittr"),
  .verbose = TRUE
  ) %:%
    foreach(
      i=seq(1, ceiling(count/100)*100, by = 100), 
      .combine=function(a,b)rbindlist(list(a,b))
    ) %dopar% {
      res <- makerequest(i,100,decade)
      fws <- content(res)
      data.table(
        refCode = sapply(fws$entities$items,function(x) return(x$archiveRecordId)),
        archiveID = sapply(fws$entities$items,function(x) return(x$referenceCode)),
        date = sapply(fws$entities$items,function(x) return(x$creationPeriod$text)),
        title = sapply(fws$entities$items,function(x) return(x$title)),
        dauer = sapply(fws$entities$items,function(x) return(x$customFields$format %>% unlist)),
        url = sapply(fws$entities$items,function(x) return(x$customFields$digitaleVersion %>% unlist %>% .["url"])),
        thema = sapply(fws$entities$items, function(x) x$customFields$thema %>% unlist)
      ) 
} %>% rbindlist(fill=TRUE)

save(fws.datatable,file="FilmWochenSchau.RData")

Variablen mit regulären Ausdrücken herauszuziehen

Das Feld «thema» in der API-Suche enthält verschiedene Werte. Sie können reguläre Ausdrücke (RegEx) verwenden, um diese Werte herauszuziehen und sie einzelnen Spalten zuzuordnen. Auf dieser Stufe bereinigen wir auch die abgerufene Datenstruktur.

unlistColumn <- function(column) {
  sapply(column, function(x) {
    if (!is.null(unlist(x))) {return(unlist(x))} else return(NA)
  })
}
fws.datatable$refCode <- unlistColumn(fws.datatable$refCode)
fws.datatable$archiveID <- unlistColumn(fws.datatable$archiveID)
fws.datatable$date <- unlistColumn(fws.datatable$date)
fws.datatable$title <- unlistColumn(fws.datatable$title)
fws.datatable$dauer <- unlistColumn(fws.datatable$dauer)
fws.datatable$url <- unlistColumn(fws.datatable$url)
fws.datatable$thema <- unlistColumn(fws.datatable$thema)

# Filter duplicates
fws.datatable <- unique(fws.datatable, by="refCode") 

# Then apply RegEx
fws.datatable[,thema_orte := sapply(thema, function(x) {str_match(x, "Orte:[\\r\\n ]{1,3}([^\\r\\n]*)") %>% .[2]})]
fws.datatable[,thema_schlagworte := sapply(thema, function(x) {str_match(x, "Schlagworte:[\\r\\n ]{1,3}([^\\r\\n]*)") %>% .[2]})]
fws.datatable[,dauer_dauer := sapply(dauer, function(x) {str_match(x, "Dauer: ([0-9:]*)") %>% .[2]})]
fws.datatable[,dauer_seconds := sapply(dauer_dauer, function(x) {
  ifelse(
    str_count(x,":")>1,
    as.difftime(x, format = "%H:%M:%S", units = "secs") %>% strtoi,
    as.difftime(x, format = "%M:%S", units = "secs") %>% strtoi
  )
})]
fws.datatable[,date:=as.Date(date,"%d.%m.%Y")]

Daten visualisieren

Das folgende Skript erhebt die Anzahl Sendungen pro Monat und visualisiert sie anhand von Rosendiagrammen nach Florence Nightingale (Pflegerin und Statistikerin, 1820–1910). Mit dieser Visualisierung (siehe oben auf der Seite) können Sie die Anzahl Ausgaben der Schweizer Wochenschau nach Monat vergleichen. Die Visualisierung speichern wir in einer skalierbaren Vektorgrafik (SVG).

emissions_par_date <- fws.datatable[, .N, by=date][, c("date","count","year","month", "N") := .(date,N,format(date,"%Y"),as.integer(format(date,"%m")), NULL)]
emissions_par_month <- emissions_par_date[, .(count=sum(count)), by=.(month,year)]
ggplot(emissions_par_month) +
  geom_col(aes(x=month,y=count),colour="white", fill="darkred", size=0.1) + 
  scale_x_continuous(
    breaks=c(3,6,9,12),
    minor_breaks = c(1,2,4,5,7,8,10,11)
  ) +
  coord_polar(start=pi/12) +
  facet_wrap(~year,ncol=10) +
  labs(title = "Ciné-Journal suisse",
       subtitle = "Nombre d'émissions diffusées par année et mois",
       caption = "Source: Archives fédérales suisses", 
       x = NULL, y = NULL) 
ggsave("cinejournal.svg",width=15,height=8)

Den Vollcode auf GitHub nutzen und mitmachen

Den vollstänidgen R-Code finden Sie in unserer GitHub-Ablage.

Mit den abgefragten Daten können Sie viele weitere Visualisierungen und Analysen vornehmen.

Stellen Sie Ihr eigenes «Fork» zusammen.