proposition d'allégement du script de création du datamart

suppression des filtres sur exceptions (recensement, naf_artificialisation_10ans_2011_2020) pour généraliser la création des fichiers

ajout des espaces après la virgule

R/datamart.R

@@ -2,6 +2,7 @@
 library(datalibaba)
 library(tidyverse)
 library(COGiter)
+library(lubridate)
 library(readxl)
 library(googlesheets4)
 library(tricky)
@@ -54,17 +55,6 @@ metadata_source_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJ
   filter(source %in% sources_des_indic$source_propre) %>% 
   select(source, source_libelle)
 
-# # association variables / mots_clefs
-# metadata_theme_0 <- read_sheet("https://docs.google.com/spreadsheets/d/1n-dhtrJM3JwFVz5WSEGOQzQ8A0G7VT_VcxDe5gh6zSo/edit#gid=60292277",
-#                                sheet = "indicateurs") %>%
-#   filter(libelle_variable != "?") %>%
-#   select(contains("variable"), contains("theme")) %>% 
-#   mutate(across(everything(), ~na_if(.x, ""))) %>%
-#   pivot_longer(cols = contains("theme"), names_to = NULL, values_to = "theme", values_drop_na = TRUE) %>%
-#   mutate(theme = str_standardize(theme),
-#          variable = tolower(variable)) %>%
-#   distinct() %>% 
-#   mutate(across(everything(), as.factor))
 
 #------------chargement des données---------------------------------------------------------------------------
 
@@ -81,81 +71,77 @@ save(result_0, file = "data/result_0.RData")
 
 # filtre sur les indicateurs à conserver et sur la dernière année disponible
 
-result_0a <- result_0 %>%
+result_1 <- result_0 %>%
   filter (variable %in% indicateurs_conserves) %>%
   mutate_if(is.character, as.factor) %>%
-  arrange(TypeZone,CodeZone,source,variable,date) %>% 
+  arrange(TypeZone, CodeZone, source, variable, date) %>% 
+  group_by(source, variable, date) %>% 
+  # on supprime les millésimes inutiles (car tout est a NA pour cet indic cette annee là)
+  filter(!all(is.na(valeur))) %>% 
   group_by(source, variable)
 
-a_part <- c("cogifiee_lgt_rgp_insee","cogifiee_pop_rgp_insee","indicateur_lgt_rgp_insee","indicateur_pop_rgp_insee")
-
-result_1a <- result_0a %>%
-  filter (!(source %in% a_part)) %>%
-  # conservation du seul millesime 2021 pour naf_artificialisation_10ans (les autres étant à NA) 
-  filter (!(variable == "naf_artificialisation_10ans_2011_2020"& date != "2021-01-01")) %>%    
+result_2 <- result_1 %>%
   mutate(mil_list = year(date),
-         mil_max = max(mil_list)) %>%                      # dernier millesime disponible
-  filter (mil_list > mil_max - 11) %>% 
-  mutate(nb_millesimes = n_distinct(date),
-         mil_min = min(mil_list),                            # premier millesime disponible
-         mil_milieu = if_else(nb_millesimes %% 2 == 0,               # si le nb de millesimes est pair, ...
+         mil_max = max(mil_list), # dernier millesime disponible
+         nb_millesimes = n_distinct(date),
+         mil_min = min(mil_list)) %>%      # premier millesime disponible                
+  filter (mil_list > mil_max - 11 | nb_millesimes <= 3) %>% # on garde les 10 dernieres annees ou tout si 3 millesimes seulement ou moins
+  mutate(mil_milieu = if_else(nb_millesimes %% 2 == 0,               # si le nb de millesimes est pair, ...
                               median(c(unique(mil_list), mil_max)),  # ... on ajoute une 2e fois le dernier, pour que la mediane renvoie le millesime du milieu le plus recent 
                               median(unique(mil_list))              # sinon, la mediane convient 
          )) %>% 
   filter(mil_list %in% unique(c(mil_max, mil_milieu, mil_min))) %>% 
-           select(-mil_list,-mil_max, -mil_milieu, -mil_min, -nb_millesimes)
-
-result_1b <- result_0a %>% 
-  filter (source %in% a_part)
-
-result_1 <- bind_rows(result_1a,result_1b) %>% 
-  ungroup() %>% 
-  arrange(TypeZone,CodeZone,source,variable,date)
-
-# ajout des codes EPCI et départements
-result_1 <- result_1 %>% left_join(liste_zone) %>% 
-  select(-NATURE_EPCI,-REG)
+  select(-mil_list,-mil_max, -mil_milieu, -mil_min, -nb_millesimes) %>% 
+  arrange(TypeZone, CodeZone, source, variable, date) %>% 
+  left_join(liste_zone) %>% # ajout des codes EPCI et départements
+  select(-NATURE_EPCI, -REG) %>% 
+  ungroup()
 
 #------------preparation des tables----------------------------------------------------------------------
 
-result_2 <- result_1 %>%
+result_3 <- result_2 %>%
   left_join(metadata_donnee_0 %>% select(-source, -secret)) %>% 
-  select(TypeZone,CodeZone,Zone,source_propre,date,libelle_variable,valeur,unite,EPCI,DEP) %>%
-  mutate(TypeZone=fct_relevel(TypeZone,"Communes","Epci","Départements","Régions")) %>%
-  mutate(date = format(date,"%d-%m-%Y")) %>% 
+  select(TypeZone, CodeZone, Zone, source_propre, date, libelle_variable, valeur, unite, EPCI, DEP) %>%
+  mutate(TypeZone = fct_relevel(TypeZone, "Communes", "Epci", "Départements", "Régions")) %>%
+  mutate(date = format(date, "%d-%m-%Y")) %>% 
   mutate(DEP = as.character(DEP),
-         libelle_variable = paste0(libelle_variable," (",unite,") ",date)) %>% 
-  select(-unite,-date)
+         libelle_variable = paste0(libelle_variable, " (", unite, ") ", date)) %>% 
+  select(-unite, -date)
 
 liste_des_sources <- metadata_source_0 %>% 
   select(source) %>% 
   pull() %>% 
   unique()
-rm(result_0,result0a,result_1,result1a,result1b)
+
+rm(result_0, result_1, result_2)
 
 #-----Creation des fichiers EPCI-------------------------------------------------------------------
 
 #table region
-result_region <- result_2 %>% 
+result_region <- result_3 %>% 
   filter(TypeZone ==  "Régions") %>% 
-  mutate(DEP = as.character(DEP))
-result_region$DEP <- na_if(result_region$DEP,"NULL")
+  mutate(DEP = as.character(DEP) %>% 
+           na_if("NULL"))
+
 
 liste_des_epci <- list_epci_in_reg("52")
 
 
-creer_fichiers<-function(mon_epci){
-   #table departement
+creer_fichier <- function(mon_epci){
+  
+   # table departement
    mon_dep <- code_dep_of_epci(mon_epci) %>% 
                   unlist()
-   mon_dep2<- paste0(mon_dep, collapse="-")
+   mon_dep2 <- paste0(mon_dep, collapse = "-")
    
-   result_dep <- result_2 %>% 
-     filter(TypeZone ==  "Départements",
+   result_dep <- result_3 %>% 
+     filter(TypeZone == "Départements",
             DEP %in% mon_dep)
-   #table epci
-   result_epci <- result_2 %>%
+   
+   # table epci
+   result_epci <- result_3 %>%
      filter(EPCI == mon_epci)
+   
    nom_epci <- result_epci %>%
      filter(TypeZone == "Epci") %>% 
      select(Zone) %>%
@@ -163,30 +149,24 @@ creer_fichiers<-function(mon_epci){
      pull() %>% 
      as.character()
    
-   #table_groupee
-   result_groupe <- bind_rows(result_epci,result_dep,result_region)
-
-   # creer_tab<-function(x,y){	
-   #   tab1 <- y %>% 
-   #     filter(source_propre == x) %>% 
-   #     select(-source_propre,-EPCI,-DEP) %>% 
-   #     spread(key=libelle_variable,value=valeur,fill=0) %>% 
-   #     select(-TypeZone)
-   # }   
-   
-   df_liste <- map(.x = liste_des_sources, .y = result_groupe, .f= ~creer_tab(.x,.y)) %>% 
-     set_names(liste_des_sources)
-   
+   # table_groupee
+   result_groupe <- bind_rows(result_epci, result_dep, result_region)
+
+   df_liste <- map(.x = liste_des_sources, .y = result_groupe, .f= ~creer_tab(.x, .y)) %>% 
+     set_names(liste_des_sources %>% 
+                 str_sub(string = ., start = 1, end =  31))
+
    #creation du fichier excel
-   openxlsx::write.xlsx(df_liste, file = paste0("extdata/",mon_dep2,"_",mon_epci,"_",nom_epci,".xlsx"))
+   openxlsx::write.xlsx(df_liste, file = paste0("extdata/", mon_dep2, "_", mon_epci, "_", nom_epci, "_1", ".xlsx"))
+  
 }
 
-map(.x = liste_des_epci, .f= ~creer_fichiers(.x))
+map(.x = liste_des_epci, .f= ~creer_fichier(.x))
 
 
 #-----Creation du fichier regional-------------------------------------------------------------------
 
-df_liste_reg <- map(.x = liste_des_sources, .y = result_2, .f= ~creer_tab(.x,.y)) %>% 
+df_liste_reg <- map(.x = liste_des_sources, .y = result_2, .f= ~creer_tab(.x, .y)) %>% 
   set_names(liste_des_sources)
   
 #creation du fichier excel