Caricare le librerie richieste

Per far sì che le librerie richieste vengano caricate correttamente dovete installarle (se non lo avete già fatto) nel vostro ambiente R. Va segnalato che lo script richiede R 4.0.x o superiore, così come il pacchetto data.table 1.12.x o superiore. Tutte le librerie possono in seguito essere caricate con il seguente codice:

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

L’ultima riga rileva il numero di core del processore del vostro PC. Questo valore sarà usato in seguito nei processi parallelizzati gestiti dai pacchetti «foreach» e «doParallel».

Estrarre dati mediante richieste effettuate all’API di ricerca

L’estrazione dei dati può richiedere tempo, dato che possono essere richiamati soltanto 100 risultati per richiesta. Per oltre 20 000 risultati, questo implica più di 200 chiamate distinte all’API di ricerca. Le richieste web sono computazionalmente poco costose, ma ognuna di esse è inevitabilmente ritardata dal traffico web. Per velocizzare in modo significativo la procedura va parallelizzato il processo utilizzando il pacchetto «foreach». Si noti inoltre che l’API di ricerca limita attualmente le richieste che vanno oltre il 9999° risultato di ricerca. Pertanto vanno effettuati cicli di richiamo dati distinti per ogni decennio, in modo da ottenere un ciclo for annidato parallelizzato. Alla fine di questo blocco di codice, i dati richiamati vanno salvati in un file locale (denominato «FilmWochenSchau.RData») per il backup, al fine di evitare una nuova chiamata all’API se involontariamente viene alterata la tabella dati.

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

Estrarre variabili con espressioni regolari

Il campo «thema» fornito dall’API di ricerca contiene più valori. Per estrarre questi valori e assegnarli alle singole colonne si possono utilizzare le espressioni regolari (RegEx). In questa fase viene anche pulita la struttura dei dati richiamati.

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

Visualizzare i dati

Lo script che segue calcola il numero di proiezioni per mese e le visualizza con l’aiuto dei «diagrammi a spicchi» introdotti da Florence Nightingale (infermiera ed esperta di statistica, 1820-1910). La visualizzazione riportata in alto su questa pagina permette di confrontare i numeri delle edizioni mensili del «Cinegiornale svizzero». La visualizzazione va salvata in un file di grafica vettoriale scalabile (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)

Scoprite il codice completo su GitHub e partecipate anche voi!

Il codice R completo è disponibile nel repository GitHub.

I dati estratti consentono numerose altre visualizzazioni e analisi.

Non esitate a creare il vostro proprio «fork»!