Skip to content
Snippets Groups Projects

Draft: Resolve "Adapter le script de collecte des bornes de recharge des véhicules électriques"

1 file
+ 26
339
Compare changes
  • Side-by-side
  • Inline
@@ -5,358 +5,46 @@
# librairies ----------
library(tidyverse)
library(sf)
library(COGiter)
library(lubridate)
library(DBI)
library(RPostgreSQL)
library(rpostgis)
# remotes::install_gitlab("dreal-datalab/rapport.irve")
library(rapport.irve)
library(sf)
library(RPostgres)
library(banR)
library(mapview)
rm(list = ls())
# Voir les couches chargées dans le SGBD dans le schéma dédié aux bornes IRVE
couches_disp <- list_couches()
dates_maj <- list_couches() %>% substr(18, 28)
# # chargement des travaux de Ronan et exploration-----------------
# drv <- dbDriver("PostgreSQL")
# con_production <- dbConnect(drv,
# dbname="production",
# host=Sys.getenv("server"),
# port=Sys.getenv("port"),
# user=Sys.getenv("userid"),
# password=Sys.getenv("pwd_does"))
# # postgresqlpqExec(con_production, "SET client_encoding = 'windows-1252'")
#
# tables <- grep("bornes_rve|borne_rve|borne_irve", dbListTables(con_production), value = TRUE)
#
# tables_rve <- map(tables, ~ st_read(dsn = con_production, layer = c("mecc_points_rve", .x))) %>%
# setNames(tables)
#
# for(i in tables) {
# assign(x= i, value = tables_rve[[i]])
# }
# rm(tables_rve)
#
# names(n_borne_irve_r52)
# unique(n_borne_irve_r52$id_station)
#
# mapview(st_geometry(n_borne_irve_r52)) +
# mapview(st_geometry(n_bornes_rve_consolidees_sans_decoupage_r52), col.region = c("blue", "blue")) +
# mapview(st_geometry(n_bornes_rve_opendata_cr_r52), col.region = c("grey", "grey")) +
# mapview(st_geometry(n_bornes_rve_consolidees_sans_dedoublonnage_r52), col.region = c("pink", "pink")) +
# mapview(st_geometry(n_borne_rve_osm_r52), col.region = c("black", "black")) +
# mapview(st_geometry(n_bornes_rve_consolidees_r52), col.region = c("red", "red"))
#
# # A priori la couche rouge n_bornes_rve_consolidees_r52 est la plus complète,
# # elle correspond à couche de consolidation des données irve fournie par étalab
# # elle comprend les données osm
# # un dédoublonnage est nécessaire
# a <- st_geometry((n_bornes_rve_consolidees_r52)) %>% st_as_sf %>% distinct
# mapview(st_geometry(n_bornes_rve_consolidees_r52), col.region = c("red", "red")) + mapview(a)
# dbDisconnect(con_production)
# chargement data.gouv.fr : fichier consolidé etalab et fichier osm disp sur data.gouv---------
## etalab osm
# library(httr)
# r <- GET("https://www.data.gouv.fr/api/1/datasets/5ef48ff4d1c48dd30e3f8ab8/")
# irve_osm <- content(r) ## ne fournit pas le dataset mais ses métadonnées
# lecture fichier consolidé etlab https://www.data.gouv.fr/fr/datasets/fichier-consolide-des-bornes-de-recharge-pour-vehicules-electriques/
# chargement à la main de extdata/bornes-irve-20210120.csv
# lecture OSM : https://www.data.gouv.fr/fr/datasets/bornes-de-recharge-de-vehicule-electrique-issues-dopenstreetmap/
unzip(zipfile = "extdata/charging_station_geojson.zip", overwrite = TRUE, exdir = "extdata")
irve_osm <- st_read(dsn = "extdata/data.geojson") %>%
mutate(nbre_pdc = as.numeric(nbre_pdc))
# Le fichier consolidé etalab est le plus complet mais il comporte des doublons
# cf. https://github.com/etalab/schema-irve/issues/5 et
# des points de recharge sans coordonnées géographiques
# chargement ---------
irve_consol0 <- readr::read_csv2("extdata/bornes-irve-20210120.csv",
col_types = cols(
n_amenageur = col_character(),
n_operateur = col_character(),
n_enseigne = col_character(),
id_station = col_character(),
n_station = col_character(),
ad_station = col_character(),
code_insee = col_character(),
Xlongitude = col_character(),
Ylatitude = col_character(),
nbre_pdc = col_double(),
id_pdc = col_character(),
puiss_max = col_character(),
type_prise = col_character(),
acces_recharge = col_character(),
accessibilité = col_character(),
observations = col_character(),
date_maj = col_date(format = ""),
source = col_character())
) %>%
mutate(Xlongitude2 = gsub(" ", "", Xlongitude) %>%
gsub("*", ".", ., fixed = TRUE) %>%
as.numeric(),
Ylatitude2 = gsub(" ", "", Ylatitude) %>%
gsub("*", ".", ., fixed = TRUE) %>%
as.numeric(),
crs = if_else(abs(Xlongitude2) <= 180 & abs(Ylatitude2) <= 180, "longlat", "proj"),
Xlongitude3 = if_else(Xlongitude2 > 10 & abs(Ylatitude2) < 10, Ylatitude2, Xlongitude2),
Ylatitude3 = if_else(Xlongitude2 > 10 & abs(Ylatitude2) < 10, Xlongitude2, Ylatitude2)) %>%
rownames_to_column(var = "num_ligne")
# on bancarise les stations avec géographie valide (~ 60% des données initiales)-------
irve_consolgeo <- irve_consol0 %>%
filter(!is.na(Xlongitude3), !is.na(Ylatitude3), crs == "longlat") %>%
st_as_sf(coords = c("Xlongitude3","Ylatitude3")) %>%
mutate(sc_geoloc = "etalab") %>%
st_set_crs(4326) %>%
select(-crs, -Xlongitude, -Ylatitude, -Xlongitude2, -Ylatitude2)
# on étudie le reste pour voir comment récupérer la géo------
#1 - points voisins de la même station
irve_consol_mqgeo <- irve_consol0 %>%
filter(is.na(Xlongitude) | is.na(Ylatitude) | crs != "longlat" | is.na(crs)) %>%
select(-crs, -contains("itude")) %>%
# on récupère la géo d'un autre point de chargement de la même station très proche
right_join(irve_consolgeo %>% select(id_station) %>% group_by(id_station) %>% slice(1) %>%
filter(!is.na(id_station)), .,
by=c("id_station"))
# on récupère 150 points : irve_consol_mqgeo %>% filter(!st_is_empty(geometry)) %>% nrow()
# on bancarise les stations géolocalisées grace à OSM ou grace à la geo d'un autre point de la station
# (~ 15 % des données initiales récupérées, vérif par échantillonnage sur la région que ok)
irve_consolgeo1 <- irve_consol_mqgeo %>%
filter(!st_is_empty(geometry)) %>%
mutate(sc_geoloc = "etalab, autre pdc même station") %>%
bind_rows(irve_consolgeo)
#2- jointure avec données osm qui comportent la géo mais moins bien renseignées sur les données attributaires
irve_consol_mqgeo1 <- irve_consol_mqgeo %>%
filter(st_is_empty(geometry)) %>%
st_drop_geometry() %>%
right_join(irve_osm %>% select(id_station, depcom = code_insee) %>% group_by(id_station) %>% slice(1) %>%
filter(!is.na(id_station)), .,
by=c("id_station"))
# on récupère 2460 points
# on bancarise les stations géolocalisées grace à OSM ou grace à la geo d'un autre point de la station
# (~ 15 % des données initiales récupérées, vérif par échantillonnage sur la région que ok)
irve_consolgeo2 <- irve_consol_mqgeo1 %>%
filter(!st_is_empty(geometry)) %>%
select(-code_insee) %>%
rename(code_insee = depcom) %>%
mutate(sc_geoloc = "OSM") %>%
bind_rows(irve_consolgeo1)
# on se penche sur le reste, que l'on géolocalise à l'adresse grâce à {banR} -----
## on améliore d'abord le champ code insee de la commune
irve_consol_mqgeo2 <- irve_consol_mqgeo1 %>%
filter(!(num_ligne %in% irve_consolgeo2$num_ligne)) %>%
st_drop_geometry() %>%
mutate(code_insee = coalesce(code_insee, str_extract(id_station, "\\D[0-9]{5}\\D") %>% substr(2,6))) %>%
ungroup()
## une première géoloc avec adresse et code insee (le résultat sera toujours dans la bonne commune, sinon NA)
irve_consol_mqgeo2ad_com <- irve_consol_mqgeo2 %>%
filter(!is.na(code_insee)) %>%
geocode_tbl(adresse = ad_station, code_insee = code_insee)
## une seconde avec l'adresse seulement
irve_consol_mqgeo2ad <- irve_consol_mqgeo2 %>%
filter(is.na(code_insee)) %>%
# on ajoute les refus de geoloc précédent en enlevant le code insee de la commune
bind_rows(filter(irve_consol_mqgeo2ad_com, is.na(result_score)) %>%
select(any_of(names(irve_consol_mqgeo2)))) %>%
# on améliore le champ adresse
mutate(ad_station = gsub("�", "e", ad_station) %>%
gsub(" 6190 ROQUEBRUNE CAP MARTIN", " 06190 ROQUEBRUNE CAP MARTIN", .) %>%
gsub("76140 MAROMME", "76150 MAROMME", .) %>%
gsub(" 9220 VIC DESSOS", " 09220 VIC DESSOS", .) %>%
gsub(" 9310 LES CABANNES", " 09310 LES CABANNES", .) %>%
gsub("Annexe Mairie 13100 AIX-EN-PROVENCE", "13100 AIX-EN-PROVENCE", .) %>%
gsub("Parking relais ", "", .) %>%
gsub("Parking ", "", .) %>%
gsub("(Office Tourisme) ", "", .)
) %>%
geocode_tbl(adresse = ad_station) %>%
# on qualifie ensuite la validité de la géolocalisation
mutate(geoloc_ok = case_when(
is.na(code_insee) & result_context == "29, Finistère, Bretagne" ~ TRUE, # les codes postaux sont les codes communes dans l'adresse, ce qui baisse le score
str_detect(ad_station, result_citycode) ~ TRUE,
str_detect(ad_station, result_oldcitycode) ~ TRUE,
result_score >=0.4 ~ TRUE,
result_score < 0.3 ~ FALSE,
is.na(result_score) ~ FALSE,
str_detect(ad_station, result_postcode) ~ TRUE,
TRUE ~ FALSE))
## on isole les réponses insatisfaisantes et on calcule leur centroïde
irve_consol_mqgeo3 <- filter(irve_consol_mqgeo2ad, !geoloc_ok) %>%
select(-c(latitude:geoloc_ok)) %>%
left_join(table_passage_com_historique, by = c("code_insee" = "DEPCOM_HIST")) %>%
right_join(communes_geo %>% select(-AREA), ., by = "DEPCOM") %>%
mutate(geometry = st_centroid(geometry) %>% st_transform(4326),
sc_geoloc = "centroide commune") %>%
select(-DEPCOM)
## on bancarise la geoloc banR et la geoloc au centroïde com avec le reste des enregistrements exploitables
irve_consolgeo3 <- irve_consol_mqgeo2ad_com %>%
filter(!is.na(result_score)) %>%
bind_rows(filter(irve_consol_mqgeo2ad, geoloc_ok)) %>%
select(any_of(names(irve_consolgeo2)), -code_insee, code_insee = result_citycode, latitude, longitude) %>%
st_as_sf( coords = c("longitude","latitude") ) %>%
st_set_crs(4326) %>%
mutate(sc_geoloc = "adresse") %>%
bind_rows(irve_consolgeo2) %>%
bind_rows(irve_consol_mqgeo3)
# ajout des données OSM --------------
# on crée des polygones de 15m de diamètre autour des bornes connues
couche_filtrante <- irve_consolgeo3 %>%
select(geometry) %>%
st_transform(2036) %>%
st_buffer(7.5) %>%
st_union %>%
st_transform(4326)
# de la couche osm on ne garde que les points à plus de 7.5 m de distance
irve_osm_abs_etalab <- st_filter(irve_osm, couche_filtrante, .predicate = st_disjoint) %>%
rownames_to_column(var = "num_ligne") %>%
mutate(num_ligne = (as.numeric(num_ligne) + nrow(irve_consol0)) %>% as.character,
sc_geoloc = "OSM",
source = "https://www.data.gouv.fr/fr/datasets/bornes-de-recharge-de-vehicule-electrique-issues-dopenstreetmap") %>%
select(-Xlongitude, -Ylatitude)
# qu'on bancarise avec le reste
irve_consolgeo4 <- irve_consolgeo3 %>%
bind_rows(irve_osm_abs_etalab) %>%
# fiabilisation du champ code commune
mutate(code_insee = coalesce(code_insee, str_extract(id_station, "\\D[0-9]{5}\\D") %>% substr(2,6)))
mapview(irve_consolgeo4)
# fiabilisation du champ code commune------------
# récupération des stations sans code commune
irve_consolgeo_mq_depcom <- irve_consolgeo4 %>%
filter(is.na(code_insee)|!(code_insee %in% table_passage_com_historique$DEPCOM_HIST)) %>%
rowwise %>%
# on utilise le reverse geocoding de ban r pour ces qq 500 points
mutate(longitude = unlist(geometry)[[1]],
latitude = unlist(geometry)[[2]]) %>%
ungroup() %>%
st_drop_geometry() %>%
select(num_ligne, longitude, latitude) %>%
reverse_geocode_tbl(longitude = longitude, latitude = latitude) %>%
select(num_ligne, DEPCOM = result_citycode, longitude, latitude)
# refus géocodage (moins de 10): recup code commune via COgiter:
refus_codage <- irve_consolgeo_mq_depcom %>%
filter(is.na(DEPCOM)) %>%
pull(num_ligne)
irve_consolgeo_mq_depcom2 <- filter(irve_consolgeo_mq_depcom, num_ligne %in% refus_codage) %>%
st_as_sf(coords = c("longitude","latitude"), crs = 4326) %>%
st_transform(2154) %>%
st_join(communes_geo, join = st_intersects) %>%
st_drop_geometry %>%
bind_rows(irve_consolgeo_mq_depcom %>% filter(!(num_ligne %in% refus_codage))) %>%
select(num_ligne, DEPCOM)
irve_consolgeo5 <- irve_consolgeo4 %>%
left_join(irve_consolgeo_mq_depcom2, by="num_ligne") %>%
mutate(code_insee=coalesce(DEPCOM, code_insee),
geometry = st_centroid(geometry)) %>%
select(-DEPCOM)
# vérification des doublons géo ---------
# un point de recharge = un numéro de station, un id de point de recharge et une localisation
doublons <- irve_consolgeo5 %>%
select(id_station, id_pdc, num_ligne) %>%
mutate(geo = st_as_text(geometry)) %>%
st_drop_geometry() %>%
group_by(geo, id_station, id_pdc) %>%
summarise(list_num_ligne = list(num_ligne), num_lig_garder = first(list_num_ligne), #list(unique(id_station)), list(unique(id_pdc)),
nb_station = n_distinct(id_station), nb_pdc = n_distinct(id_pdc), nb_lignes = n(), .groups = "drop") %>%
filter(nb_pdc < nb_lignes)
# une première liste de lignes en doublons
liste_doublons <- doublons %>%
unnest(cols = c(list_num_ligne)) %>%
filter(list_num_ligne != num_lig_garder) %>%
pull(list_num_ligne)
# qu'on écarte de la géolocalisation
irve_consolgeo6 <- irve_consolgeo5 %>%
filter(!(num_ligne %in% liste_doublons))
# puis recherche de doublons par regroupement des points géo
regroupmt_geo <- irve_consolgeo6 %>%
select(id_station, id_pdc, num_ligne) %>%
mutate(geo = st_as_text(geometry)) %>%
st_drop_geometry() %>%
group_by(geo) %>%
summarise(list_num_ligne = list(num_ligne), list(id_station), list(id_pdc),
nb_station = n_distinct(id_station), nb_pdc = n_distinct(id_pdc), nb_lignes = n(), .groups = "drop")
# --> plus de doublons "flagrants"
doublons2 <- regroupmt_geo %>%
filter(nb_pdc < nb_lignes)
# regroupement des stations par points geo ----------
id_geo <- regroupmt_geo %>%
select(list_num_ligne) %>%
rownames_to_column("id_geo") %>%
mutate(id_geo = paste0("gr_geo_", id_geo)) %>%
unnest(cols = c(list_num_ligne))
irve_consolgeo7 <- irve_consolgeo6 %>%
left_join(id_geo, by = c("num_ligne" = "list_num_ligne")) %>%
mutate(nbre_pdc = if_else(nbre_pdc == 0 | is.na(nbre_pdc), 1, nbre_pdc))
# si la dernière couche est ancienne lancer mettre à jour la collecte
# mettre_a_jour_la_collecte()
# une fonction pour lire et combiner les couches geo des bornes de recharge
prep_irve <- function(i) {
lect_data(couche = list_couches()[i]) %>%
mutate(date = dates_maj[i])
}
# # stockage de la couche nettoyée dans le sgbd/production/mecc_points_rve ------------
# drv <- Postgres()
# con <- dbConnect(drv, dbname="production", host="10.44.128.174", port=5432,
# user = Sys.getenv("sgbd_user"), password = Sys.getenv("sgbd_pwd"))
#
# st_write(obj = irve_consolgeo7, dsn = con, delete_layer = TRUE,
# layer = DBI::Id(schema = "mecc_points_rve", table = paste0("n_borne_irve_000_", "20210205")))
#
# # dbWriteTable(conn = con, name = c("mecc_points_rve", paste0("n_borne_irve_000_", today())),
# # value = irve_consolgeo7, row.names=FALSE, overwrite=TRUE)
# save(irve_consolgeo7, file = paste0("extdata/bornes_irve_", today()))
# lect_data charge la dernière couche, quand on aura 12 mois d'écarts entre deux couches, il faudra mettre à jour le script pour pouvoir calculer des évolutions
irve <- map_dfr(.x = c(1:length(couches_disp)), .f = ~ prep_irve(.x))
# communes x dates : un dataframe croisant dates de mise à jour et liste des communes pour avoir les communes sans bornes de recharge pour tous les millésiomes
com_dates = communes %>%
select(depcom = DEPCOM) %>%
mutate(date = list(dates_maj)) %>%
unnest(date)
# calculs des indicateurs : nb de stations et nb de prises par communes ------------
indic_irve <- irve_consolgeo7 %>%
indic_irve <- irve %>%
st_drop_geometry() %>%
select(depcom = code_insee, id_geo, nbre_pdc) %>%
group_by(depcom) %>%
summarise(nb_stations = n_distinct(id_geo), nb_pdc = sum(nbre_pdc)) %>%
full_join(communes %>% select(DEPCOM), by=c("depcom" = "DEPCOM")) %>%
select(date, depcom = DEPCOM, id_geo, nbre_pdc) %>%
group_by(date, depcom) %>%
summarise(nb_stations = n_distinct(id_geo), nb_pdc = sum(nbre_pdc), .groups = "drop") %>%
full_join(com_dates, by=c("depcom", "date")) %>%
replace_na(list("nb_stations" = 0, "nb_pdc" = 0)) %>%
pivot_longer(cols = starts_with("nb_"), names_to = "variable", values_to = "valeur") %>%
mutate(date = today(),
across(where(is.character), as.factor)) %>%
pivot_wider(names_from = variable,values_from = valeur)
mutate(across(where(is.character), as.factor))
# versement dans le sgbd/datamart.portrait_territoires -------------
@@ -367,7 +55,6 @@ con_datamart <- dbConnect(drv,
port=Sys.getenv("port"),
user=Sys.getenv("userid"),
password=Sys.getenv("pwd_does"))
postgresqlpqExec(con_datamart, "SET client_encoding = 'windows-1252'")
dbWriteTable(con_datamart, c("portrait_territoires","source_bornes_recharges_vehicules_elec"),
indic_irve, row.names=FALSE, overwrite=TRUE)
Loading