## Stratégies Numériques en Sciences Sociales - 2021
## Julien Boelaert, Etienne Ollion
## Séance 5 : Automatisation de la récolte
## Ce script est encodé en UTF-8 ; si les accents ne s'affichent pas bien,
## utilisez dans Rstudio le menu Fichier -> Réouvrir avec encodage...
## et choisissez UTF-8.
#############
## Préliminaires : environnement, bibliothèques
#############
rm(list = ls())
## Conseil : redémarrez la session R, Ctr+Shift+F10
setwd("~/cours/20-21 SICSS Scraping/playground/") # à adapter
## Installation des bibliothèques
# install.packages(c("httr", "XML"))
library(httr) # Pour la fonction GET
library(XML) # Pour les fonctions htmlParse, et xpathSApply
#############
## Exercice : Tables de multiplication de 1 à 10
## URL : https://css.cnrs.fr/scrape/multiplication-1.html
## https://css.cnrs.fr/scrape/multiplication-2.html, ...,
## https://css.cnrs.fr/scrape/multiplication-10.html
## Consigne : extraire toutes les multiplications des 10 tables, et stocker
## le résultat dans un seul vecteur.
#############
## Téléchargement et enregistrement en boucle for
urls <- paste0("https://css.cnrs.fr/scrape/multiplication-", 1:10, ".html")
fichiers <- paste0("multip-", 1:10, ".html")
for (ipage in 1:10) {
cat("Page ", ipage, "\n")
multip.tel <- GET(urls[ipage])
writeLines(as.character(multip.tel), fichiers[ipage])
Sys.sleep(1)
}
## Parsing en boucle for
# fichiers <- grep("^multip-\\d+[.]html$", value = TRUE, dir())
multip.parse <- list()
for (ipage in 1:10) {
multip.parse[[ipage]] <- htmlParse(fichiers[ipage])
}
multip.parse[[1]]
## (Alternative :) Parsing en lapply
multip.parse <- lapply(fichiers, htmlParse)
multip.parse[[1]]
## Extraction de toutes les multiplications des tables de 1 à 10,
## résultat stocké en un seul vecteur.
## Boucle for :
multip.extr <- NULL
for (ipage in 1:10) {
tmp <- xpathSApply(multip.parse[[ipage]], "//li", xmlValue)
multip.extr <- c(multip.extr, tmp)
}
multip.extr
## (Alternative :) Même chose en lapply
multip.extr <- lapply(multip.parse, xpathSApply, "//li", xmlValue)
multip.extr <- do.call(c, multip.extr)
multip.extr
#############
## Exercice : Page d'accueil Nobel, contenant les liens vers les pages où se
## trouvent les informations
## URL : https://www.css.cnrs.fr/scrape/nobel_accueil.html
## Consigne :
## 1 - A partir des liens présentés sur la page d'accueil, télécharger
## toutes les pages de gagnants de prix Nobel par décennie
## 2 - Extraire de ces pages l'ensemble des lauréats de physique et chimie, en
## une data.frame (une ligne par année, trois colonnes)
## 3 - Extraire des mêmes pages l'ensemble des lauréats de physique et chimie,
## en une data.frame, mais cette fois en une ligne par lauréat, en
## quatre colonnes : année, nom, discipline, lien vers la page wikipedia
#############
## Téléchargement et enregistrement de la page d'acceuil
accueil.brut <- GET("https://www.css.cnrs.fr/scrape/nobel_accueil.html")
writeLines(as.character(accueil.brut), "nobel-accueil.html")
## Parsing
accueil.parse <- htmlParse("nobel-accueil.html", encoding = "UTF-8")
## Extraction des liens vers les récipiendaires par décennie
decenn.liens <-
xpathSApply(accueil.parse, "//div[@class='row']//div[@id='price_winners']//a/@href")
decenn.liens <- paste0("https://www.css.cnrs.fr/scrape/", decenn.liens)
## Téléchargement et enregistrement en boucle for
decenn.fichiers <- gsub(".*/", "", decenn.liens)
for (i in seq_along(decenn.liens)) {
cat("GET ", i, "\n")
labrute <- GET(decenn.liens[i])
writeLines(as.character(labrute), decenn.fichiers[i])
Sys.sleep(1)
}
## Parsing en boucle for
# decenn.fichiers <- grep("^nobel_\\d.*[.]html$", value = TRUE, dir())
decenn.parse <- list()
for (i in seq_along(decenn.liens)) {
decenn.parse[[i]] <- htmlParse(decenn.fichiers[i], encoding = "UTF-8")
}
length(decenn.parse)
decenn.parse[[1]]
## Suppl : lapply
# decenn.fichiers <- grep("^winners_.*[.]html$", value = TRUE, dir())
decenn.parse <- lapply(decenn.fichiers, htmlParse, encoding = "UTF-8")
## Extraction des lauréats de physique et chimie en une ligne par année :
laur.an <- NULL
laur.phy <- NULL
laur.chimie <- NULL
for (ipage in 1:length(decenn.parse)) {
## Extraction page par page
tmp.an <- xpathSApply(decenn.parse[[ipage]], "//tr//td[1]", xmlValue)
tmp.phy <- xpathSApply(decenn.parse[[ipage]], "//tr//td[2]", xmlValue)
tmp.chimie <- xpathSApply(decenn.parse[[ipage]], "//tr//td[3]", xmlValue)
## Stockage dans des vecteurs séparés
laur.an <- c(laur.an, tmp.an)
laur.phy <- c(laur.phy, tmp.phy)
laur.chimie <- c(laur.chimie, tmp.chimie)
}
laureats.paran <- data.frame(annee = laur.an,
physique = laur.phy,
chimie = laur.chimie)
write.csv(laureats.paran, row.names = FALSE, "nobel-laureats-par-an.csv")
## Extraction des lauréats de physique et chimie en une ligne par lauréat
## Deux boucles imbriquées : pour les pages et pour les lauréats
laur.an <- NULL
laur.nom <- NULL
laur.disc <- NULL
laur.url <- NULL
for (ipage in 1:length(decenn.parse)) {
## Extraction des lauréats page par page
tmp.laureats <- xpathSApply(decenn.parse[[ipage]], "//td[2]/a | //td[3]/a")
for (ilaur in 1:length(tmp.laureats)) {
## Extraction des infos, lauréat par lauréat
tmp.nom <- xpathSApply(tmp.laureats[[ilaur]], ".", xmlValue)
tmp.url <- xpathSApply(tmp.laureats[[ilaur]], "./@href")
tmp.an <- xpathSApply(tmp.laureats[[ilaur]], "./../../td[1]", xmlValue)
tmp.disc <- xpathSApply(tmp.laureats[[ilaur]], "count(./../preceding-sibling::td)", xmlValue)
## Stockage comme vecteurs séparés
laur.nom <- c(laur.nom, tmp.nom)
laur.url <- c(laur.url, tmp.url)
laur.an <- c(laur.an, tmp.an)
laur.disc <- c(laur.disc, tmp.disc)
}
}
## Recodage de la discipline
laur.disc2 <- rep("Physique", length(laur.disc))
laur.disc2[laur.disc == 2] <- "Chimie"
laureats.parlaur <- data.frame(annee = laur.an,
nom = laur.nom,
discipline = laur.disc2,
url = laur.url)
## Enregistrement sur le disque
write.csv(laureats.parlaur, row.names = F, "laureats-par-laureat.csv")
## Toute l'extraction en une fois avec scraEP :
library(scraEP)
names(decenn.parse) <- decenn.liens
laureats.aspi <- xscrape(decenn.parse,
row.xpath = "//td[2]/a | //td[3]/a",
col.xpath = c(annee = "./../../td[1]",
nom = ".",
disc = "count(./../preceding-sibling::td)"))
## Recodage de la discipline
laureats.aspi$discipline <- "Physique"
laureats.aspi$discipline[laureats.aspi$disc == 2] <- "Chimie"
## Enregistrement sur le disque
write.csv(laureats.aspi, row.names = F, "laureats-aspi.csv")
#############
## Exercice (avancé) : extraction d'infos à partir de pages individuelles des
## lauréats de prix nobel
## URL : https://www.css.cnrs.fr/scrape/nobel_1900_1920.html
## Consigne : Construire une data.frame à un lauréat par ligne, avec en colonnes
## les informations biographique : date de naissance, nationalité.
## On se limitera aux prix nobel de physique.
#############
## Téléchargement de la page liste
nobel20.brut <- GET("https://www.css.cnrs.fr/scrape/nobel_1900_1920.html")
writeLines(as.character(nobel20.brut), "nobel1900-1920.html")
## Parsing
nobel20 <- htmlParse("nobel1900-1920.html", encoding = "UTF-8")
## Extraction des noms et url de prix nobel de physique
nobel20.noms <- xpathSApply(nobel20, "//td[2]/a", xmlValue)
nobel20.urls <- xpathSApply(nobel20, "//td[2]/a/@href")
nobel20.urls <- gsub("^[.]", "https://css.cnrs.fr/scrape", nobel20.urls)
## Recodage des accents (plutôt que des %C3 etc) dans les URL (optionnel)
nobel20.urls <- sapply(nobel20.urls, URLdecode)
## Téléchargement de l'ensemble des pages individuelles
nobel20.fichiers <- gsub("^.*/", "wiki_", nobel20.urls)
nobel20.fichiers <- paste0(nobel20.fichiers, ".html")
for (iurl in 1:length(nobel20.urls)) {
cat(iurl, " ", nobel20.noms[iurl], "\n")
Sys.sleep(1)
tmp.brut <- GET(nobel20.urls[iurl])
writeLines(as.character(tmp.brut), nobel20.fichiers[iurl])
}
## Parsing
fiches20.fichiers <- grep("^wiki_.*html$", value = T, dir())
fiches20.parse <- lapply(fiches20.fichiers, htmlParse)
## Extraction des infos : nom, date de naissance, nationalité
names(fiches20.parse) <- fiches20.fichiers
fiches20.infos <- xscrape(
fiches20.parse,
col.xpath = c(nom = "//h1",
naissance = "//th[text()='Naissance']/following-sibling::td//time/*[3]",
nationalité = "//th[text()='Nationalité']/following-sibling::td"))