Website: Dhafer Malouche

email : dhafer.malouche@yale.edu

Introduction

(Ces fichiers sont disponibles gratuitement sur le web)

Les étapes d’une représentation d’une statistique sur une carte géorgraphique

Cette partie a été insipirée de la page :Timothée Giraud & Nicolas Lambert, Cartographie et Analyse Spatiale avec R

Représentation de la carte

Objectif : repreésenter une carte des délegations de la Tunisie avec des cercles de rayon proportionnel à la taille de la population (Statistique recensement 2004)

  1. Importation du fond de la carte dans R et les données aà représenter.

Importation du fond de carte

> library(maptools)
Loading required package: sp
Checking rgeos availability: TRUE
> library(sp)
> library(shapefiles)
Loading required package: foreign

Attaching package: 'shapefiles'
The following objects are masked from 'package:foreign':

    read.dbf, write.dbf
> fdc <- readShapePoly("Tunisie_snuts4")

Importation des données

>  donnees <- read.csv("tunisie_data_del_2011.csv", header = TRUE, sep = ";", 
+     dec = ",", encoding = "latin1")
>  dim(donnees)
[1] 263  17
  1. Extraction des coordonnées des centroides des délégations
> pt <- cbind(fdc@data[, "id"], as.data.frame(coordinates(fdc)))
  1. Jointure entre le dataframe des coordonnées des centroides et les données à cartographier
> colnames(pt) <- c("id", "x", "y")
> i=match(pt[, "id"], donnees[, "del"])
> pt <- data.frame(pt, donnees[i, ])
> pt$var <- pt$POPTO2010
  1. Calcul du rayon des cercles.

On détermine 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$var, na.rm = TRUE)
> sc
[1] 10489116

Calcul d’une variable correspondant aux rayons des cercles (la surface des cercles correspond à 20% de la surface de fdc)

> k <- 0.2  
> pt$size <- sqrt((pt$var * k * sfdc/sc)/pi)
  1. Enfin on trace la carte
> # Tracer le fond 
> plot(fdc, border = "white", col = "grey")
> # affichage des cercles proportionnels
> symbols(pt[, c("x", "y")], circles = pt$size, add = TRUE, bg = "red", inches = FALSE)

Ajout d’une légende sur la carte

> ## Titre de la légende.
> LegTitle <- "Nombre \nd'habitants\n"
> ## Tracer des cercles dont la taille indique les valeurs de la variable population.
> rLeg <- quantile(pt$size, c(1, 0.9, 0.25, 0), type = 1, na.rm = TRUE);rLeg
> rVal <- quantile(pt$var, c(1, 0.9, 0.25, 0), type = 1, na.rm = TRUE);rVal
> l <- data.frame(x = x1, y = y1);head(l)
> xinit <- l$x + rLeg[1];xinit
> ypos <- l$y + rLeg;ypos
> symbols(x = rep(xinit, 4), y = ypos, circles = rLeg, add = TRUE, bg = "red", 
+     inches = FALSE)
> text(x = rep(xinit, 4) + rLeg[1] * 1.2, y = (l$y + (2 * rLeg)), rVal, cex = 0.3, 
+     srt = 0, adj = 0)
> for (i in 1:4) {
+     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])), LegTitle, adj = c(0, 0), 
+     cex = 0.7)

Ajout du titre et de l’orientation dans une carte

> # Titre
> title(main = "Population, 2010",  cex.sub = 0.7)
> # échelle
> xscale <- x2
> yscale <- y1
> sizescale <- 50000
> labelscale <- "50km"
> SpatialPolygonsRescale(layout.scale.bar(), offset = c(xscale, yscale), scale = sizescale, 
+     fill = c("black"), plot.grid = F)
> text(xscale + sizescale/2, yscale, paste(labelscale, "\n\n", sep = ""), cex = 0.7)
> # fleche nord
> xarrow <- x1
> yarrow <- y2 - (y2 - y1)/10
> SpatialPolygonsRescale(layout.north.arrow(2), offset = c(xarrow, yarrow), scale = 50000, 
+     plot.grid = F)
##     100%      90%      25%       0% 
## 821572.5 818811.8 813466.7 809842.1

Les cartes choroplètes

Une représentation de la carte

  1. Jointure des données vers le fond de carte
> i=match(fdc@data[, "id"], donnees[, "del"])
> fdc@data <- data.frame(fdc@data, donnees[i,])
  1. Choix de la variable à représenter (Indice de développement régional)
> fdc@data$var <- fdc@data$IDRVA2011
> var <- as.vector(na.omit(fdc@data$var))
  1. Nombre de classes
> nbclass <- 8

4.determination des bornes (manuelement ou automatiquement)

> library(classInt)
> distr <- classIntervals(var, nbclass, style = "quantile")$brks
  1. Choix de la palette de couleurs et attribution des couleurs aux régions
> library(RColorBrewer)
> colours <- brewer.pal(nbclass, "YlOrRd")
> colMap <- colours[(findInterval(fdc$var, distr, all.inside = TRUE))]
  1. Affichage de la carte
> plot(fdc, col = colMap, border = "black", lwd = 1)

Ajout d’un habillage

> # legende
> legend(x = "topright", legend = leglabs(round(distr, 2), over = "plus de", under = "moins de"), 
+     fill = colours, bty = "n", pt.cex = 1, cex = 0.7, title = "indice 0-1")
> # Titre
> title(main = "Indicateur de developpement regional", 
+     cex.sub = 0.7)

Etude de cas : représentation des différences des votes de Nahdha entre 2011 et 2014.

Les votes en 2011 et en 2014

> library(maptools)
> library(ggplot2)
> library(RColorBrewer)
> donnees <-  read.csv("data_Paper_with_Maleke_11_9.csv")
> donnees$CPR_2014.1=c()
> 
> i=match(fdc@data$id,donnees[, "del"])
> fdc@data$Nahdha_2014=donnees$Nahdha_2014[i]
> fdc@data$Nahdha_2011=donnees$Nahdha_2011[i]
> fdc@data$Region=donnees$reg_nom[i]
> ### Imputing data
> library(e1071)
> x=matrix(fdc@data$Nahdha_2014,ncol=1)
> x=impute(x)
> fdc@data$Nahdha_2014=x
> y=matrix(fdc@data$Nahdha_2011,ncol=1)
> y=impute(y)
> fdc@data$Nahdha_2011=y
> 
> fdc@data$Difference=fdc@data$Nahdha_2014-fdc@data$Nahdha_2011
> 
> tun_df <- fortify(fdc,region = "id")
> dim(tun_df)
[1] 3490    7
> dt2=data.frame(fdc@data[,c("id","Nahdha_2014","Region")])
> dim(dt2)
[1] 263   3
> head(dt2)
      id Nahdha_2014     Region
0 TS1248         543 Nord-ouest
1 TS124A         640 Nord-ouest
2 TS1246        1498 Nord-ouest
3 TS1247         458 Nord-ouest
4 TS1240        1343 Nord-ouest
5 TS1241        1442 Nord-ouest
> tun_df2 <- merge(tun_df,dt2, by="id")
> dim(tun_df2)
[1] 3490    9
> dt3=data.frame(fdc@data[,c("id","Nahdha_2011","Region")])
> head(dt3)
      id Nahdha_2011     Region
0 TS1248         805 Nord-ouest
1 TS124A        1035 Nord-ouest
2 TS1246        3590 Nord-ouest
3 TS1247        1312 Nord-ouest
4 TS1240        3061 Nord-ouest
5 TS1241        2622 Nord-ouest
> tun_df3 <- merge(tun_df,dt3, by="id")
> dim(tun_df3)
[1] 3490    9
> tun_dfA=data.frame(c(tun_df2$id,tun_df3$id),c(tun_df2$long,tun_df3$long),c(tun_df2$lat,tun_df3$lat),
+                    c(tun_df2$order,tun_df3$order),c(tun_df2$hole,tun_df3$hole),
+                    c(tun_df2$piece,tun_df3$piece),c(tun_df2$group,tun_df3$group),
+                    c(tun_df2$Nahdha_2014,tun_df3$Nahdha_2011),
+                    c(as.character(tun_df2$Region),as.character(tun_df3$Region)),
+                    c(rep("2014",3490),rep("2011",3490)))
> colnames(tun_dfA)=c(colnames(tun_df2)[-c(8,9)],"Nahdha","Region","Year")
> head(tun_dfA)
      id    long     lat order  hole piece group Nahdha   Region Year
1 TS1110 4350192 1529845     1 FALSE     1     1   2418 Nord-est 2014
2 TS1110 4346729 1530476     2 FALSE     1     1   2418 Nord-est 2014
3 TS1110 4347480 1532800     3 FALSE     1     1   2418 Nord-est 2014
4 TS1110 4352078 1534408     4 FALSE     1     1   2418 Nord-est 2014
5 TS1110 4350192 1529845     5 FALSE     1     1   2418 Nord-est 2014
6 TS1111 4336246 1526804     6 FALSE     1     2   3042 Nord-est 2014
> p<-ggplot(tun_dfA, aes(x=long, y=lat, group=group)) +
+   geom_polygon(aes(fill=Nahdha),color = "grey50")+
+   scale_fill_gradientn(colours=brewer.pal(5,"OrRd"),name="Nahdha")+
+   labs(x="",y="")+ theme_bw()+facet_grid(~Year)+
+   coord_fixed()
> p<-p+theme(axis.line=element_blank(),
+       axis.text.x=element_blank(),
+       axis.text.y=element_blank(),
+       axis.ticks=element_blank(),
+       axis.title.x=element_blank(),
+       axis.title.y=element_blank(),panel.grid.major = element_blank(),
+     panel.grid.minor = element_blank(),
+     panel.border = element_blank(),
+     panel.background = element_blank())
> p<-p+ theme(legend.position="right")
> p

Une autre facon de présenter les deux cartes.

Les délégations où Nahdha a gagné des votes.

  • On présentera d’abord les délégation où la différence entre 2014 et 2011 est positive.

  • Pour cela on garde dans l’obbjet tun_df2 les lignes ouù la différence est restée positive (Nahdha a soit gardé le même nombre d’élécteurs ou elle en a gagné).

> i=which(tun_df2$Nahdha_2014-tun_df3$Nahdha_2011 >=0)
> tun_df2A=tun_df2[i,]
> tun_dfA=data.frame(c(tun_df2A$id,tun_df3$id),c(tun_df2A$long,tun_df3$long),c(tun_df2A$lat,tun_df3$lat),
+                    c(tun_df2A$order,tun_df3$order),c(tun_df2A$hole,tun_df3$hole),
+                    c(tun_df2A$piece,tun_df3$piece),c(tun_df2A$group,tun_df3$group),
+                    c(tun_df2A$Nahdha_2014,tun_df3$Nahdha_2011),
+                    c(as.character(tun_df2A$Region),as.character(tun_df3$Region)),
+                    c(rep("2014",length(i)),rep("2011",3490)))
> colnames(tun_dfA)=c(colnames(tun_df2)[-c(8,9)],"Nahdha","Region","Year")
> head(tun_dfA)
      id    long     lat order  hole piece group Nahdha     Region Year
1 TS2134 4355599 1370631  1673 FALSE     1   157   1042 Centre-est 2014
2 TS2134 4356971 1368746  1674 FALSE     1   157   1042 Centre-est 2014
3 TS2134 4351256 1367522  1675 FALSE     1   157   1042 Centre-est 2014
4 TS2134 4344645 1358415  1676 FALSE     1   157   1042 Centre-est 2014
5 TS2134 4351729 1354280  1677 FALSE     1   157   1042 Centre-est 2014
6 TS2134 4353369 1350181  1678 FALSE     1   157   1042 Centre-est 2014
> p<-ggplot(tun_dfA, aes(x=long, y=lat, group=group)) +
+   geom_polygon(aes(fill=Nahdha),color = "grey50")+
+   scale_fill_gradientn(colours=brewer.pal(5,"OrRd"),name="Nahdha")+
+   labs(x="",y="")+ theme_bw()+facet_grid(~Year)+
+   coord_fixed()
> p<-p+theme(axis.line=element_blank(),
+       axis.text.x=element_blank(),
+       axis.text.y=element_blank(),
+       axis.ticks=element_blank(),
+       axis.title.x=element_blank(),
+       axis.title.y=element_blank(),panel.grid.major = element_blank(),
+     panel.grid.minor = element_blank(),
+     panel.border = element_blank(),
+     panel.background = element_blank())
> p<-p+ theme(legend.position="right")
> p

Maintenant les délégations où Nahdha a perdu des votes.

> i=which(tun_df2$Nahdha_2014-tun_df3$Nahdha_2011<0)
> tun_df2A=tun_df2[i,]
> tun_dfA=data.frame(c(tun_df2A$id,tun_df3$id),c(tun_df2A$long,tun_df3$long),c(tun_df2A$lat,tun_df3$lat),
+                    c(tun_df2A$order,tun_df3$order),c(tun_df2A$hole,tun_df3$hole),
+                    c(tun_df2A$piece,tun_df3$piece),c(tun_df2A$group,tun_df3$group),
+                    c(tun_df2A$Nahdha_2014,tun_df3$Nahdha_2011),
+                    c(as.character(tun_df2A$Region),as.character(tun_df3$Region)),
+                    c(rep("2014",length(i)),rep("2011",3490)))
> colnames(tun_dfA)=c(colnames(tun_df2)[-c(8,9)],"Nahdha","Region","Year")
> head(tun_dfA)
      id    long     lat order  hole piece group Nahdha   Region Year
1 TS1110 4350192 1529845     1 FALSE     1     1   2418 Nord-est 2014
2 TS1110 4346729 1530476     2 FALSE     1     1   2418 Nord-est 2014
3 TS1110 4347480 1532800     3 FALSE     1     1   2418 Nord-est 2014
4 TS1110 4352078 1534408     4 FALSE     1     1   2418 Nord-est 2014
5 TS1110 4350192 1529845     5 FALSE     1     1   2418 Nord-est 2014
6 TS1111 4336246 1526804     6 FALSE     1     2   3042 Nord-est 2014
> p<-ggplot(tun_dfA, aes(x=long, y=lat, group=group)) +
+   geom_polygon(aes(fill=Nahdha),color = "grey50")+
+   scale_fill_gradientn(colours=brewer.pal(5,"OrRd"),name="Nahdha")+
+   labs(x="",y="")+ theme_bw()+facet_grid(~Year)+
+   coord_fixed()
> p<-p+theme(axis.line=element_blank(),
+       axis.text.x=element_blank(),
+       axis.text.y=element_blank(),
+       axis.ticks=element_blank(),
+       axis.title.x=element_blank(),
+       axis.title.y=element_blank(),panel.grid.major = element_blank(),
+     panel.grid.minor = element_blank(),
+     panel.border = element_blank(),
+     panel.background = element_blank())
> p<-p+ theme(legend.position="right")
> p

Différence des votes entre 2014 et 2011

> tun_df <- fortify(fdc,region = "id")
> dt=data.frame(fdc@data[,c("id","Difference","Region")])
> tun_df <- merge(tun_df,dt, by="id")
> colnames(tun_df)[8]="Difference"
> 
> splits <- 7
> mid.point<-0
> pos.vals <- tun_df$Difference[tun_df$Difference > mid.point]
> neg.vals <- tun_df$Difference[tun_df$Difference < mid.point]
> pos.quants <- quantile(c(mid.point, pos.vals), 0:((splits - 1) / 2) / ((splits - 1) / 2), names=F)
> neg.quants <- quantile(c(mid.point, neg.vals), 0:((splits - 1) / 2) / ((splits - 1) / 2), names=F)
> quants <- c(neg.quants, pos.quants[-1])  
> 
> get_col <- colorRamp(c("red", "white", "green"))  # make fun to interpolate colors
> colours <- rgb(get_col(0:(splits - 1)/(splits - 1)), max=255)       # 7 evenly interpolated colors 
> val.remap <- (quants - min(quants)) / 
+   diff(range(quants))
> quants2=as.integer(c(quants[1],mid.point,quants[7]))
> 
> 
> p<-ggplot(tun_df, aes(x=long, y=lat, group=group)) +
+   geom_polygon(aes(fill=Difference),color = "grey50")+
+   scale_fill_gradientn(colours=colours,
+     values=val.remap,
+     breaks=quants2,name="Nahdha Difference\n(RoV 2014 - Votes 2011)")+
+   labs(x="",y="")+ theme_bw()+
+   coord_fixed()
> p<-p+theme(axis.line=element_blank(),
+       axis.text.x=element_blank(),
+       axis.text.y=element_blank(),
+       axis.ticks=element_blank(),
+       axis.title.x=element_blank(),
+       axis.title.y=element_blank(),panel.grid.major = element_blank(),
+     panel.grid.minor = element_blank(),
+     panel.border = element_blank(),
+     panel.background = element_blank())
> p<-p+ theme(legend.position="right")
> p

Représentation avec spplot

Tous les votes.

> spplot(fdc,"Difference",main="Différence entre 2014 et 2011",sub="")

Représentation avec ssplot de ceux où Nahdha a perdu des votes.

> i=which(fdc@data$Difference<0)
> fdc2=fdc[i,]
> spplot(fdc2,"Difference",main="Votes Ennahdha",sub="Délégation où Nahdha a perdu des voix")