Commit b3367ee9 authored by Françoise Bahoken's avatar Françoise Bahoken
Browse files

Update how-to-build-flow-maps.R with gross and net flow types

parent 09c36114
......@@ -11,20 +11,107 @@ knitr::opts_chunk$set(
library(flowmapper)
## ----out.width = 200----------------------------------------------------------
#---------------------
# 0. DATA Importation
#---------------------
library(sf)
# Import
crs <- "+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs"
subregions <- st_read(system.file("subregions.gpkg", package="flowmapper")) %>% st_transform(crs)
migr <- read.csv(system.file("migrantstocks2019.csv", package="flowmapper"))
# Selection, filtrage, traitement en amont
#---------------------
# I. DATA Preparation
#---------------------
library(dplyr)
library(cartograflow)
threshold <- 1500
migr <- migr[migr$fij >= threshold,]
## -----------------------------------------------------------------------------
# Square and close the matrix
mat_migr<-flowtabmat(migr, matlist="M")
migr<-flowtabmat(mat_migr, matlist="L")
colnames(migr) <- c("i","j", "fij")
## I.1. Compute bilateral flows
#----------------------------
# Gross flows
# With triangular upper reduction
migr_gross<-flowmapper_types(migr,origin="i",destination="j",fij="fij",format="L",type="gross", lowup="up")
colnames(migr_gross) <- c("i","j", "fij")
# Net flows
# Keeping only positive net flows
migr_net<-flowmapper_types(migr,origin="i",destination="j", fij="fij", format="L",type="net", net="positive")
colnames(migr_net) <- c("i","j", "fij")
## I.2. Compute places oriented flows
#----------------------------
# Intrazonal interactions
intra <- migr_gross[migr_gross$i == migr_gross$j,c("i","fij")]
colnames(intra) <- c("id","nb")
# Flow volum by places
voli <- flowplaces(migr_gross, origin ="i",destination="j",fij="fij",format = "L", x = "voli")
colnames(voli) <- c("id","vol")
voli<-as.data.frame(voli)
#---------------------
# II. FLOW DATA REDUCTION
#---------------------
# Flow thresholding
#---------------------
# Mean value as Tobler's suggestion
threshold_gross<-mean(migr_gross$fij)
threshold_net<-mean(migr_net$fij)
# Matrix reduction
#---------------------
migr_gross <- migr_gross[migr_gross$fij >= threshold_gross,]
migr_net <- migr_net[migr_net$fij >= threshold_net,]
# Variable typing
str(migr_gross)
migr_gross$i<-as.character(migr_gross$i)
migr_gross$j<-as.character(migr_gross$j)
migr_gross$fij<-as.numeric(migr_gross$fij)
migr_net$i<-as.character(migr_net$i)
migr_net$j<-as.character(migr_net$j)
migr_net$fij<-as.numeric(migr_net$fij)
#---------------------
# III. FLOW MAPPING
#---------------------
# III.1 Standard flowmaps
#---------------------
# Map1: All bilateral migrations
# -------------------------------
# Interactions only
#---------------------
# Default plot
c <- plotflows(
x = subregions,
xid = "id",
......@@ -33,50 +120,160 @@ c <- plotflows(
dfvar = "fij"
)
## -----------------------------------------------------------------------------
intra <- migr[migr$i == migr$j,c("i","fij")]
colnames(intra) <- c("id","nb")
mtext("All flows")
# Add map background and arrows parameters
plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
c <- plotflows(
x = subregions,
xid = "id",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
size = "thickness",
type = "rect",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = "#00FF0090",
border = "#4a0c25",
k = NULL,
df2 = intra,
df2id = "id",
df2var = "nb"
x = subregions,
xid = "id",
df = migr,
dfid = c("i","j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = "#00FF0090",
border = "#4a0c25",
k = NULL,
df2 = intra,
df2id = "id",
df2var = "nb"
)
mtext("Map 1 : All bilateral migrations")
# Map 2: Gross migrations above mean
# -------------------------------
# rectangle and thickness
plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
c <- plotflows(
x = subregions,
xid = "id",
df = migr_gross,
dfid = c("i","j"),
dfvar = "fij",
size = "thickness",
type = "rect",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = "#00FF0090",
border = "#4a0c25",
k = NULL,
df2 = intra,
df2id = "id",
df2var = "nb"
)
mtext("Map 2 : Main gross migrations")
# Map 3: Net migrations above mean
# -------------------------------
# arrows and thickness
plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
c <- plotflows(
x = subregions,
xid = "id",
df = migr_net,
dfid = c("i","j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = "#00FF0090",
border = "#4a0c25",
k = NULL,
df2 = intra,
df2id = "id",
df2var = "nb"
)
mtext("Map 3 : Main net migrations")
#plot(st_geometry(subregions), col = "#CCCCCC", border = "white", lwd = 0.5)
#c <- plotflows(
# x = subregions,
# xid = "id",
# df = migr,
# dfid = c("i","j"),
# dfvar = "fij",
# size = "thickness",
# type = "rect",
# decreasing = FALSE,
# add = TRUE,
# lwd = 1,
# col = "#00FF0090",
# border = "#4a0c25",
# k = NULL,
# df2 = intra,
# df2id = "id",
# df2var = "nb"
#)
# III.2 Non standard flowmaps
#---------------------
# Playing with cartographic projection : polar oriented
# Map 4: Net migrations above mean
# -------------------------------
# arrows and thickness
## -----------------------------------------------------------------------------
crs <- "+proj=aeqd +lat_0=90 +lon_0=50 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs "
subregions2 <- st_transform(subregions, crs)
plot(st_geometry(subregions2), col = "#CCCCCC", border = "white", lwd = 0.5)
c <- plotflows(
x = subregions2,
xid = "id",
df = migr,
df = migr_net,
dfid = c("i","j"),
dfvar = "fij",
add = TRUE
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = "#00FF0090",
border = "#4a0c25",
k = NULL
)
mtext("Map 4 : Main net migrations (polar oriented)")
# Map 4: Global migrations above mean - default map
# -------------------------------
# rectangle and thickness
## -----------------------------------------------------------------------------
crs <- "+proj=ortho +lat_0=42.5333333333 +lon_0=-72.53333333339999 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"
flows <- smoothr::densify(c[[3]], n = 30) %>% st_transform(crs)
plot(st_geometry(subregions) %>% st_transform(crs), col ="#CCCCCC", border = "white")
plot(st_geometry(flows), col ="#FF000099", add = TRUE)
plot(st_centroid(st_geometry(c[[2]])) %>% st_transform(crs), add = TRUE, pch = 20, cex = 1.3, col ="black")
mtext("Map 5 : global migrations (globe oriented)")
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment