add centroïd extraction for countries, regions and sub regions

data handling.R

@@ -136,12 +136,41 @@ subregions <- subregions[,c("Code2","Label2")]
 st_geometry(subregions) <- st_cast(subregions$geometry, "MULTIPOLYGON")
 colnames(subregions) <- c("id","label","geometry")
 
+# Centroïd extraction
+
+countries <- st_read("data/world/geom/countries.gpkg")
+bkg<-countries
+pt_centroid<-bkg %>% sf::st_centroid()
+pts<-st_coordinates(pt_centroid)
+XYcountries<-cbind(pts,pt_centroid)
+
+regions <- st_read("data/world/geom/regions.gpkg")
+bkg<-regions
+pt_centroid<-bkg %>% sf::st_centroid()
+pts<-st_coordinates(pt_centroid)
+XYregions<-cbind(pts,pt_centroid)
+
+subregions <- st_read("data/world/geom/subregions.gpkg")
+bkg<-subregions
+pt_centroid<-bkg %>% sf::st_centroid()
+pts<-st_coordinates(pt_centroid)
+XYsubregions<-cbind(pts,pt_centroid)
+
+
 # Export geopackage
 
 if(!dir.exists("data/geom")){dir.create("data/geom")}
-st_write(world,"data/geom/countries.gpkg")
-st_write(regions,"data/geom/regions.gpkg")
-st_write(subregions,"data/geom/subregions.gpkg")
+st_write(world,"data/world/geom/countries.gpkg")
+st_write(regions,"data/world/geom/regions.gpkg")
+st_write(subregions,"data/world/geom/subregions.gpkg")
+
+
+# Export geopackage points
+
+st_write(XYcountries,"data/world/geom/XYsubregions.gpkg")
+st_write(XYregions,"data/world/geom/XYregions.gpkg")
+st_write(XYsubregions,"data/world/geom/XYcountries.gpkg")
+
 
 # Other geometries
 

data handling_matrix.R

@@ -0,0 +1,217 @@
+#----------------------------
+# DATA HANDLING : COMPUTE SEVERAL TYPES OF MATRIX
+# Computes bilateral flows (Fij) and marginal (on i) flow indicators
+#----------------------------
+
+
+#rm(list=ls())
+
+# Compute flow types for several matrix
+
+setwd("D:/R/github/transcarto/rflows")
+
+
+# Packages
+#----------------------------
+
+library("dplyr")
+library("cartograflow")
+
+
+# Import data
+#----------------------------
+
+#geography
+countries <- st_read("./data/world/geom/countries.gpkg")
+
+#flows
+
+setwd("./data/world/fij")
+
+list.files() # 21 files
+
+file=list.files(pattern = "*.csv")
+
+
+for (index in 1:21){
+
+flow<- read.csv2(file[index],
+                   header=TRUE,sep=",",
+                   stringsAsFactors=FALSE,
+                   encoding="UTF-8",dec=".", check.names=FALSE)
+
+
+# Variable typing
+countries$adm0_a3_is<-as.character(countries$adm0_a3_is)
+
+flow$i<-as.character(flow$i)
+flow$j<-as.character(flow$j)
+flow$fij<-as.numeric(flow$fij)
+
+
+#----------------------------
+# (I) Compute flows types indicators (on fij) 
+# for OD flowmapping
+#----------------------------
+
+
+# 1) Close and square the matrix
+#----------------------------
+
+# creating a single vector list of codes
+liste<-countries%>%select(adm0_a3_is)
+liste<-as.data.frame(liste$adm0_a3_is)
+
+
+tabflow<-flowcarre(tab=flow,
+                   liste=liste,
+                   origin = "i", dest="j",valflow="fij",
+                   format="L",
+                   diagonale = TRUE,
+                   empty.sq = FALSE
+)
+
+colnames(tabflow)<-c("i", "j", "Fij")
+
+
+
+# 2) Compute all bilateral flows indicators (on Fij) 
+#----------------------------
+
+# Compute only bilateral flow volum : FSij
+#----------------------------
+#flow_vol<-flowtype(tabflow, origin ="i",destination="j",fij="Fij", format="L", "bivolum")
+
+# Compute all 9 types of bilateral flows (and supress NA)
+#------------------------
+# Fij : observed flow 
+# Fji : reverse flow 
+# FSij : bilateral volum flow
+# FBij : bilateral balance flow
+# FAij : asymetry of bilateralflow
+# minFij : bilateral - cooperation - ie. symetry as min of (Fij, Fji)
+# maxFij : bilateral - competition - ie. symetry as max of (Fij, Fji)
+# rangeFij : bilateral range as (maxFij - minFij)
+# FDij : bilateral disymetry as (bilateral volum / bilateral range)
+
+flow_indic<-flowtype(tabflow, origin ="i",destination="j",fij="Fij",
+                     format="L", x="alltypes")
+
+# supress NA cells
+
+for (i in 1:nrow(flow_indic))
+  for (j in 1:ncol(flow_indic))
+  {if (is.na.data.frame(flow_indic[i,j])==TRUE) {flow_indic[i,j]<-0}
+  }
+
+flow_indic$i<-as.character(flow_indic$i)
+flow_indic$j<-as.character(flow_indic$j)
+
+head(flow_indic)
+
+
+# Export 
+#----------------------------
+if(!dir.exists("D:/R/github/transcarto/rflows/data/world/fij_indic"))
+  {dir.create("D:/R/github/transcarto/rflows/data/world/fij_indic")}
+
+filename_tabflow <- paste0("D:/R/github/transcarto/rflows/data/world/fij_indic/fij_indic_",file[index])
+write.csv2(flow_indic,filename_tabflow)
+
+}
+
+
+
+
+#----------------------------
+# (II) Compute flows margins indicators (on i) 
+# for choropleth flowmapping
+#----------------------------
+
+
+rm(list=ls())
+
+# Compute flow types for several matrix
+
+setwd("D:/R/github/transcarto/rflows")
+
+
+# Packages
+#----------------------------
+
+library("dplyr")
+library("cartograflow")
+
+
+setwd("./data/world/fij")
+
+list.files() # 21 files
+
+
+file=list.files(pattern = "*.csv")
+
+
+
+for (index in 1:21) {
+
+flow<- read.csv2(file[index],
+                   header=TRUE,sep=",",
+                   stringsAsFactors=FALSE,
+                   encoding="UTF-8",dec=".", check.names=FALSE)
+
+# Oi : marginal sum of the place of origin
+#----------------------------
+tabOi<-flow %>%
+  group_by(i)%>%
+  summarise(Oi = sum(fij),count_Oi = n())
+
+# Di : marginal sum of the place of destination
+#----------------------------
+tabDj<-flow %>%
+  group_by(j)%>%
+  summarise(Dj = sum(fij),count_Dj = n())
+
+colnames(tabDj)<-c("i", "Dj","count_Dj")
+
+as.data.frame(tabOi)
+as.data.frame(tabDj)
+
+# Margin table
+#----------------------------
+tabOiDj<-merge(tabOi,tabDj,
+               by=c("i"), 
+               all.X=TRUE,all.Y=TRUE)
+
+# Add Asymetry
+#----------------------------
+tabOiDj <- tabOiDj %>%
+  mutate (Vol=Oi+Dj, Bal=Oi-Dj, Asy=Bal/Vol)
+
+str(tabOiDj)
+
+tabOiDj$i<-as.character(tabOiDj$i)
+tabOiDj$Oi<-as.numeric(tabOiDj$Oi)
+tabOiDj$Dj<-as.numeric(tabOiDj$Dj)
+tabOiDj$Vol<-as.numeric(tabOiDj$Vol)
+tabOiDj$Bal<-as.numeric(tabOiDj$Bal)
+tabOiDj$Asy<-as.numeric(tabOiDj$Asy)
+
+
+head(tabOiDj)
+
+# Export
+#----------------------------
+
+if(!dir.exists("D:/R/github/transcarto/rflows/data/world/fij_OiDj"))
+  {dir.create("D:/R/github/transcarto/rflows/data/world/fij_OiDj")}
+
+filename_tabOiDj <- paste0("D:/R/github/transcarto/rflows/data/world/fij_OiDj/OiDj_",file[index])
+write.csv2(tabOiDj,filename_tabOiDj)
+
+
+}
+
+
+
+
+

data handling_matrix_isere.R

@@ -0,0 +1,75 @@
+# -------------------------------------------
+# Isere - Mobilites professionnelles MOBPRO 2017 - 2020
+#
+# Download Data handling and matrix preparation 
+# -------------------------------------------
+
+#rm(list=ls())
+
+setwd("D:/R/github/transcarto/rflows/")
+
+library("tidyverse")
+
+#-----------------------
+# I- download data
+#-----------------------
+
+data_url <- "https://www.insee.fr/fr/statistiques/fichier/4509353/base-csv-flux-mobilite-domicile-lieu-travail-2017.zip"
+data_website <- "https://www.insee.fr/fr/statistiques/4509353"
+data_source <- "INSEE, Mobilités professionnelles en 2017 : déplacements domicile - lieu de travail, Recensement de la population - Base flux de mobilité"
+
+
+if(!dir.exists("./data/isere")){dir.create("data")}
+if(!dir.exists("./data/isere/input")){dir.create("./data/isere/input")}
+
+file <- "./data/isere/input/base-csv-flux-mobilite-domicile-lieu-travail-2017.zip"
+
+# Dezip
+#-----------------------
+
+download.file(url =data_url, destfile = "./data/isere/input/mobpro2017.zip")
+unzip("./data/isere/input/mobpro2017.zip", exdir = "data/isere/input")
+file.remove("data/isere/input/mobpro2017.zip")
+
+mobpro2017 <-st_read(dsn = "./data/isere/input/base-flux-mobilite-domicile-lieu-travail-2017.csv",
+                     stringsAsFactors = F)
+
+#-----------
+# Extraction des OD de l'Isère (commune*commune)
+#-----------
+
+# Création d'un champs département origine et destination
+#-----------
+
+tabflow<-mobpro2017
+
+tabflow=tabflow %>%
+  mutate (dept_O=CODGEO, dept_D=DCLT)
+
+tabflow$dept_O <- substr(tabflow$dept_O, 1, 2)
+tabflow$dept_D <- substr(tabflow$dept_D, 1, 2)
+
+head(tabflow)
+
+
+# Filtrage du département 38 en origine et zn destination
+#-----------
+
+tabflow=filter(tabflow,dept_O=="38")
+tabflow=filter(tabflow,dept_D=="38")
+head(tabflow)
+
+
+# Variable typing
+#-----------
+tabflow$NBFLUX_C17_ACTOCC15P<-as.numeric(tabflow$NBFLUX_C17_ACTOCC15P)
+
+# Export
+#-----------
+
+if(!dir.exists("./data/isere")){dir.create("data")}
+if(!dir.exists("./data/isere/fij")){dir.create("./data/isere/fij")}
+
+
+st_write(tabflow,"./data/isere/fij/mobpro_isere2017.csv")
+

data handling_one_matrix.R

@@ -36,11 +36,10 @@ flow$j<-as.character(flow$j)
 flow$fij<-as.numeric(flow$fij)
 
 
-
 #----------------------------
 # (I) Compute flows types indicators (on fij) 
 # for OD flowmapping
-#----------------------------#
+#----------------------------
 
 
 
@@ -82,7 +81,6 @@ flow_net<-flowtype(tabflow, origin ="i",destination="j",fij="Fij",
 
 
 
-
 # (3) Compute asymmetry of bilateral flows : FAij
 #----------------------------
 
@@ -99,7 +97,6 @@ for (i in 1:nrow(flow_asy))
   }
 
 
-
 #----------------------------
 # Compute all 9 types of bilateral flows indicators (on Fij)
 # (and supress NA)
@@ -139,8 +136,6 @@ st_write(flow_indic,"./data/world/fij_indic/fij_indic_migr2019.csv")
 
 
 
-
-
 #----------------------------
 # (II) Compute flows margins indicators (on i) 
 # for choropleth flowmapping