Visualisation de données médiatiques et géographiques avec R

Représenter et visualiser des données avec R

Séminaire Ined SMS - 3 décembre 2012
Timothée Giraud, UMS RIATE
Marta Severo, Université de Lille 3
rcartog(at)gmail.com


Résumé

La combinaison d’informations géographiques et d’informations médiatiques peut s’avérer particulièrement fructueuse pour l’analyse des évènements médiatiques internationaux et notamment pour l’étude de leur propagation spatio-temporelle.
L’objectif de cette communication est de présenter les caractéristiques de la donnée médiatique et de montrer les possibilités que le logiciel R offre pour le traitement et la visualisation de ce type de données.
Nous présenterons quelques exemples faisant appel à l’interactivité, à l’animation et à la cartographie à travers l’analyse de la couverture médiatique internationale du conflit de Wukan, un village du sud de la Chine, où après des mois de protestations contre l’accaparement illégal de terres les habitants ont obtenu des élections libres.

Bibliographie

C. Grasland C., T. Giraud, M. Severo, 2012, « Un capteur géomédiatique d'événements internationaux » in > Beckouche P., Grasland C., Guerin-Pace F., Moisseron J.Y., 2012, Fonder les Sciences du Territoires, Karthala, Paris.

M. Severo, T. Giraud, N. Douay, « The Wukan’s protests: from local activism to global media event », Workshop Just-in-Time Sociology, Conférence internationale SocInfo 2012 (Lausanne, novembre 2012). Url : The Wukan’s protests: just-in-time identification of international media events

Vous pourrez trouver et télécharger l'ensemble des données utilisées ici :
données : http://wukan.ums-riate.fr/data/
shapefile : http://wukan.ums-riate.fr/shapes/

Le chargement et l'initialisation

Ici nous chargeons les données brutes et opérons quelque manipulations simples. Notez l'utilisation du package sqldf.

# chargement des packages nécessaires
library(sqldf)

# sauvegarde des parametres graphiques
oldpar <- par(no.readonly = TRUE)

# à adapter en fonction de votre architecture de dossiers
setwd("D:/Dropbox/SeminaireInedSMS/")

# lecture de la table
load("data/wukan.Rdata")

# selection de colonnes et renomages
wukan <- sqldf("SELECT Ctry AS 'ctry' ,start AS 'time1',datesemaine AS 'time2', nbArt, jrnl FROM wukan")

# transformation du format de la date
wukan$time1 <- as.Date(wukan$time1, format = "%d/%m/%Y")

Le graphique du nombre hebdomadaire d'article publiés sur Wukan

Il s'agit d'un graphique simple indiquant le nombre hebdomadaire d'articles publiés évoquant le village de Wukan.

# agrégation des articles par semaine
wukanH <- sqldf("SELECT time1, time2, sum(nbArt) AS 'nbArt' FROM wukan GROUP BY time1 ORDER BY time1")

# nombre maximal d'article par semaine
maxArt <- max(wukanH$nbArt)

# gestion des marges
par(mgp = c(3, 0.4, 0))

# affichage du graphique
barplot(wukanH$nbArt, names.arg = wukanH$time1, space = 0, ylim = c(0, maxArt), 
    beside = TRUE, adj = 0.5, xlab = "Temps (semaines)", ylab = "Nb. Articles", 
    cex.names = 0.6, las = 2, yaxt = "n", col = "#CCEBC5", main = "Diffusion hebdomadaire d'informations sur Wukan")
axis(2, at = seq(0, 200, 50), pos = 0, las = 1, cex.axis = 0.6, lwd = 0.5, tck = -0.03)

plot of chunk unnamed-chunk-2


# restauration des parametres graphiques initiaux
par(oldpar)

Le graphique hebdomadaire interactif

Utilisation du package googleVis qui permet de créer assez facilement des graphiques interactifs utilisant les outils google chart. Nous créons ici un graphique du type AnnotatedTimeLine.


# chargement des packages nécessaires
library(googleVis)

# création de la table à représenter
df <- wukanH
df$Title <- NA
df$Annotation <- NA

# les annotations à représenter sur le graph
df$Title[8] <- "Sep 21-23"
df$Title[20] <- "Dec 12-14"
df$Title[25] <- "Jan 17"
df$Title[27] <- "Feb 1"
df$Title[28] <- "Feb 11"
df$Title[31] <- "Mar 3"
df$Annotation[8] <- "Attack of the PCC building and a police station"
df$Annotation[20] <- "Death of Xue Jinbo, flee of the PCC officials and police, siege of the village"
df$Annotation[25] <- "Villagers from the Baiyun district threatened to turn the district into a \"second Wukan\""
df$Annotation[27] <- "1st round of the Wukan municipal election"
df$Annotation[28] <- "2nd round of the Wukan municipal election"
df$Annotation[31] <- "3d round of the Wukan municipal election"

# les paramètres du graph
AnnoTimeLine <- gvisAnnotatedTimeLine(df, datevar = "time1", date.format = "%Y - %m - %d", 
    numvar = "nbArt", titlevar = "Title", annotationvar = "Annotation", options = list(displayAnnotations = TRUE, 
        legendPosition = "sameRow", displayRangeSelector = FALSE, displayZoomButtons = FALSE, 
        gvis.language = "en", width = 900, height = 300), chartid = "Wukan_events")

# Affichage du graph
print(AnnoTimeLine, "chart")
# enregistrement du graph print(AnnoTimeLine,file='output/wukan.html')
# Attention le graph ne s'affiche correctement que si la page html est
# diffusée par un serveur (local ou pas)

Une fois la page html du graphique construite elle peut être modifiée et mise en ligne.

Graphique hebdomadaire pour une selection de journaux

Il s'agit ici encore d'un graphique assez simple.

# création d'une liste des dates
lesDates <- sqldf("SELECT time1,time2\nFROM wukan\nGROUP BY time1, time2\nORDER BY time2")

# numero de la premiere semaine
deb <- min(lesDates$time2)

# numero de la derniere semaine
fin <- max(lesDates$time2)

# agregation des articles par semaine et par journal
wukanHS <- xtabs(nbArt ~ time2 + jrnl, data = wukan)
wukanHS <- as.data.frame(wukanHS)
wukanHS$time2 <- as.character(wukanHS$time2)

# calcul des fréquences hebdomadaires des article par journal
FT <- wukanHS[wukanHS$jrnl == 1, ]
FT$var <- FT$Freq/sum(FT$Freq)
SCMP <- wukanHS[wukanHS$jrnl == 2, ]
SCMP$var <- SCMP$Freq/sum(SCMP$Freq)
TDT <- wukanHS[wukanHS$jrnl == 3, ]
TDT$var <- TDT$Freq/sum(TDT$Freq)
NYT <- wukanHS[wukanHS$jrnl == 4, ]
NYT$var <- NYT$Freq/sum(NYT$Freq)
TOT <- wukanH
TOT$var <- TOT$nbArt/sum(TOT$nbArt)

# affichage du graphique
txtLeg <- c("All the newspapers", "Financial Times", "New York Times", "South China Morning Post", 
    "The Daily Telegraph")
colLeg <- c("black", "blue", "green", "grey", "red")
plot(TOT$time2, TOT$var, col = colLeg[1], frame.plot = FALSE, lwd = 3, type = "l", 
    ylim = c(0, 0.4), xlim = c(deb, fin), xlab = "Temps (semaines)", ylab = "Freq. Articles", 
    xaxt = "n", yaxt = "n")
lines(FT[, 1], FT[, 4], col = colLeg[2], lwd = 2)
lines(NYT[, 1], NYT[, 4], col = colLeg[3], lwd = 2)
lines(SCMP[, 1], SCMP[, 4], col = colLeg[4], lwd = 2)
lines(TDT[, 1], TDT[, 4], col = colLeg[5], lwd = 2)
axis(1, at = deb:fin, labels = lesDates[, 1], cex.axis = 0.6, las = 2, pos = 0, 
    tck = -0.05, lwd = 0.5)
axis(2, at = seq(0, 0.4, 0.2), pos = deb, las = 1, cex.axis = 0.6, lwd = 0.5, 
    tck = -0.05)
title(main = "Les articles évoquant la révolte de Wukan dans 4 journaux")
legend("topleft", col = colLeg, legend = txtLeg, lty = 1, cex = 0.8, bty = "n", 
    lwd = 2)

plot of chunk unnamed-chunk-4

Les quelques lignes en commentaire suivantes permettent l'affichage d'une boite de dialogue indiquant à l'utilisateur qu'il doit cliquer sur le graphique pour placer interactivement la légende du graphique. Elles peuvent remplacer la dernière ligne du bloc précédent.

# pour le placement interactif de la légende avec une boite de dialogue

# tkmessageBox(title = '',message = 'Choisir la position de la légende',
# icon = 'info', type = 'ok')

# posLeg<-locator(n=1)
# legend(posLeg$x,posLeg$y,col=colLeg,legend=txtLeg,lty=1,cex=0.8,bty='n',lwd=2)

Graphique animé du nombre d'articles

Création d'un graphique animé de la diffusion hebdomadaire d'informations sur Wukan. Nous utilisons ici le package animation.

# chargement des packages nécessaires
library(animation)

# boucle de création du graph
graph.ani <- function() {
    for (i in deb:fin) {
        # Affichage du graph
        plot(wukanH[wukanH[2] == deb:i, 2], wukanH[wukanH[2] == deb:i, 3], xaxs = "i", 
            type = "l", ylim = c(0, 180), xlim = c(1179, 1221), ylab = "Nb. Articles", 
            xaxt = "n", las = 2, xlab = "Temps (semaines)")
        axis(1, at = c(seq(deb, fin, 4)), labels = wukanH[seq(1, 43, 4), 1], 
            cex.axis = 0.8, las = 1, padj = -1.5)
        title(main = "Diffusion hebdomadaire d'informations sur Wukan")
    }
}

# création de l'animation
saveGIF(graph.ani(), interval = 0.5, autobrowse = FALSE, movie.name = "graphAnim.gif", 
    outdir = paste(getwd(), "/output", sep = ""), ani.height = 400, ani.width = 800)

Diffusion hebdomadaire d'informations sur Wukan

Il est possible d'enregistrer une version html de l'animation:

saveHTML(graph.ani(), interval = 0.5, autobrowse = FALSE, outdir = paste(getwd(), 
    "/output", sep = ""), ani.height = 400, ani.width = 800)

Le résultat est visible ici : http://wukan.ums-riate.fr/animationweb/

Catographie du nombre d'articles par pays - première solution

Créer une carte en symboles proportionnels

  1. Import du fond de carte : readShapeSpatial()
  2. Création d'un dataframe avec les coordonnées des centroides des communes : coordinates()
  3. Jointure entre le dataframe des coordonnées des centroides et les données à cartographier : merge()
  4. Création d'une variable contenant les rayons des cercles à représenter
  5. Tri du dataframe de manière à ce que les cercles soient dessinés du plus gros au plus petit
  6. Affichage de la carte : plot() + symbols()
  7. Affichage de la légende (dessin)
  8. Titre et sous titres
# chargement des packages nécessaires
library(maptools)

# agrégation des articles par pays
wukanC <- sqldf("SELECT ctry, sum(nbArt) AS 'nbArtTot' FROM wukan GROUP BY ctry")

# selection des pays dont plus de 2 articles evoquent Wukan
wukanC <- wukanC[wukanC$nbArtTot > 2, ]

# import du fd de carte
fdc <- readShapeSpatial("D:/Dropbox/SeminaireInedSMS/shp/fdc.shp")

# création d'un dataframe avec les coordonnées des centroides des communes
pt <- cbind(fdc@data[, "CODE_ISO3"], as.data.frame(coordinates(fdc)))

# renommage des colonnes de ce dataframe
colnames(pt) <- c("Code", "x", "y")

# jointure entre le dataframe des coordonnées des centroides et les
# données à cartographier
pt <- merge(pt, wukanC, by.x = "Code", by.y = "ctry", all.x = TRUE)

# extension maximale du fond de carte la fonction bbox donne les
# coordonnées max et min du fond de carte
x1 <- bbox(fdc)[1]
y1 <- bbox(fdc)[2]
x2 <- bbox(fdc)[3]
y2 <- bbox(fdc)[4]

# surface maximale de la carte
sfdc <- (x2 - x1) * (y2 - y1)

# somme de la variable à cartographier
sc <- sum(pt$nbArtTot, na.rm = TRUE)

# création d'une variable contenant les rayons des cercles à représenter
pt$var <- sqrt((pt$nbArtTot * 0.04 * sfdc/sc)/pi)  #la somme des surfaces des cercles
# représentera ici 10% (0.1) de la surface de la carte

# tri du dataframe de manière à ce que les cercles soient dessiner du plus
# gros au plus petit
pt <- pt[order(pt$var, decreasing = TRUE), ]

# affichage de la carte
plot(fdc, border = "Grey", col = "#FEE08B", ann = FALSE)
symbols(pt[, c("x", "y")], circles = pt$var, add = TRUE, bg = "#CCEBC5", inches = FALSE)

# affichage de la légende (dessin)
rLeg <- quantile(pt$var, c(1, 0.9, 0), type = 1, na.rm = TRUE)
rVal <- quantile(pt$nbArtTot, c(1, 0.9, 0), type = 1, na.rm = TRUE)
l <- NA
l$x <- x1
l$y <- y1
xinit <- l$x + rLeg[1]
ypos <- l$y + rLeg
symbols(x = rep(xinit, 3), y = ypos, circles = rLeg, add = TRUE, bg = "#C7E9C0", 
    inches = FALSE)
text(x = rep(xinit, 4) + rLeg[1] * 1.2, y = (l$y + (2 * rLeg)), rVal, cex = 0.7, 
    srt = 0, adj = 0)
for (i in 1:3) {
    segments(xinit, (l$y + (2 * rLeg[i])), xinit + rLeg[1] * 1.1, (l$y + (2 * 
        rLeg[i])))
}
text(x = xinit - rLeg[1], y = (l$y + (2 * rLeg[1])), "Nombre d'articles\n", 
    adj = c(0, 0), cex = 0.7)

# titre et sous titres
title(main = paste("\nRépartition des articles évoquant Wukan\nentre le", lesDates[lesDates$time2 == 
    deb, 1], "et le", lesDates[lesDates$time2 == fin, 1]), sub = "Auteur: T. Giraud, UMS RIATE, 2012\nSource: Factiva, 2012", 
    cex.sub = 0.8)

plot of chunk unnamed-chunk-8

Catographie du nombre d'articles par pays - deuxième solution : le package rCarto

Cette deuxième solution utilise un package, rCarto, qui n'est pas encore disponible publiquement.
Il est en phase de developpement et si vous souhaitez participer aux tests et aux améliorations vous pouvez m'envoyer un e-mail : rcartog(at)gmail.com
Pour l'instant deux fonctions sont disponibles :

D’autres sont prévues :

# chargement des packages nécessaires
library(rCarto)

# minimum d'arguments
mapCircles(shpFile="D:/Dropbox/SeminaireInedSMS/shp/fdc.shp",   # chemin du shapefile
           shpId="CODE_ISO3",       # identifiant dans le shape file
           df=wukanC,               # dataframe à cartographier
           dfId="ctry",             # identifiant dans le data frame
           var="nbArtTot")         # variable à cartographier

plot of chunk unnamed-chunk-9

# (presque) tous les arguments
mapCircles(shpFile = "D:/Dropbox/SeminaireInedSMS/shp/fdc.shp", shpId = "CODE_ISO3", 
    df = wukanC, dfId = "ctry", var = "nbArtTot", title = "Répartition des articles évoquant Wukan\nentre le 01/08/2011 et le 21/05/2012", 
    legend = "Nombre d'articles", author = "T. Giraud, UMS RIATE", sources = "Factiva, 2012", 
    width = 20, height = 12.5, shareOfCircle = 0.04, lgdInter = FALSE, circleCol = "#CCEBC5", 
    baseCol = "#FEE08B", txtCex = 2)

plot of chunk unnamed-chunk-10

Catographie animée du nombre d'articles par pays - deuxième solution

Nous combinons ici les possibilités offertes par les packages animation et rCarto.

# passage par les xtab et création d'une tables des dates
wukanC <- xtabs(nbArt ~ time2 + ctry, data = wukan)
wukanC <- as.data.frame(wukanC)
wukanC <- sqldf("SELECT wukanC.*,lesDates.time1 AS time1 FROM wukanC LEFT JOIN lesDates ON wukanC.time2=lesDates.time2")

# création des effectifs cumulés par pays
wukanC$cum <- 0
lg <- dim(wukanC)[1]
wukanC$cum[1] <- wukanC$Freq[1]
for (i in 2:lg) {
    if (wukanC[i, 2] == wukanC[(i - 1), 2]) {
        wukanC$cum[i] <- ((wukanC$Freq[i]) + (wukanC$cum[(i - 1)]))
    } else {
        wukanC$cum[i] <- wukanC$Freq[i]
    }
}

# selection des valeurs à représenter
wukanC <- wukanC[wukanC$cum > 0, ]

# boucle de l'animation
carte.ani <- function() {
    for (i in (deb + 7):fin) {
        # lacarte
        mapCircles(shpFile = "shp/fdc.shp", shpId = "CODE_ISO3", df = wukanC[wukanC$time2 == 
            i, ], dfId = "ctry", var = "cum", fixedNorm = TRUE, valueMax = 150, 
            radiusMax = 0.6, lgdRnd = 0, height = 15, width = 25, title = paste("Répartition des articles évoquant wukan\nentre le", 
                lesDates[lesDates$time2 == deb + 7, "time1"], "et le", lesDates[lesDates$time2 == 
                  i, "time1"]), legend = "Nb. Articles", author = "T. Giraud, UMS RIATE", 
            sources = "Factiva, 2012", lgdInter = FALSE, circleCol = "#CCEBC5", 
            baseCol = "#FEE08B", txtCex = 2.4)
    }
}

# sauvegarde de l'animation
saveGIF(carte.ani(), interval = 0.5, autobrowse = FALSE, movie.name = "carteAnim.gif", 
    outdir = paste(getwd(), "/output", sep = ""), ani.height = 480, ani.width = 800)

# restauration des parametres graphiques initiaux
par(oldpar)

Catographie animée du nombre d'articles par pays