{"word_count": 326, "character_count": 5985}
&#160;Voici ci dessous le programme R permettant de réaliser une typologie multiscalaire et de la cartographier à la façon du logiciel HyperAtlas (http://www.espon.eu/main/Menu_ToolsandMaps/ESPONHyperAtlas/). Le principe de cette typologie est la suivante, comparer la valeur d'une region selon un indicateur donné en fonction de 3 voisinages :- Global (e.g. ensemble de l'espace d'étude)- Intermédiaire (e.g niveau administratif supérieur)- Local (régions contiguës ou proches à vol d'oiseau)Pour plus de détail sur la méthodologie, rendez vous sur le site web du groupe de recherche HyperCarte : http://hypercarte.imag.fr/hyperatlas.html&#160;&#160;Voici le code source dont le téléchargement vous est proposé en fin de page avec données et fond de carte.&#160;# =============================================# pgm_MTA.R## Objectif: Cartographie multiscalaire# auteurs : Nicolas Lambert,UMS RIATE - CNRS# version : 1.0 (janvier 2014)## ===============================================# ===================================# Chargement des libraries nécéssaires# ===================================library(maptools)library(rgeos)library(reshape2)# ===================================# 1. Imports et jointure# ===================================setwd("/home/nlambert/Documents/Travaux/Tunisie/Sfax2014/R/tunisie")fdc &#60;- readShapeSpatial("geom/Tunisie_snuts4.shp")donnees&#60;-read.csv( "data/data_del_2004.csv",header=TRUE,sep=";",dec=",",encoding="latin1",)names(fdc@data)[1]&#60;-"id"names(donnees)[1]&#60;-"id"fdc@data = data.frame(fdc@data, donnees[match(fdc@data[,"id"], donnees[,"id"]),])# ===================================# 2. Variables# ===================================#Indicateurs &#38; labelsstock1&#60;-fdc@data$pop_tstock2&#60;-fdc@data$arearatio&#60;-stock1/stock2#stock1_label&#60;-"Population totale, 2004 (unit)"#stock2_label&#60;-"Superficie (unit)"ratio_label&#60;-"Densité de population, 2004"# Deviation globale (valeur)global=sum(stock1)/sum(stock2)# Deviation intermediaire (champ aggregatif)medium&#60;-fdc@data$id_snuts2# Deviation locale (0 = contiguite, sinon distance euclidienne dans l'unité de la carte)mydist&#60;-0# Critere et seuilcritere&#60;-"sup" # "sup" = plus grand que, "inf" = plus petit queseuil &#60;-125# ===================================# 3. Calculs# ===================================# On ne garde que ce qui est utilefdc@data&#60;-data.frame(fdc@data$id,medium,stock1,stock2,ratio)colnames(fdc@data)&#60;-c("id","id2","stock1","stock2","ratio")# 3.1 Calcul deviation globalfdc@data$global&#60;-(fdc@data$ratio/global)*100# 3.2 Calcul deviation intermédiarestock1_med&#60;-aggregate(fdc@data$stock1, by = list(id2 = fdc@data$id2), sum, simplify=TRUE)stock2_med&#60;-aggregate(fdc@data$stock2, by = list(id2 = fdc@data$id2), sum, simplify=TRUE)med&#60;-data.frame(c(stock1_med,stock2_med))med$tmp&#60;-(med$x/med$x.1)med&#60;-data.frame(med$id2,med$tmp)colnames(med)&#60;-c("id2","medium")fdc@data = data.frame(fdc@data, med[match(fdc@data[,"id2"], med[,"id2"]),2])colnames(fdc@data)&#60;-c("id","id2","stock1","stock2","ratio","global","medium")fdc@data$medium&#60;-(fdc@data$ratio/fdc@data$medium)*100# 3.3 Calcul déviation localeif(mydist==0) {dist&#60;-gIntersects(fdc, byid = TRUE, prepared=TRUE)row.names(dist)&#60;-fdc@data$idcolnames(dist)&#60;-fdc@data$iddist&#60;-melt(dist,variable.name=1,value.name="fij", na.rm=TRUE)colnames(dist)&#60;-c("i","j","cij")dist&#60;-dist[dist$cij==TRUE,]} else {centres&#60;-gCentroid(fdc, byid=TRUE, id = NULL)dist&#60;-gWithinDistance(centres,byid=TRUE,dist=mydist)row.names(dist)&#60;-fdc@data$idcolnames(dist)&#60;-fdc@data$iddist&#60;-melt(dist,variable.name=1, na.rm=TRUE)colnames(dist)&#60;-c("i","j","cij")dist&#60;-dist[dist$cij==TRUE,]}dist = data.frame(dist, fdc@data[match(dist[,"j"], fdc@data[,"id"]),c("stock1","stock2")])local_stock1&#60;-aggregate(dist$stock1, by = list(i = dist$i), sum, simplify = TRUE)local_stock2&#60;-aggregate(dist$stock2, by = list(i = dist$i), sum, simplify = TRUE)local&#60;-data.frame(local_stock1,local_stock2$x)colnames(local)&#60;-c("id","stock1","stock2")local$ratio&#60;-local$stock1/local$stock2local&#60;-data.frame(local$id,local$ratio)colnames(local)&#60;-c("id","local")fdc@data = data.frame(fdc@data, local[match(fdc@data[,"id"], local[,"id"]),2])colnames(fdc@data)&#60;-c("id","id2","stock1","stock2","ratio","global","medium","local")fdc@data$local&#60;-(fdc@data$ratio/fdc@data$local)*100# ===================================# 4. Typologie multiscalaire# ===================================# Typesfdc@data$tmp1&#60;-0fdc@data$tmp2&#60;-0fdc@data$tmp3&#60;-0fdc@data$typo=seuil]=seuil]=seuil]&#60;-4}if (critere=="inf"){fdc@data$tmp1[fdc@data$global&#60;=seuil]&#60;-1fdc@data$tmp2[fdc@data$medium&#60;=seuil]&#60;-2fdc@data$tmp3[fdc@data$local&#60;=seuil]&#60;-4}fdc@data$typo&#60;-fdc@data$tmp1+fdc@data$tmp2+fdc@data$tmp3fdc@data$typo&#60;-as.factor(fdc@data$typo)# couleurscolours&#60;-c("white","#fdc785","#ffffab","#fba9b0","#addea6","#ffa100","#fff226","#e30020")fdc@data$col&#60;-colours[1]fdc@data$col[fdc@data$typo==1]&#60;-colours[2]fdc@data$col[fdc@data$typo==2]&#60;-colours[3]fdc@data$col[fdc@data$typo==3]&#60;-colours[4]fdc@data$col[fdc@data$typo==4]&#60;-colours[5]fdc@data$col[fdc@data$typo==5]&#60;-colours[6]fdc@data$col[fdc@data$typo==6]&#60;-colours[7]fdc@data$col[fdc@data$typo==7]&#60;-colours[8]# ===================================# 5. Cartographie# ===================================cols&#60;-as.character(fdc@data$col)plot(fdc, col=cols)rVal&#60;-c(" . . . ","[X] . . "," . [X] . ","[X] [X] . "," . . [X]","[X] . [X]"," . [X] [X]","[X] [X] [X]")legend("bottomleft",legend=rVal, fill=colours,bty="n",pt.cex=1,cex=0.7,title=paste(paste(critere, seuil),"\n[glo] [med] [loc]"))if(mydist==0){soustitre0){soustitre&#60;-paste("NB : déviation locale basée sur la distance : ",mydist)}title(main=paste("Typologie multiscalaire\n",ratio_label),cex.sub=0.7,sub=soustitre)Sources (code, données et fond de carte)R_MTA