first commit
This commit is contained in:
François Pelletier
commit
59e217b2e4
2 changed files with 184 additions and 0 deletions
176
merge_travaux_routiers.Rmd
Normal file
176
merge_travaux_routiers.Rmd
Normal file
|
|
@ -0,0 +1,176 @@
|
|||
---
|
||||
title: "Travaux Routiers - Assemblage"
|
||||
output:
|
||||
html_document:
|
||||
fig_width: 6
|
||||
fig_height: 6
|
||||
keep_md: yes
|
||||
---
|
||||
|
||||
```{r Initialisation de knitr, include=FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE)
|
||||
```
|
||||
|
||||
Dans ce billet, je vais consolider les différents fichiers [GPX des travaux routiers](https://www.quebec511.info/fr/Diffusion/EtatReseau/TravauxGps.aspx) publiés par Transports Québec en un seul fichier GeoJSON qui peut être utilisé dans n'importe quel logiciel de système d'information géographique (GIS).
|
||||
|
||||
Je vais d'abord télécharger les données en utilisant le logiciel `wget` en ligne de commande et une boucle pour chacune des régions ayant des fichiers disponibles.
|
||||
|
||||
```{bash eval=FALSE}
|
||||
#!/bin/bash
|
||||
for i in $(echo "for (i=1;i<=13;i++) i*1000"| bc)
|
||||
do
|
||||
wget "https://www.quebec511.info/fr/Diffusion/EtatReseau/TravauxGps.aspx?idreg=${i}&p=0&action=gps" \
|
||||
--output-document="travaux_gps_${i}.gpx"
|
||||
done
|
||||
```
|
||||
|
||||
Dans R, je charge d'abord les packages requis pour le traitement qui suit.
|
||||
|
||||
```{r Charger les packages requis, message=FALSE, warning=FALSE}
|
||||
library(sf)
|
||||
library(dplyr)
|
||||
library(stringr)
|
||||
library(lubridate)
|
||||
library(ggplot2)
|
||||
library(ggmap)
|
||||
```
|
||||
|
||||
Je liste les fichiers GPX contenus dans le répertoire de travail:
|
||||
|
||||
```{r Lister les GPX dans le répertoire}
|
||||
gpxfiles <- list.files("~/Nextcloud/gpx/",
|
||||
pattern = "*.gpx")
|
||||
```
|
||||
|
||||
```{r Afficher la liste de fichiers GPX, echo=FALSE}
|
||||
gpxfiles
|
||||
```
|
||||
Comme les fichiers GPX ont une capacité limitée à contenir une variété d'attributs associés aux entités géospatiales, les informations telles que les dates de début et de fin des travaux ou le numéro de la route concernée sont concaténées dans le champs `name` et `desc`.
|
||||
|
||||
Je crée ici une fonction qui permet de lire un fichier GPX et d'extraire ces champs ainsi que la géométrie associée, et retourner le tout sous la forme d'un data.frame, qui est la structure par défaut de traitement des données en R.
|
||||
|
||||
```{r Définir la fonction de lecture des GPX}
|
||||
getwaypoint <- function(gpxfile)
|
||||
{
|
||||
gpxfile %>%
|
||||
st_read(layer = "waypoints", quiet=TRUE) %>%
|
||||
select(name, desc, geometry) %>%
|
||||
as.data.frame()
|
||||
}
|
||||
```
|
||||
|
||||
J'applique ici la fonction à la liste des chemins des fichiers créée précédemment. La fonction [lapply](https://www.rdocumentation.org/packages/base/versions/3.6.2/topics/lapply) permet d'appliquer une fonction sur chacun des éléments d'une liste et de retourner une liste de même longueur. C'est l'équivalent de la [list comprehension](https://www.w3schools.com/python/python_lists_comprehension.asp) de Python.
|
||||
|
||||
J'ajoute aussi une clé synthétique à chaque rangée (`rowkey`) afin de ne pas avoir à effectuer de fusion de tables sur des champs texte complexes (conseil d'ami, ne fusionnez jamais des données sur un champ en texte libre).
|
||||
J'ajoute aussi la date du jour dans une colonne, afin d'identifier la journée où les données ont été téléchargées, comme cette information n'apparaît pas dans le fichier.
|
||||
|
||||
```{r Lire tous les GPX dans un seul Tibble}
|
||||
mywaypoints <- lapply(gpxfiles, getwaypoint) %>%
|
||||
bind_rows() %>%
|
||||
mutate(rowkey = seq_along(name),
|
||||
record_date = today())
|
||||
```
|
||||
|
||||
J'utilise ici une expression régulière afin d'extraire le type de travaux, la date de début et la date de fin depuis le champ `name`.
|
||||
|
||||
```{r Extraction des attributs depuis le nom}
|
||||
name_groups <- mywaypoints$name %>%
|
||||
str_match(pattern = "^([A-Za-z]+)\\s+([0-9]{1,2}/[0-9]{1,2}/[0-9]{1,2})\\s+([0-9]{1,2}/[0-9]{1,2}/[0-9]{1,2})$") %>%
|
||||
`colnames<-`(c("name", "type", "date_debut", "date_fin")) %>%
|
||||
as.data.frame %>%
|
||||
mutate(rowkey = mywaypoints$rowkey)
|
||||
```
|
||||
|
||||
J'effectue un traitement similaire pour le champ `desc` qui contient le nom de la route, une date de début et de fin associée à la route ainsi que d'autres informations superflues.
|
||||
|
||||
```{r Extraction des attributs depuis la description}
|
||||
desc_groups <- mywaypoints$desc %>%
|
||||
str_match(pattern = "^(.*)\\s+([0-9]{1,2}/[0-9]{1,2}/[0-9]{1,2})\\s+([0-9]{1,2}/[0-9]{1,2}/[0-9]{1,2})\\s+") %>%
|
||||
`colnames<-`(c("desc", "route", "date_debut_rte", "date_fin_rte")) %>%
|
||||
as.data.frame %>%
|
||||
mutate(rowkey = mywaypoints$rowkey)
|
||||
```
|
||||
|
||||
Je fusionne ici les données extraites aux données originales en utilisant la clé synthétique (`rowkey`) que j'ai générée plus tôt. Je conserve seulement les champs qui ont des informations pertinentes à l'aide d'un `select`.
|
||||
|
||||
```{r Fusion des attributs}
|
||||
mywaypoints2 <- mywaypoints %>%
|
||||
inner_join(name_groups, by = "rowkey") %>%
|
||||
inner_join(desc_groups, by = "rowkey") %>%
|
||||
select(
|
||||
record_date,
|
||||
type,
|
||||
date_debut,
|
||||
date_fin,
|
||||
route,
|
||||
date_debut_rte,
|
||||
date_fin_rte,
|
||||
geometry
|
||||
)
|
||||
```
|
||||
|
||||
Je me prépare ici à exporter les données. Comme la fonction utilisée ci-dessous ne permet pas d'écraser un fichier GeoJSON, je supprime ici le fichier s'il existe.
|
||||
|
||||
```{r Suppression des données existantes}
|
||||
export_geojson_path <- "~/Nextcloud/gpx/all.geojson"
|
||||
succes.supprimer <- if (file.exists(export_geojson_path)) {
|
||||
file.remove(export_geojson_path)
|
||||
}
|
||||
```
|
||||
|
||||
J'utilise la fonction `st_write` pour écrire un fichier GeoJSON aves les données assemblées.
|
||||
|
||||
```{r Écriture des données extraites, include=FALSE}
|
||||
mywaypoints2 %>% st_write(dsn = export_geojson_path,
|
||||
driver = "GeoJSON",
|
||||
append = FALSE)
|
||||
```
|
||||
|
||||
Enfin, avant de conclure ce billet, profitons-en pour visualiser les données.
|
||||
|
||||
```{r}
|
||||
mywaypoints2_df <- fortify(mywaypoints2)
|
||||
```
|
||||
|
||||
Je calcule d'abord l'étendue des données pour télécharger le fond de carte correspondant.
|
||||
|
||||
```{r}
|
||||
mywaypoints2_bbox <- st_bbox(mywaypoints2_df$geometry) %>% as.list()
|
||||
```
|
||||
|
||||
Je télécharge ensuite le fond de carte.
|
||||
|
||||
```{r Télécharger le fond de carte, echo=TRUE, message=FALSE, warning=FALSE, cache=TRUE}
|
||||
mapImage <- get_map(
|
||||
c(
|
||||
left = mywaypoints2_bbox$xmin,
|
||||
bottom = mywaypoints2_bbox$ymin,
|
||||
right = mywaypoints2_bbox$xmax,
|
||||
top = mywaypoints2_bbox$ymax
|
||||
),
|
||||
maptype = "terrain",
|
||||
zoom = 7,
|
||||
source = "stamen"
|
||||
)
|
||||
```
|
||||
|
||||
Enfin, j'affiche les points sur une carte
|
||||
|
||||
```{r}
|
||||
plot(st_transform(mywaypoints2_df$geometry, crs = 3857),
|
||||
bgMap = mapImage,
|
||||
pch = 3,
|
||||
main="Travaux routiers au Québec",
|
||||
axes = TRUE
|
||||
)
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
8
telecharger.sh
Normal file
8
telecharger.sh
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#!/bin/bash
|
||||
for i in $(echo "for (i=1;i<=13;i++) i*1000"| bc)
|
||||
do
|
||||
wget "https://www.quebec511.info/fr/Diffusion/EtatReseau/TravauxGps.aspx?idreg=${i}&p=0&action=gps" \
|
||||
--output-document="travaux_gps_${i}.gpx"
|
||||
done
|
||||
|
||||
|
||||
Loading…
Reference in a new issue