finalisation fonction recherche code insee dans eco ptz

data-raw/chargement_eco_ptz.R

@@ -59,78 +59,30 @@ BASE_ECO_PTZ_DHUP<- read_delim(paste0("/nfs/data/partage-PTZ-EPTZ/PTZ-EPTZ/BASE_
                           delim = ";", escape_double = FALSE, locale = locale(decimal_mark = ","), trim_ws = TRUE)
 
 
-# suppression des années anciennes
+
 base_intermediaire <- BASE_ECO_PTZ_DHUP %>%
   mutate(DATP = str_sub(DATP,1,4)) %>% 
-  filter (DATP >= annee_conservee) %>%
+  filter (DATP >= annee_conservee) %>%  # suppression des années anciennes
   select(DATP,CINS,CPLA,VILL,NALO,TTRV,CSEN,CTA1,CTA2,CTA3,CTA4,CTA5,CTA6,CTTA1,CTTA2,CTTA3,CTTA4,CTTA5,CTTA6,CTTA7) %>%  
 # application des filtres
-# CSEN est"V" (valide)
-# si type de travaux (TTRV) = 4 (réhabilitation de système d’assainissement non collectif),
-# la nature du logement (NALO) doit être égale à 1 (maison individuelle)
-  filter(CSEN == "V") %>%
-  mutate(NALO = case_when(
-    TTRV == "4" ~ 1,
-    TRUE~ NALO)) %>% 
-  select(-CSEN,-TTRV)
-
-
-#complétage du code insee--------------------------------------------------------
-communes2 <- communes %>%                 #table des communes
-  select(DEPCOM,NOM_DEPCOM,DEP) %>% 
-  mutate(NOM_DEPCOM = toupper(NOM_DEPCOM),  #met tout en majuscules
-         NOM_DEPCOM = iconv(NOM_DEPCOM, from = "UTF-8", to = "ASCII//TRANSLIT"),   #enlève les accents
-         NOM_DEPCOM = str_replace_all (NOM_DEPCOM,"[-']"," "), #remplace les tirets et apostrophes par des espaces
-         lien = paste(DEP,NOM_DEPCOM)) %>% 
-  select(lien, DEPCOM) 
-communes2a <- communes2 %>%   #creation d'une table dans laquelle on remplace "saint" par "st"
-  mutate(lien = str_replace (lien,"SAINTES","STES"),
-         lien = str_replace (lien,"SAINTE","STE"),
-         lien = str_replace (lien,"SAINTS","STS"),
-         lien = str_replace (lien,"SAINT","ST")
-  )
-communes2b <- communes2 %>%   #creation d'une table dans laquelle on remplace "saint" par "st"
-  mutate(lien = str_replace (lien,"LE ",""),
-         lien = str_replace (lien,"LES ",""),
-         lien = ifelse(str_detect(lien,"LA LONGEVILLE"), lien, str_replace (lien,"LA ","")),
-         lien = str_replace (lien,"L ","")  
-  )
-communes2 <- rbind(communes2,communes2a,communes2b) %>% 
-  unique()
-        
-base_intermediaire2 <- base_intermediaire %>%
+  filter(CSEN == "V") %>%  # CSEN est"V" (valide)
+  mutate(NALO = case_when(  
+    TTRV == "4" ~ 1,   # si type de travaux (TTRV) = 4 (réhabilitation de système d’assainissement non collectif)
+    TRUE~ NALO)) %>%   # la nature du logement (NALO) doit être égale à 1 (maison individuelle)
+  select(-CSEN,-TTRV) %>%
+# mise au format des noms de communes  
   mutate(VILL = iconv(VILL, from = "UTF-8", to = "ASCII//TRANSLIT"),
-         VILL = toupper(VILL)) %>%   #met tout en majuscules
-  mutate(lien = paste(ifelse(str_detect(CPLA,"^97"),str_sub(CPLA,1,3),str_sub(CPLA,1,2)),VILL)) %>% # SI DOM TOM (97) , prend les 3 premiers chiffres
-  mutate(lien = str_replace (lien,"SAINTES","STES"),
-         lien = str_replace (lien,"SAINTE","STE"),
-         lien = str_replace (lien,"SAINTS","STS"),
-         lien = str_replace (lien,"SAINT","ST"),
-         lien = str_replace_all (lien,"[-']"," "), #remplace les tirets et apostrophes par des espaces
-  ) %>% 
-  left_join(communes2, by = "lien") %>%
-  mutate(CINS = case_when(
-    is.na(CINS)~ DEPCOM,
-    TRUE~ CINS))
-#fin complétage du code insee--------------------------------------------------------
-# après complétage, 1554 codes insee ne sont pas complétés
-# à compléter pour tout remplir CINS
-    
+         VILL = toupper(VILL),  #met tout en majuscules
+         VILL = str_replace (VILL,"SAINTES","STES"),
+         VILL = str_replace (VILL,"SAINTE","STE"),
+         VILL = str_replace (VILL,"SAINTS","STS"),
+         VILL = str_replace (VILL,"SAINT","ST"),
+         VILL = str_replace_all (VILL,"[-']"," ") #remplace les tirets et apostrophes par des espaces
+         )  
+  # mutate(lien = paste(ifelse(str_detect(CPLA,"^97"),str_sub(CPLA,1,3),str_sub(CPLA,1,2)),VILL)) # SI DOM TOM (97) , prend les 3 premiers chiffres
 
 #---------------------------------------------------------------------------------------------  
-
-# #test reconnaissance : marche pas
-# 
-# 
-#
-
-
-
-
-
-
-
-# FONCTION QUI CHOISIT DANS UNE LISTE LE CODE INSEE DONT LE NOM DE LA COMMUNE EST LE PLUS PROCHE
+# Fonction qui à partir du code postal et du nom de commune, même approximatif, renvoie le code Insee de la commune
 retrouve_cinsee <- function(codepostal, ville){
   library(dplyr)
   library(httr)
@@ -158,9 +110,6 @@ retrouve_cinsee <- function(codepostal, ville){
     list_com <- c_insee2 %>% pull(nom) # liste des communes avec ce code postal
     list_code <- c_insee2 %>% pull(code) # liste des codes insee
     
-    #liste des communes avec le code postal
-    liste_communes <- c(list_com,list_code)
-    
     # recherche commune avec texte le plus proche 
     library(stringdist) 
     distances <- stringdist(ville,list_com,method ="jw")
@@ -174,32 +123,85 @@ retrouve_cinsee <- function(codepostal, ville){
     return(code_insee_proche)
   }
 }
-# 
-# df <- base_intermediaire3 %>% 
-#   mutate(comm100 = mapply(retrouve_cinsee(CPLA,VILL)))
-# #
-# base_intermediaire2b <- base_intermediaire2 %>% filter(is.na(CINS))
-# vecteur <- base_intermediaire2b %>%  select(CPLA) %>% pull()
-# vecteur2 <- sapply(vecteur, retrouve_cinsee)
-# vecteur2 <- unlist(sapply(vecteur, retrouve_cinsee))
-# 
-# aaa <- retrouve_cinsee("44680")   # ça ça fonctionne, mais pas pour la colonne
-# 
-# 
-# base_intermediaire20 <- base_intermediaire %>%
-#   mutate(VILL = iconv(VILL, from = "UTF-8", to = "ASCII//TRANSLIT"),
-#          VILL = toupper(VILL))
-# base_intermediaire30 <- base_intermediaire20 %>%
-#  mutate(cinsee20 = retrouve_cinsee("35800"))
-# base_intermediaire20$code_insee <- mapply(retrouve_cinsee, base_intermediaire20$CPLA)
-# base_intermediaire20 <- base_intermediaire20 %>%
-#   mutate(code_insee = retrouve_cinsee(CPLA))
+#-Remplissage de la colonne CINS (code insee)-------------------------------------------------------------------------------------------  
+
+#  séparation table remplie et table sans les codes insee
+base_inter_manquantes <- base_intermediaire %>% filter(is.na(CINS)) %>% 
+  select(-CINS)
+base_inter_complete <- base_intermediaire %>% filter(!is.na(CINS))
+
+# recherche des codes insee (on applique la fonction)
+base_inter_manquantes$CINS <- mapply(retrouve_cinsee, 
+                                           base_inter_manquantes$CPLA, 
+                                           base_inter_manquantes$VILL)
+# ATTENTION: OPERATION TRES LONGUE (30 minutes)
+
+# transformation de la colonne du format list en format texte
+base_inter_manquantes2 <- base_inter_manquantes
+base_inter_manquantes2$CINS <- lapply(base_inter_manquantes2$CINS, function(x) if (is.null(x)|| length(x) == 0) NA else x) # remplace les NULL ou character(0) par NA
+base_inter_manquantes2$CINS <- unlist(base_inter_manquantes2$CINS, use.names = FALSE)
+
+# regroupement des tables
+base_intermediaire2 <- bind_rows(base_inter_complete,base_inter_manquantes2)
+
+# nombre de lignes avec CINS = NA
+nb_na <- base_intermediaire2 %>% filter(is.na(CINS)) %>% nrow() %>% as.numeric()
+print(paste("il reste",nb_na,"lignes avec code insee non rempli"))
+
+#-----------remplir les lignes manquantes quand on n'a que le code postal (on met la commune principale)-------------
+#  ne s'effectue que s'il reste des lignes à NA
+if(nb_na == 0){
+}else{
+  base_intermediaire2a <- base_intermediaire2 %>% filter(is.na(CINS))
+  base_intermediaire2b <- base_intermediaire2 %>% filter(!is.na(CINS))
+  
+  retrouve_cinsee_pop_max <- function(codepostal){
+    library(dplyr)
+    library(httr)
+    library(jsonlite)
+    #récupère la table des communes avec ce code postal
+    url <- "https://geo.api.gouv.fr/communes"
+    response <- GET(url, query = list(codePostal = codepostal))
+    c_insee <- fromJSON(content(response, "text"))
+    
+    if (length(c_insee) == 0) {  # si pas de code insee ou code inexistant
+      return(NA)
+      # return(data[[1]]$code)
+    } else {
+      c_insee2 <- c_insee %>%
+        as.data.frame() %>%
+        filter(population == max(population)) %>%  # filtre sur la commune à la population la plus élevée
+        pull(code)  
+      
+      return(c_insee2) #renvoie le code insee de la commune la plus peuplée
+    }
+  }
+  
+  # recherche des codes insee (on applique la fonction)
+  base_intermediaire2a$CINS <- mapply(retrouve_cinsee_pop_max,base_intermediaire2a$CPLA)
+  
+  # transformation de la colonne du format list en format texte
+  base_intermediaire2a$CINS <- lapply(base_intermediaire2a$CINS, function(x) if (is.null(x)|| length(x) == 0) NA else x) # remplace les NULL ou character(0) par NA
+  base_intermediaire2a$CINS <- unlist(base_intermediaire2a$CINS, use.names = FALSE)
+  
+  # regroupement des tables
+  base_intermediaire2 <- bind_rows(base_intermediaire2a,base_intermediaire2b)  
+}
+
+# Vérification des lignes restantes sans code insee
+nb_na <- base_intermediaire2 %>% filter(is.na(CINS)) %>% nrow() %>% as.numeric() # nombre de lignes avec CINS = NA
+print(paste("il reste",nb_na,"lignes avec code insee non rempli")) 
+if(nb_na != 0){
+  stop("il reste des codes insee non remplis, si vous continuez, les lignes correspondantes seront supprimées")
+}
+base_intermediaire2 <- base_intermediaire2 %>% filter(!is.na(CINS)) # suppression des lignes avec CINS= NA
+
 
 #---------------------------------------------------------------------------------------------  
  
 base_intermediaire3 <- base_intermediaire2 %>% 
   filter(!is.na(CINS)) %>%  # filtre pour ne garder que les lignes avec code commune
-  select(-CPLA,-VILL,-lien,-DEPCOM) %>% 
+  select(-CPLA,-VILL) %>% 
   rename(date = "DATP",DEPCOM = "CINS", type_logt = "NALO") %>%
   mutate(type_logt = case_when(
     type_logt == 1 ~ "nb_eptz.maison_individuelle",