Diverses améliorations (automatisation de certaines phrases, mise en forme des graphiques, ...)

SYNCSPECIFIC_2024_03

+immatriculations_vehicules.html
+publications/rsvero/2024_03/export_tableur/neuf.xlsx
+publications/rsvero/2024_03/export_tableur/occasion.xlsx
+publications/rsvero/2024_03/footer.html
+publications/rsvero/2024_03/header.html
+publications/rsvero/2024_03/ortm_rsvero_2024_03.html
+publications/rsvero/2024_03/images
+
+

points_de_vigilance

@@ -27,8 +27,8 @@ Certains couples catégories de véhicules / modalités (énergie, département,
 
 
 
-Reste à faire :
-- tableau qui donne le rapport de la part de l’électrique
+À faire :
+- ....
 
 
 

scripts/series_pour_tdb.R

+library(tidyr)
+library(tidyverse)
+library(dplyr)
+library("RcppRoll")
+library(readxl)
+library(xlsx)
+library(shiny)
+library(rmarkdown)
+library(kableExtra)
+library(formattable)
+library(DT)
+library(ggthemes)
+library(janitor)
+library(plotly)
+library(ggplot2)
+library(ggtext)
+library(openxlsx)
+library(grDevices)
+library(forcats)
+library(grid)
+library(gridtext)
+library(lubridate)
+library(sf)
+library(extrafont)
+library(stringr)
+library(scales)
+library(rlang)
+library(knitr)
+library(kableExtra)
+library(huxtable)
+
+# Désactivation de la notation scientifique
+options(scipen = 999)
+
+# Séparateur décimal à la française
+options(OutDec= ",")
+
+# Création d'une fonction %notin% (inverse de %in%)
+`%notin%` <- function (x, y) {
+  !(match(x, y, nomatch = 0L) > 0L)}
+
+# Avant de lancer le script, il faut renommer manuellement le fichier que le SDES nous envoie chaque mois,
+# de façon à ce qu'il ne contienne pas d'espace et qu'il ait à chaque fois le même nombre de caractères
+# Par exemple, passer de "stat_ dreal_n_2016 _1 à 2023_8.xlsx" à "stat_dreal_n_2016_1_2023_08.xlsx
+
+# Création de la liste de tous les fichiers RSVéRO déposés dans le dossier dédié
+liste_fichiers_neuf <- list.files("X:/SCTE/DEP/Donnees_confidentielles/Conjoncture/rsvero",
+                                  include.dirs = FALSE, full.names = FALSE, pattern = "stat_dreal_n_2016_1_")
+
+# Extraction des sept derniers caractères du fichier RSVéRO le plus récent
+# (ces sept caractères donnent le dernier mois disponible)
+dernier_mois_rsvero <- liste_fichiers_neuf %>%
+  substr(21,27) %>%
+  max()
+
+# Reconstitution (par concaténation) du nom du fichier RSVéRO le plus récent
+neuf_file <- paste0("X:/SCTE/DEP/Donnees_confidentielles/Conjoncture/rsvero/stat_dreal_n_2016_1_",dernier_mois_rsvero,".xlsx")
+
+# Ouverture du fichier RSVéRO, recodage de la variable énergie et création de la segmentation des véhicules en 14 postes
+neuf_data_raw_large <- read_excel(neuf_file) %>%
+  mutate(statut = replace_na(statut, "Statut non déterminé")) %>%
+  # mutate(statut = str_replace(statut, "NA", "Statut non déterminé")) %>%
+  mutate(statut = str_replace(statut, "ND", "Statut non déterminé")) %>%
+  mutate(energie = case_when(
+    energie %in% c("Diesel - hybride NR", "Diesel thermique") ~ "Gazole",
+    energie %in% c("Essence - hybride NR", "Essence thermique") ~ "Essence",
+    energie %in% c("Hybride rechargeable") ~ "Hybride rechargeable",
+    energie %in% c("Electrique et hydrogène") ~ "Électricité",
+    TRUE ~ "Autres motorisations")) %>%
+  mutate(energie = as.factor(energie)) %>%
+  mutate(energie = fct_relevel(energie,"Essence","Gazole","Électricité","Hybride rechargeable","Autres motorisations")) %>%
+  mutate(genre_14_postes = case_when(
+    categ == "VP" ~ "Voiture particulière et commerciale",
+    categ == "CATL" & genre_eu == "Cyclomoteurs" ~ "Cyclomoteur",
+    categ == "CATL" & genre_eu == "Motocyclettes"~ "Motocyclette",
+    categ == "CATL"& genre_eu %notin% c("Cyclomoteurs", "Motocyclettes") ~ "Tricycle et quadricycle à moteur",
+    categ == "REM" & genre_eu %notin% c("3,5-10 T", ">10 T") ~ "Remorque légère et caravane",
+    categ == "REM" & genre_eu %in% c("3,5-10 T", ">10 T") ~ "Remorque lourde",
+    genre == "VASP" & carro == "Camping-car" ~ "Camping-car",
+    categ == "TCP" ~ "Autobus et autocar",
+    genre == "VASP" & carro == "Dérivé voiture" ~ "Utilitaire dérivé de voiture (UDVP)",
+    categ == "VUL" & genre %in% c("Camionnettes", "Camions") ~ "Camionnette",
+    categ == "PL" & genre %in% c("Camionnettes", "Camions") ~ "Camion",
+    genre == "Tracteurs routiers" ~ "Tracteur routier",
+    genre == "VASP" & carro %notin% c("Camping-car", "Dérivé voiture") ~ "VASP (hors UDVP et camping-car)",
+    categ == "TRA" ~ "Tracteur agricole",
+    TRUE ~ "Autres")) %>%
+  mutate(genre_14_postes = as.factor(genre_14_postes)) %>%
+  mutate(genre_14_postes = fct_relevel(genre_14_postes, "Voiture particulière et commerciale", "Cyclomoteur", "Motocyclette",
+                                       "Tricycle et quadricycle à moteur", "Remorque légère et caravane", "Camping-car",
+                                       "Autobus et autocar", "Utilitaire dérivé de voiture (UDVP)", "Camionnette","Camion",
+                                       "Tracteur routier", "Remorque lourde", "VASP (hors UDVP et camping-car)", "Tracteur agricole")) %>%
+  relocate(genre_14_postes, .after = statut)
+
+# Création d'un vecteur qui détermine le nombre de colonnes du fichier RSVéRO
+# NB : le fichier comprend une colonne supplémentaire chaque mois
+nb_colonnes <- as.numeric(ncol(neuf_data_raw_large))
+
+# Mise au format long du fichier RSVéRO et simplification du mois
+neuf_data_raw <- neuf_data_raw_large %>%
+  gather(key = date, value = immat, 16:all_of(nb_colonnes)) %>%
+  mutate(date = str_replace(date,"IMMAT20","20"), date = str_replace(date,"_","-")) %>%
+  mutate(date = format(ym(date), "%Y %m"))
+
+# Constitution de séries mensuelles pour la note trimestrielle transports et export dans un tableur ----
+series_pour_tdb <- neuf_data_raw %>%
+  filter(REG == 52,
+         genre_14_postes %in% c("Voiture particulière et commerciale","Utilitaire dérivé de voiture (UDVP)","Camionnette","Camion","Tracteur routier","Remorque lourde")) %>%
+  group_by(DEPLIB, date, genre_14_postes) %>%
+  summarise(immat = sum(immat, na.rm = T)) %>%
+  spread(key = genre_14_postes, value = immat) %>%
+  ungroup() %>%
+  mutate(VPC = `Voiture particulière et commerciale`, VU = rowSums(across(4:8))) %>%
+  select(2,9,10,1) %>%
+  gather(key = genre, value = immat, 2:3) %>%
+  select(1,3,2,4) %>%
+  spread(key = date, value = immat)
+
+sortie_excel_pour_tdb <- createWorkbook()
+
+addWorksheet(sortie_excel_pour_tdb, "VPC et VU")
+writeData(sortie_excel_pour_tdb, sheet = 1, x = series_pour_tdb)
+setColWidths(sortie_excel_pour_tdb, sheet = 1, cols = 1:2, widths = "auto")
+setColWidths(sortie_excel_pour_tdb, sheet = 1, cols = 3:200, widths = "7")
+
+nombre <- createStyle(numFmt = "COMMA")
+addStyle(sortie_excel_pour_tdb, 1, nombre, rows = 2:99, cols = 3:200, gridExpand = TRUE)
+
+halignright <- createStyle(halign = "right", textDecoration = "bold")
+addStyle(sortie_excel_pour_tdb, 1, halignright, rows = 1, cols = 3:200, gridExpand = TRUE)
+
+entete <- createStyle(textDecoration = "bold")
+addStyle(sortie_excel_pour_tdb, 1, entete, rows = 1:200, cols = 1:2, gridExpand = TRUE)
+
+blue <- createStyle(fontColour = "#484fb5", numFmt = "COMMA")
+addStyle(sortie_excel_pour_tdb, 1, blue, rows = 2:6, cols = 3:200, gridExpand = TRUE)
+
+couleur <- createStyle(fontColour = "#484fb5", textDecoration = "bold")
+addStyle(sortie_excel_pour_tdb, 1, couleur, rows = 2:6, cols = 1:2, gridExpand = TRUE)
+
+freezePane(sortie_excel_pour_tdb, 1, firstActiveRow = 2, firstActiveCol = "C")
+
+saveWorkbook(sortie_excel_pour_tdb, "export_tableur/tdb.xlsx", overwrite = T)
\ No newline at end of file

scripts/tableaux_annexes.R

-# Constitution de séries mensuelles pour la note trimestrielle transports et export dans un tableur ----
-# series_pour_tdb <- neuf_data_raw %>%
-#   filter(REG == 52,
-#          genre_14_postes %in% c("Voiture particulière et commerciale","Utilitaire dérivé de voiture (UDVP)","Camionnette","Camion","Tracteur routier","Remorque lourde")) %>%
-#   group_by(DEPLIB, date, genre_14_postes) %>%
-#   summarise(immat = sum(immat, na.rm = T)) %>%
-#   spread(key = genre_14_postes, value = immat) %>%
-#   ungroup() %>%
-#   mutate(VPC = `Voiture particulière et commerciale`, VU = rowSums(across(4:8))) %>%
-#   select(2,9,10,1) %>%
-#   gather(key = genre, value = immat, 2:3) %>%
-#   select(1,3,2,4) %>%
-#   spread(key = date, value = immat)
-# 
-# sortie_excel_pour_tdb <- createWorkbook()
-# 
-# addWorksheet(sortie_excel_pour_tdb, "VPC et VU")
-# writeData(sortie_excel_pour_tdb, sheet = 1, x = series_pour_tdb)
-# setColWidths(sortie_excel_pour_tdb, sheet = 1, cols = 1:2, widths = "auto")
-# setColWidths(sortie_excel_pour_tdb, sheet = 1, cols = 3:200, widths = "7")
-# 
-# nombre <- createStyle(numFmt = "COMMA")
-# addStyle(sortie_excel_pour_tdb, 1, nombre, rows = 2:99, cols = 3:200, gridExpand = TRUE)
-# 
-# halignright <- createStyle(halign = "right", textDecoration = "bold")
-# addStyle(sortie_excel_pour_tdb, 1, halignright, rows = 1, cols = 3:200, gridExpand = TRUE)
-# 
-# entete <- createStyle(textDecoration = "bold")
-# addStyle(sortie_excel_pour_tdb, 1, entete, rows = 1:200, cols = 1:2, gridExpand = TRUE)
-# 
-# blue <- createStyle(fontColour = "blue", numFmt = "COMMA")
-# addStyle(sortie_excel_pour_tdb, 1, blue, rows = 2:6, cols = 3:200, gridExpand = TRUE)
-# 
-# couleur <- createStyle(fontColour = "blue", textDecoration = "bold")
-# addStyle(sortie_excel_pour_tdb, 1, couleur, rows = 2:6, cols = 1:2, gridExpand = TRUE)
-# 
-# freezePane(sortie_excel_pour_tdb, 1, firstActiveRow = 2, firstActiveCol = "C")
-# 
-# saveWorkbook(sortie_excel_pour_tdb, "export_tableur/tdb.xlsx", overwrite = T)
-
-
-# Tableaux de l'annexe statistique ----
+# Tableaux de l'annexe statistique
 
 # Séparateur décimal à la française
 options(OutDec= ",")
 
-# Tableau 1 - Immatriculations neuves par département des vingt-cinq derniers mois
+## Tableau 1 - Immatriculations neuves par département des vingt-cinq derniers mois ----
 annexe_1 <- neuf_data_raw %>%
   filter(REG == 52) %>%
   group_by(DEPLIB, date) %>%
@@ -76,7 +35,7 @@ annexe_1_kable <- kable(annexe_1, "html", booktabs = T, escape = F,
   column_spec(7, width = "13em", extra_css = "padding: 4px 46px 2px 1px")
   # column_spec(7, width = "10em", extra_css = "padding: 4px 30px 2px 1px", background = "#323787", color = "white")
 
-# Tableau 2 - Immatriculations d'occasion par département des vingt-cinq derniers mois
+## Tableau 2 - Immatriculations d'occasion par département des vingt-cinq derniers mois ----
 annexe_2 <- occ_data_raw %>%
   filter(REG == 52) %>%
   group_by(DEPLIB, date) %>%
@@ -107,7 +66,7 @@ annexe_2_kable <- kable(annexe_2, "html", booktabs = T, escape = F,
 # column_spec(7, width = "10em", extra_css = "padding: 4px 30px 2px 1px", background = "#323787", color = "white")
 
 
-# Tableau 3 - Évolutions et ratios des vingt-cinq derniers mois
+## Tableau 3 - Évolutions et ratios des vingt-cinq derniers mois ----
 neuf_evolution <- neuf_data_raw %>%
   filter(REG == 52) %>%
   group_by(date) %>%
@@ -311,7 +270,43 @@ annexe_3_kable <- kable(annexe_3, "html", booktabs = T, escape = F,
   column_spec(10:11, width = "6em", extra_css = "padding: 4px 13px 2px 1px") %>%
   column_spec(12:15, width = "6em", extra_css = "padding: 4px 6px 2px 1px")
 
-# Sauvegarde de l'environnement
+
+## Rapport de la part de l’électrique entre le neuf et l'occasion ----
+
+part_elec_neuf <- neuf_data_raw %>%
+  filter(REG == 52, date == dernier_mois_rsvero_2) %>%
+  group_by(date, energie) %>%
+  summarise(immat = sum(immat, na.rm = T)) %>%
+  ungroup() %>% 
+  spread(key = energie, value = "immat") %>%
+  mutate(Ensemble = rowSums(across(2:6)), part_elec = `Électricité`/Ensemble) %>%
+  select(1,8)
+
+part_elec <- occ_data_raw %>%
+  filter(REG == 52, date == dernier_mois_rsvero_2) %>%
+  group_by(date, energie) %>%
+  summarise(immat = sum(immat, na.rm = T)) %>%
+  ungroup() %>% 
+  spread(key = energie, value = "immat") %>%
+  mutate(Ensemble = rowSums(across(2:6)), part_elec = `Électricité`/Ensemble) %>%
+  select(1,8) %>% 
+  mutate(ratio_part_elec = part_elec_neuf$part_elec/part_elec,
+         ratio_lettres = case_when(round(ratio_part_elec) == 5 ~ "cinq",
+                                   round(ratio_part_elec) == 6 ~ "six",
+                                   round(ratio_part_elec) == 7 ~ "sept",
+                                   round(ratio_part_elec) == 8 ~ "huit",
+                                   round(ratio_part_elec) == 9 ~ "neuf",
+                                   round(ratio_part_elec) == 10 ~ "dix",
+                                   round(ratio_part_elec) == 11 ~ "onze",
+                                   round(ratio_part_elec) == 12 ~ "douze",
+                                   round(ratio_part_elec) == 13 ~ "treize",
+                                   round(ratio_part_elec) == 14 ~ "quatorze",
+                                   round(ratio_part_elec) == 15 ~ "quinze",
+                                   TRUE ~ "ALERTE"))
+         
+
+
+## Sauvegarde de l'environnement
 save(list = ls(), file = "data/rsvero.RData")
 
 # Création d'objets permettant le téléchargement des fichiers
@@ -321,17 +316,16 @@ save(list = ls(), file = "data/rsvero.RData")
 # file_download_occ <- paste0("occasion_",dernier_mois_rsvero,".xlsx")
 # rm(lien_download_neuf, lien_download_occ, file_download_neuf, file_download_occ)
 
-# Exemples de code pour extraire un vecteur
+# Exemples de code pour extraire un vecteur et automatiser la rédaction des faits saillants
 annexe_3[nb_lignes-12, 6] %>% pull
 neuf_occ_tableau_synthese[4, 4] %>% pull
-
 sjmisc::big_mark(neuf_ensemble_bis[13, 2], " ") %>% pull
 prettyNum(neuf_ensemble_bis[13, 2], big.mark=" ")
 
 
 download="ind_mois.csv"
-
 download="neuf_2024_02"
+rm(download)