Licence du post CC BY-NC 2.0 FR : https://creativecommons.org/licenses/by-nc/2.0/fr/
Implémentation du modèle gravitaire pour l’appliquer à des périodes anciennes pour lesquelles les données sur les flux entre les lieux sont soit inexistantes, soit non exhaustives d’un point de vue spatial. Le test est ici réalisé sur les villes du nord de la France avant la Révolution industrielle (en 1836). Le modèle gravitaire généralisé par Pareto s’écrit : \[F_{ij} = k . \frac{P_i*P_j}{D_{ij}^\alpha}\] On a donc le flux entre un lieu i et un lieu j (\(F_{ij}\)) est égal à \(k\) multiplé par le poids de i fois le poids de j (\(P{i}*P{j}\)) divisé par la distance entre i et j (\(D_{ij}\)) à la puissance \(\alpha\). Dans la bibliographie relative au modèle gravitaire, les poids sont également appelés les masses des lieux (notés \(M{i}\) et \(M{j}\)). Le poids est relatif à la taille des lieux, le plus souvent mesurée par la population recensée. Quant à la distance, il s’agit généralement d’une distance euclidienne.
Dans ce modèle, \(k\) et \(\alpha\) sont des paramètres, avec \(k\) correspondant à une constante (de proportionnalité) permettant d’ajuster le modèle selon les types de flux (quand ils sont donc connus) et \(\alpha\) correspondant au frein de la distance. Ainsi, le modèle testé pour évaluer des flux potentiels est le suivant : \[F_{ij} = \frac{P_i*P_j}{D_{ij}^\alpha}\]
Les données ont été construites à partir des cartes d’État-major disponibles sur le géoportail de l’IGN et des données de recensement de population à échelle communale en 1836 (en ligne : projet Cassini du Ldh-EHESS). Plus précisément, les lieux de peuplement que sont les “villes” ont été repérées sur les cartes. On a ainsi pris en compte les lieux désignés comme tels par les acteurs de l’époque.
L’intérêt de tester le modèle sur ces données est triple :
1) on possède des données sur les populations ;
2) on se situe avant la Révolution industrielle, donc avant l’arrivée du chemin de fer. Ainsi, les modes de déplacements, et dès lors les relations distance-temps, sont semblables aux époques antérieures que l’on étudie par ailleurs (de l’Antiquité à l’époque moderne). Si le modèle apparaît relativement satisfaisant, il pourra ainsi être appliqué sur des données plus anciennes ;
3) sachant que l’on a pour la même époque (1833), des données sur des réseaux existants (à savoir le réseau des routes de Poste grâce à la base de données réalisée par Anne Bretagnolle et Nicolas Verdier), on pourra faire des comparaisons entre les résultats du modèle selon différentes valeurs de paramètre \(\alpha\) et le réseau observé. La comparaison nous permettra de “valider” le modèle, disons tout du moins, d’évaluer des valeurs de paramètres efficaces dans un contexte préindustriel.
En entrée, nous avons d’une part un tableau (en .csv) avec les villes étudiées (i) et les données sur les populations. Et nous avons d’autre part les localisations des villes i en format .shp.
Il aurait été plus simple pour les traitements d’avoir un seul tableau avec les coordonnées géographiques des villes en tant qu’attribut. Toutefois, l’enregistrement n’a pas été réalisé de cette manière au départ (en particulier car les localisations ont été récupérés directement par calcul dans un SIG du centroïde des communes car nous avions anciennement réalisé d’autres traitement en SIG demandant de le faire). Par ailleurs, ces formats de données sont souvent utilisés dans les chaînes d’enregistrement et de traitements de données des archéologues. Ils peuvent ainsi, selon nous, s’approprier et appliquer le code suivant plus facilement.
Packages nécessaires
library(sp)
library(rgdal)
## rgdal: version: 1.2-7, (SVN revision 660)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.0.1, released 2015/09/15
## Path to GDAL shared files: C:/Users/Paris/Documents/R/win-library/3.4/rgdal/gdal
## Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
## Path to PROJ.4 shared files: C:/Users/Paris/Documents/R/win-library/3.4/rgdal/proj
## Linking to sp version: 1.2-4
library(Matrix)
library(spdep)
library(sf)
## Linking to GEOS 3.6.1, GDAL 2.2.0, proj.4 4.9.3
library(cartography)
library(igraph)
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:igraph':
##
## as_data_frame, groups, union
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(reshape2)
Imports des données
# Le semis étudié
Semis <- readOGR(dsn = "Data_Villes_PasBourgs.shp",
layer = "Data_Villes_PasBourgs",
encoding = "utf8",
stringsAsFactors = FALSE)
## OGR data source with driver: ESRI Shapefile
## Source: "Data_Villes_PasBourgs.shp", layer: "Data_Villes_PasBourgs"
## with 72 features
## It has 30 fields
## Integer64 fields read as strings: ID_GEOFLA SUPERFICIE Tquant_Ran Tquant_POP Tquant_P_1 Tquant_P_2 Tquant_P_3
# Un fond géographique pour visualiser les données
Fond <- readOGR(dsn = "G:/These/These/Sujet/3-Traitements/2-SIG/20-SurfacesVilles/1-BDAB&ETJM_These/ModeleGravitaire/PorjetR/Fond_R.shp",
layer = "Fond_R",
encoding = "utf8",
stringsAsFactors = FALSE)
## OGR data source with driver: ESRI Shapefile
## Source: "G:/These/These/Sujet/3-Traitements/2-SIG/20-SurfacesVilles/1-BDAB&ETJM_These/ModeleGravitaire/PorjetR/Fond_R.shp", layer: "Fond_R"
## with 15 features
## It has 1 fields
## Integer64 fields read as strings: id
# Les données sur les populations
PopulationDonneesEtmj <- read.csv("Data_R.csv", header = T, sep = ";", dec = ",", stringsAsFactors = F)
Vérification des projections géographiques
proj4string(Semis)
## [1] "+proj=lcc +lat_1=49 +lat_2=44 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +units=m +no_defs"
proj4string(Fond)
## [1] "+proj=lcc +lat_1=49 +lat_2=44 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +units=m +no_defs"
Qu’a-t-on dans le jeu de données ?
head(PopulationDonneesEtmj)
## INSEE NOM Etjm3km2 Etjm3 Rang Sup30ha TypeEtmj POP1793
## 1 80001 ABBEVILLE 3.079000 307.9000 5 307,9 Ville 18125
## 2 80013 AIRAINES 0.467146 46.7146 53 46,7146 Bourg 1490
## 3 62014 AIRE-SUR-LA-LYS 0.482772 48.2772 50 48,2772 Ville 8500
## 4 80016 ALBERT 0.539511 53.9511 44 53,9511 Ville 2000
## 5 80021 AMIENS 3.345310 334.5310 4 334,531 Ville 40000
## 6 2018 ANIZY-LE-CHÂTEAU 0.303141 30.3141 90 30,3141 Bourg 1017
## POP1821 POP1836 POP1866
## 1 18654 18247 19385
## 2 1857 1935 2270
## 3 8713 8717 8803
## 4 2299 2542 4019
## 5 41107 46129 61063
## 6 1043 1073 1116
On recode les ID et on sélectionne les villes (hors Paris)
PopulationDonneesEtmj$INSEE <- ifelse(test = nchar(as.character(PopulationDonneesEtmj$INSEE)) == 4,
yes = paste("0", PopulationDonneesEtmj$INSEE, sep=""),
no = PopulationDonneesEtmj$INSEE)
# On vire Paris qui est beaucoup trop exeptionnel
PopulationDonneesEtmj <- PopulationDonneesEtmj %>%
filter(TypeEtmj == "Ville") %>%
filter(NOM != "PARIS")
## Warning: package 'bindrcpp' was built under R version 3.4.3
On va tout d’abord réordonner les lignes pour être certain d’avoir les mêmes matrices finales (celle des poids et celle des distances)
# Réordonnancement des lignes
PopulationDonneesEtmj <- PopulationDonneesEtmj[order(PopulationDonneesEtmj$INSEE),]
# création de la matrice
MatricePoids <- matrix(nrow = nrow(PopulationDonneesEtmj), ncol = nrow(PopulationDonneesEtmj), byrow = TRUE,
dimnames = list(PopulationDonneesEtmj$INSEE, PopulationDonneesEtmj$INSEE))
head(MatricePoids)
## 02173 02304 02361 02408 02468 02691 02722 02789 02810 59017 59036
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 59043 59053 59067 59092 59094 59122 59135 59136 59153 59178 59183
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 59273 59295 59331 59350 59392 59481 59512 59571 59599 59606 60057
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 60104 60143 60157 60159 60175 60176 60471 60509 60612 62014 62038
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 62041 62119 62160 62193 62268 62318 62447 62588 62765 62767 62770
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 76255 77153 80001 80016 80021 80136 80212 80253 80410 80561 80585
## 02173 NA NA NA NA NA NA NA NA NA NA NA
## 02304 NA NA NA NA NA NA NA NA NA NA NA
## 02361 NA NA NA NA NA NA NA NA NA NA NA
## 02408 NA NA NA NA NA NA NA NA NA NA NA
## 02468 NA NA NA NA NA NA NA NA NA NA NA
## 02691 NA NA NA NA NA NA NA NA NA NA NA
## 80620 80685 80721 93066 95052
## 02173 NA NA NA NA NA
## 02304 NA NA NA NA NA
## 02361 NA NA NA NA NA
## 02408 NA NA NA NA NA
## 02468 NA NA NA NA NA
## 02691 NA NA NA NA NA
# Boucle permettant de remplir la matrice
for(i in 1:nrow(PopulationDonneesEtmj)){
for (j in 1:nrow(PopulationDonneesEtmj))
if (i != j){
MatricePoids[i,j] <- PopulationDonneesEtmj$POP1836[i]*PopulationDonneesEtmj$POP1836[j];
}
}
## Warning in PopulationDonneesEtmj$POP1836[i] * PopulationDonneesEtmj
## $POP1836[j]: NA produit par débordement d'entier par le haut
## Warning in PopulationDonneesEtmj$POP1836[i] * PopulationDonneesEtmj
## $POP1836[j]: NA produit par débordement d'entier par le haut
head(MatricePoids)
## 02173 02304 02361 02408 02468 02691 02722
## 02173 NA 11884433 14529403 36895090 7558338 92215310 37764792
## 02304 11884433 NA 8591891 21817730 4469586 54531070 22332024
## 02361 14529403 8591891 NA 26673430 5464326 66667370 27302184
## 02408 36895090 21817730 26673430 NA 13875780 169291100 69329520
## 02468 7558338 4469586 5464326 13875780 NA 34681020 14202864
## 02691 92215310 54531070 66667370 169291100 34681020 NA 173281680
## 02789 02810 59017 59036 59043 59053 59067
## 02173 11525793 12068236 29193296 13583490 44431013 7396950 26754544
## 02304 6815721 7136492 17263312 8032530 26274061 4374150 15821168
## 02361 8332611 8724772 21105392 9820230 32121551 5347650 19342288
## 02408 21159330 22155160 53593760 24936900 81567530 13579500 49116640
## 02468 4334706 4538712 10979232 5108580 16709946 2781900 10062048
## 02691 52885470 55374440 133951840 62327100 203869270 33940500 122761760
## 59092 59094 59122 59135 59136 59153 59178
## 02173 5146484 11328541 80003618 20151085 26965245 23746451 85952559
## 02304 3043348 6699077 47309746 11916245 15945765 14042347 50827623
## 02361 3720668 8190007 57838886 14568295 19494615 17167577 62139693
## 02408 9448040 20797210 146872580 36993850 49503450 43594310 157793790
## 02468 1935528 4260522 30088356 7578570 10141290 8930742 32325678
## 02691 23614360 51980390 367092220 92462150 123728550 108959290 394388610
## 59183 59273 59295 59331 59350 59392 59481
## 02173 106731264 20361786 34402542 16492957 322798415 28525329 14708723
## 02304 63115008 12040842 20343774 9753029 190885255 16868313 8697931
## 02361 77161728 14720622 24871434 11923639 233368205 20622483 10633721
## 02408 195939840 37380660 63157020 30278170 592601150 52367490 27002630
## 02468 40140288 7657812 12938364 6202794 121400430 10728018 5531766
## 02691 489730560 93428940 157854180 75677030 1481142850 130886910 67490170
## 59512 59571 59599 59606 60057 60104 60143
## 02173 87216765 22401551 89507578 87414017 58646606 10826445 4989579
## 02304 51575205 13247047 52929866 51691849 34680382 6402165 2950563
## 02361 63053655 16195277 64709806 63196259 42398762 7827015 3607233
## 02408 160114650 41125310 164320180 160476770 107664860 19875450 9159990
## 02468 32801130 8424942 33662676 32875314 22056252 4071690 1876518
## 02691 400189350 102788290 410700620 401094430 269096740 49676550 22894410
## 60157 60159 60175 60176 60471 60509 60612
## 02173 14502505 39876285 7576270 11575106 26651435 11126806 22486728
## 02304 8575985 23580645 4480190 6844882 15760195 6579782 13297416
## 02361 10484635 28828695 5477290 8368262 19267745 8044162 16256856
## 02408 26624050 73205850 13908700 21249860 48927350 20426860 41281680
## 02468 5454210 14996970 2849340 4353252 10023270 4184652 8456976
## 02691 66543950 182970150 34763300 53111740 122288650 51054740 103179120
## 62014 62038 62041 62119 62160 62193 62268
## 02173 39078311 9638450 105283255 30506815 115356556 48707795 12319284
## 02304 23108767 5699650 62258735 18040055 68215532 28803115 7284948
## 02361 28251797 6968150 76114885 22055005 83397412 35213465 8906268
## 02408 71740910 17694500 193281550 56005150 211774360 89418950 22616040
## 02468 14696862 3624900 39595710 11473230 43384152 18318390 4633128
## 02691 179308690 44225500 483086450 139978850 529307240 223493050 56526360
## 62318 62447 62588 62765 62767 62770 76255
## 02173 8109747 15493248 17335761 85320456 15475316 10140546 16761937
## 02304 4795659 9161856 10251417 50453832 9151252 5996562 9912089
## 02361 5862969 11200896 12532947 61682712 11187932 7331142 12118099
## 02408 14888070 28442880 31825410 156633360 28409960 18616260 30771970
## 02468 3049974 5826816 6519762 32087952 5820072 3813732 6303954
## 02691 37211130 71089920 79544190 391488240 71007640 46529340 76911230
## 77153 80001 80016 80021 80136 80212 80253
## 02173 7809386 81801301 11395786 206796307 6298615 11812705 17537496
## 02304 4618042 48372797 6738842 122287979 3724655 6985385 10370712
## 02361 5645822 59138527 8238622 149504089 4553605 8540035 12678792
## 02408 14336660 150172810 20920660 379641670 11563150 21686050 32195760
## 02468 2937012 30764442 4285812 77773494 2368830 4442610 6595632
## 02691 35832940 375340790 52288940 948873530 28900850 54201950 80469840
## 80410 80561 80585 80620 80685 80721 93066
## 02173 9795355 16990570 7643515 18465477 16452610 14726655 41835356
## 02304 5792435 10047290 4519955 10919469 9729170 8708535 24739132
## 02361 7081585 12283390 5525905 13349679 11894470 10646685 30245012
## 02408 17982550 31191700 14032150 33899370 30204100 27035550 76802360
## 02468 3683910 6389940 2874630 6944634 6187620 5538510 15733752
## 02691 44945450 77960300 35071850 84727830 75491900 67572450 191959240
## 95052
## 02173 8401142
## 02304 4967974
## 02361 6073634
## 02408 15423020
## 02468 3159564
## 02691 38548180
À partir du shapefile on va créer une matrice des distance entre les villes
# récupération des coordonnées (si en entrée on a un polygone, la fonction renvoie les centroïdes)
coordVilles <- as.data.frame(coordinates(Semis))
# On enrichit le tableau
colnames(coordVilles) <- c("CoordX", "CoordY")
coordVilles$INSEE <- Semis@data$INSEE_COM
coordVilles <- coordVilles %>%
filter(INSEE != "75101") # on vire Paris également
coordVilles <- coordVilles[order(coordVilles$INSEE),] # Réordonnancement des lignes pour avoir les mêmes matrices
row.names(coordVilles) <- coordVilles$INSEE
DistVilles <- dist(coordVilles, method = "euclidean") # calcul des distances entre les villes (euclidiennes)
matrice_DistVilles <- as.matrix(DistVilles) # transformation en matrice
matrice_DistVilles[matrice_DistVilles == 0] <- NA
head(matrice_DistVilles)
## 02173 02304 02361 02408 02468 02691 02722
## 02173 NA 12049.41 42440.59 29656.90 41851.15 25663.82 27867.23
## 02304 12049.41 NA 31500.37 21220.82 29887.65 21201.23 32112.26
## 02361 42440.59 31500.37 NA 36508.03 19604.07 25550.67 61464.90
## 02408 29656.90 21220.82 36508.03 NA 22304.21 39743.80 30040.34
## 02468 41851.15 29887.65 19604.07 22304.21 NA 36918.89 51719.11
## 02691 25663.82 21201.23 25550.67 39743.80 36918.89 NA 52197.21
## 02789 02810 59017 59036 59043 59053 59067
## 02173 56324.60 43278.60 134374.9 94796.38 140100.1 103064.86 170197.0
## 02304 44275.19 51483.54 132189.1 86191.78 138640.1 95224.01 169539.2
## 02361 22661.19 82487.20 117826.6 65804.85 125651.1 73057.82 157166.9
## 02408 36975.01 52812.24 147199.7 86768.56 154493.0 99527.44 186434.1
## 02468 15280.40 74297.49 135298.8 71537.66 143358.1 83295.75 175522.3
## 02691 46632.65 68918.59 113219.1 79386.56 119452.8 84050.20 149720.9
## 59092 59094 59122 59135 59136 59153 59178
## 02173 93269.70 173737.5 83665.81 151892.9 80861.80 113698.65 102657.18
## 02304 89011.07 174189.8 80372.32 151519.4 74999.96 107149.96 99938.05
## 02361 74539.14 164425.4 70049.44 140561.2 61133.63 85323.92 87277.42
## 02408 100016.30 192053.3 91944.81 168520.7 81578.81 115131.46 113521.69
## 02468 88431.23 182699.3 82829.67 158526.5 70471.14 99076.81 102864.80
## 02691 74283.56 154638.4 66966.13 132160.6 65431.51 92263.99 83177.80
## 59183 59273 59295 59331 59350 59392 59481
## 02173 178584.3 180778.0 144254.3 86687.91 126939.4 107676.67 95219.49
## 02304 178160.9 181281.7 143907.5 79595.28 123860.3 98999.85 88534.72
## 02361 166091.6 171431.4 133394.2 62380.91 107972.1 75523.77 69442.39
## 02408 195314.1 199223.0 160840.7 83944.30 137682.4 100995.28 95042.73
## 02468 184554.4 189798.4 151144.9 70781.15 124955.5 83885.31 80743.89
## 02691 158262.4 161646.4 124782.8 70734.46 105417.1 89388.27 76564.92
## 59512 59571 59599 59606 60057 60104 60143
## 02173 132065.0 86819.74 135916.6 102574.81 102452.4 88589.75 119396.9
## 02304 128047.9 81013.06 131991.4 96641.24 112338.4 97034.76 129977.3
## 02361 109737.3 65364.83 113644.8 77424.56 135256.2 115834.79 155059.1
## 02408 140710.0 88534.05 144833.5 105268.36 126120.2 112349.13 142621.3
## 02468 126539.5 76338.41 130610.6 90852.75 138741.6 121617.44 157182.3
## 02691 109738.1 69589.23 113478.7 82312.05 113114.4 94422.42 132633.1
## 60157 60159 60175 60176 60471 60509 60612
## 02173 86792.72 68320.25 88677.12 75721.13 60442.60 81194.22 87105.28
## 02304 96015.39 75026.24 97857.93 82554.46 64527.08 89721.93 95859.15
## 02361 119951.04 97503.05 123534.28 107284.50 81318.21 114515.50 121841.99
## 02408 107266.22 82373.72 106604.35 86392.99 73071.03 98146.45 102998.93
## 02468 120986.11 95745.82 122208.24 102467.55 81882.93 113106.12 119219.91
## 02691 99893.12 82047.96 104723.83 93221.29 67962.91 96604.30 104235.87
## 62014 62038 62041 62119 62160 62193 62268
## 02173 141645.0 175942.2 101019.60 124671.7 179104.2 186386.1 165241.4
## 02304 142404.6 177551.6 101314.89 124556.6 182756.5 188111.2 168378.5
## 02361 134916.1 170738.0 96273.67 116044.3 181224.1 181277.9 165945.0
## 02408 160046.2 196162.9 117423.93 141183.2 202441.3 206869.1 187707.9
## 02468 152179.8 188614.8 111198.51 132784.6 198175.3 199290.2 182884.2
## 02691 123964.0 158655.7 85416.97 106568.5 165355.6 169112.6 150819.0
## 62318 62447 62588 62765 62767 62770 76255
## 02173 162312.6 133626.2 152610.8 157106.8 121969.6 136389.5 155887.2
## 02304 166864.2 137624.6 157084.6 157968.8 124351.4 136540.6 163460.4
## 02361 168383.9 139049.6 158806.6 150003.5 122370.2 127896.6 174894.2
## 02408 186636.4 156737.2 176684.3 175860.1 142505.6 153589.0 182120.0
## 02468 184304.9 154338.4 174478.5 167660.5 138022.3 145060.0 186451.0
## 02691 150790.1 122008.8 141232.5 139139.9 107935.4 118123.7 153375.5
## 77153 80001 80016 80021 80136 80212 80253
## 02173 105454.8 137725.8 97859.36 107340.8 93554.07 99646.76 116973.3
## 02304 112934.8 143813.7 100737.22 113014.2 96266.53 104105.42 120560.6
## 02361 138076.6 152098.0 105329.72 123454.2 101512.75 112536.12 123883.6
## 02408 116378.7 161928.3 115287.83 128890.3 110001.59 119097.00 137288.1
## 02468 133057.2 164150.4 115327.40 132661.7 110543.07 121604.31 136345.4
## 02691 123347.5 132638.4 91268.61 105183.5 87979.09 96150.30 108218.3
## 80410 80561 80585 80620 80685 80721 93066
## 02173 80319.89 91438.44 82998.20 88123.04 84834.75 152237.0 134431.6
## 02304 81542.43 97327.57 85651.60 89365.69 88945.81 158530.0 142670.3
## 02361 88971.12 112546.00 94854.71 92905.13 101341.40 166507.5 168005.3
## 02408 89839.90 109431.48 95946.86 101034.81 99706.19 177147.9 147316.8
## 02468 92523.06 116930.22 99544.66 100692.18 105431.52 179169.7 163969.2
## 02691 79777.80 95740.66 82848.56 82338.88 87279.60 146728.0 151788.9
## 95052
## 02173 126201.9
## 02304 134368.0
## 02361 157706.1
## 02408 141632.7
## 02468 156200.9
## 02691 140498.6
Au cas où on a un problème de correspondance entre les matrices (pas les mêmes villes par exemple), on réalise un test pour vérifier qu’il n’y a pas de soucis dans nos données.
TestIdentifiants <- inner_join(PopulationDonneesEtmj, coordVilles, "INSEE")
nrow(PopulationDonneesEtmj)
## [1] 71
nrow(TestIdentifiants) # doit être égal au nbre de ligne du tableau en entrée sur les populations ou les coordonnées
## [1] 71
On prend ici une valeur d’\(\alpha\) égale à 2, ce qui est relativement traditionnel (cf. modèle de Stewart). L’objectif étant bien entendu (mais pas ici) de tester différentes valeurs d’\(\alpha\) car c’est un paramètre.
# Voici la différence entre alpha = 1 et alpha = 2
curve(1/x, from=1, to=50, xlab="Distance", ylab="Fij", col = "blue")
curve(1/(x^2), from=1, to=50, xlab="Distance", ylab="Fij", add = T, col = "red")
# Matrice des flux potentiels
FluxPotentielsDijCarre <- MatricePoids/(matrice_DistVilles^2)
Transformation de la matrice en tableau à trois entrées :
- l’origine du flux (i),
- la destination du flux (j),
- le flux potentiel
OrigineDestDij <- melt(FluxPotentielsDijCarre, id = c("INSEE_Dep", "INSEE_Arr"), measure = "FluxPotentielDij")
# On va virer les NA (= ce sont les i et j identiques)
OrigineDestDij <- OrigineDestDij %>%
filter(!is.na(value))
# on renomme les colonnes et réorganise le tableau
colnames(OrigineDestDij) <- c("Orig", "Dest", "Fij")
OrigineDestDij <- OrigineDestDij[order(OrigineDestDij$Orig),]
head(OrigineDestDij)
## Orig Dest Fij
## 71 2173 2304 0.081855312
## 141 2173 2361 0.008066497
## 211 2173 2408 0.041948563
## 281 2173 2468 0.004315306
## 351 2173 2691 0.140010390
## 421 2173 2722 0.048629453
On crée un graphe à partir du tableau des flux origine-destination. Du fait que les flux sont symétriques, on ne va pas garder la totalité des \(F_{ij}\), mais on ne va sélectionner qu’une partie de la matrice.
Graphe_Dij <- graph_from_data_frame(OrigineDestDij, directed = F)
summary(Graphe_Dij)
## IGRAPH 1b10ee5 UN-- 71 4968 --
## + attr: name (v/c), Fij (e/n)
# On simplifie le graphe <=> on ne sélectionne qu'une partie (inférieure ou supérieure) de la matrice des flux
Graphe_Dij <- simplify(Graphe_Dij)
summary(Graphe_Dij)
## IGRAPH 1b12c31 UN-- 71 2484 --
## + attr: name (v/c)
On va ensuite enrichir le graphe de données, sur les liens et sur les noeuds.
# Enrichissement des liens
doublonFij <- !duplicated(OrigineDestDij$Fij)
sum(doublonFij, na.rm=FALSE) # doit être égale au nombre de liens du graphe
## [1] 2484
OrigineDestDij <- OrigineDestDij[doublonFij,]
E(Graphe_Dij)$Fij <- OrigineDestDij$Fij
# Enrichissement des noeuds
V(Graphe_Dij)$POP <- PopulationDonneesEtmj$POP1836
V(Graphe_Dij)$NOM <- PopulationDonneesEtmj$NOM
summary(Graphe_Dij)
## IGRAPH 1b12c31 UN-- 71 2484 --
## + attr: name (v/c), POP (v/n), NOM (v/c), Fij (e/n)
Pour représenter le graphe, on a besoin que chaque noeud soit géocodé.
# On récupère les coordonnées des points d'après le tableau précédent (coordVilles)
coordsGraphe <- as.matrix(coordVilles[,1:2])
Graphe_Dij$layout <- coordsGraphe
On peut maintenant visualiser les flux potentiels entre les villes !
plot(Fond, border = "grey")
plot.igraph(Graphe_Dij, rescale = F,
vertex.size = 2,
vertex.label = V(Graphe_Dij)$NOM, vertex.label.cex = 0.7,
edge.curved = 0.4,
edge.color = "red", add=T)
En toute logique, on ne voit pas grand chose car il y a des flux potentiels entre toutes les villes. On va donc sélectionner une partie seulement des flux à représenter. Pour cela, on décide de représenter que les 10% des flux les plus importants (en volume).
# Calcul des déciles
DecilesFlux <- quantile(E(Graphe_Dij)$Fij, probs = seq(0,1,0.1))
DecilesFlux <- as.data.frame(DecilesFlux)
# Sélection d'une partie du graphe
GraphePrincipalDij <- delete_edges(graph = Graphe_Dij,
edges = E(Graphe_Dij)[E(Graphe_Dij)$Fij < DecilesFlux[10,1]])
summary(GraphePrincipalDij)
## IGRAPH 1bee323 UN-- 71 249 --
## + attr: layout (g/n), name (v/c), POP (v/n), NOM (v/c), Fij (e/n)
Visualisation
plot(Fond, border = "grey")
plot.igraph(GraphePrincipalDij, rescale = F,
vertex.size = 1,
vertex.label = V(GraphePrincipalDij)$NOM, vertex.label.cex = 0.5,
vertex.color = "grey50",
vertex.label.color = "black",
edge.curved = 0.2,
edge.width = E(GraphePrincipalDij)$Fij,
edge.color = "darkorange", add=T)
On peut visualiser les flux différemment, en particulier sous forme de heatmap. On récupère sous forme matricielle le deuxième graphe (on aurait également pu travailler directement sur le tableau origine/destination en ne sélectionnant que les 10% des flux majeurs et en le transformant en matrice), puis on le représente en heatmap.
# Récupération de la matrice d'adjacence du graphe composé des flux majeurs
MatGrapheMaj <- as_adjacency_matrix(GraphePrincipalDij,
attr = "Fij", sparse = F) # les valeurs de la matrice sont celles des flux
row.names(MatGrapheMaj) <- V(GraphePrincipalDij)$NOM
colnames(MatGrapheMaj) <- V(GraphePrincipalDij)$NOM
# Représentation sous forme de heatmap
PalettePerso <- colorRampPalette(c("gold", "red"))
heatmap(MatGrapheMaj, Rowv = NA, Colv = NA,
col = PalettePerso(100),
scale = "none")
On observe que les flux principaux sont entre Lille, Roubaix et Tourcoing. Les flux potentiels entre ces trois villes sont tellement important qu’on ne visualise pas bien tous les autres.
Si l’objectif est de visualiser quelles sont les villes qui sont les plus connectées, on peut également sélectionner la matrice d’adjacence du 2e graphe mais en regardant les flux en présence/absence.
# Récupération de la matrice d'adjacence du graphe composé des flux majeurs
MatGrapheMaj_pres <- as_adjacency_matrix(GraphePrincipalDij, sparse = F)
row.names(MatGrapheMaj_pres) <- V(GraphePrincipalDij)$NOM
colnames(MatGrapheMaj_pres) <- V(GraphePrincipalDij)$NOM
# Heatmap présence/absence de flux majeurs
heatmap(MatGrapheMaj_pres, Rowv = NA, Colv = NA,
col = PalettePerso(100),
scale = "none")
# Heatmap avec réordonnancement des lignes et colonnes
heatmap(MatGrapheMaj_pres,
col = PalettePerso(100),
scale = "none")
On observe ici que les villes les mieux connectées sont Amiens, Lille, Boulogne-sur-Mer, etc. D’autres villes sont moyennement connectées (plus ou moins celles comprises entre Bergues et Beauvais sur le heatmap). D’autres sont très peu connectées, telles que Noyon, Breteuil, Clermont. Enfin, certaines villes n’ont aucune connexion (quand on regarde les 10% des flux les plus importants), telles que Guise ou Ham.