/
diag_COG.R
235 lines (196 loc) · 10.9 KB
/
diag_COG.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
# Auteure : Constance Lecomte, Observatoire des territoires, ANCT. Mainteneur et fonctionnalités évolutives : Kim Antunez
#' @title Effectuer un diagnostic sur le COG présent dans une base de données
#' @name diag_COG
#' @description Effectuer un diagnostic sur le COG présent dans une base de données
#' @param table_entree correspond à la table à diagnostiquer (ajout de la colonne de diagnostic au tableau en entrée, nouveaux paramètres optionnels ign_na et id_doubl, simplification du diagnostic)
#' @param codgeo_entree est une chaîne de caractères qui indique le nom de la variable contenant les codes Insee communaux. Par défaut, il s'agit du nom de la première colonne de table_entree.
#' @param ign_na vaut TRUE si on souhaite ignorer les codes manquants. Valeur FALSE par défaut.
#' @param id_doubl vaut TRUE si on souhaite ajouter une colonne d'identification des codes en double à l'export. Valeur FALSE par défaut.
#' @param hypothese_COG (optionnelle) hypothèse formulée par l'utilisateur concernant l'année de référence de COG supposée de la base de données. Le diagnostic sera alors effectué par rapport à cette année de COG. vaut annee_ref (COG le plus récent) par défaut.
#' @param table_diagnostic vaut TRUE si on souhaite obtenir en sortie une table avec un diagnostic de COG pour chaque ligne. vaut TRUE par défaut.
#' @details
#' Le code officiel géographique le plus récent du package est actuellement celui au 01/01/2023. \cr
#'
#' Les millésimes des COG qui peuvent être utilisés sont à ce stade les suivants : 1968, 1975, 1982, 1990, 1999, 2008 à 2023. \cr
#'
#' Les dates de référence des codes officiels géographiques utilisés dans COGugaison sont les suivantes :
#' \itemize{
#' \item{COG 1968 : à partir du 01/03/1968}
#' \item{COG 1975 : à partir du 20/02/1975}
#' \item{COG 1982 : à partir du 04/03/1982}
#' \item{COG 1990 : à partir du 05/03/1990}
#' \item{COG 1999 : à partir du 08/03/1999}
#' \item{Pour tous les autres COG : à partir du 01/01 de chaque année}} \cr
#'
#' Les différences entre les tables de passage Insee et non Insee sont les suivantes :\cr
#' \itemize{
#' \item{1982-03-03 (pris en compte par l'Insee seulement après le 04/03/1982): Flaignes-Havys (08169) est un rassemblement de Flaignes-Havys (08169), Havys (08221) [fusion simple].}
#' \item{2014-01-01 (pris en compte par l'Insee seulement au 01/01/2015) : Loisey (55298) s'est séparée en Loisey (55298), Culey (55138) [rétablissement].}
#' \item{1990-02-01 (pris en compte par l'Insee seulement après le 05/03/1990) : Le code commune de Oudon passe de 14624 à 14697 [changement de code dû à un changement de chef-lieu].}
#' \item{2014-01-07 (pris en compte par l'Insee dès le 01/01/2016) : Tôtes est rattachée à Notre-Dame-de-Fresnay qui devient L'Oudon (changement de code de l'Oudon de 14697 à 14472) [transfert de chef-lieu].}
#' \item{1981-09-28 (pris en compte par l'Insee dès le 20/02/1975) : Vaudreuil-Ex-Ensemble Urbain (27701) est créée à partir des parcelles d'Incarville (27351), de Léry (27365) , de Porte-Joie (27471) , de Poses (27474) , de Saint-Étienne-du-Vauvray (27537), de Saint-Pierre-du-Vauvray (27598), de Tournedos-sur-Seine (27651) et du Vaudreuil (27528) [création]. Cette situation étant complexe, nous avons pour le moment considéré que Vaudreuil-Ex-Ensemble Urbain (27701) est créée à partir de parcelles du Vaudreuil (27528) uniquement.}
#' \item{En 1968, les 4 communes qui auraient dû d'après le COG être codées 2B044,2B076,2B151 et 2A325 sont codées 20044,20076,20151 et 20325 dans les données Insee.}}
#' @references
#' \itemize{
#' \item{\href{https://www.insee.fr/fr/information/2666684#titre-bloc-11}{historique des géographies communales (Insee)}}
#' \item{\href{https://www.insee.fr/fr/information/2028028}{tables d'appartenance des communes aux différents niveaux géographiques (Insee)}}}
#' @seealso
#' \link{COG_akinator}, \link{enlever_PLM}, \link{trajectoire_commune}
#' @export
#' @examples
#' ## Exemple 1
#' # Exemple d'une table dont le COG est au carré
#' sortie <- diag_COG(COG2010)
#' ## Exemple 2
#' # Exemple d'une table qui mix plusieurs COG
#' library(dplyr)
#' table_fictive <- rbind(COG2014,COG2015,COG2013) %>%
#' distinct(CODGEO, .keep_all = TRUE) %>%
#' add_row(CODGEO = c(rep("01001",5),"75101",NA,"98756","ZZZZZ"))
#' # Sans hypothèse préalable sur le COG probable de la table
#' sortie <- diag_COG(table_fictive)
#' # En ayant une hypothèse préalable sur le COG de sortie de la table
#' COG_akinator(table_fictive$CODGEO)
#' sortie <- diag_COG(table_fictive, hypothese_COG = 2013)
#' @encoding UTF-8
#' @import dplyr
diag_COG <- function(table_entree, codgeo_entree = colnames(table_entree)[1], ign_na = FALSE, id_doubl = FALSE, hypothese_COG = annee_ref, table_diagnostic=TRUE){
table_sortie <- table_entree
if(!codgeo_entree%in%colnames(table_sortie)){ #NEW
stop(paste0("codgeo_entree doit être une colonne de table_entree."))
}
temp <- table_sortie %>% select(!!as.name(codgeo_entree)) %>% setNames("codgeo_init")
# ****************************************************************************
# Détection d'erreurs de codes
# Codes manquants
temp.na <- temp %>%
filter(is.na(codgeo_init))
# Codes arrondissements
temp.plm <- temp %>%
filter((substr(codgeo_init, 1, 3) %in% c("751", "132") | substr(codgeo_init, 1, 4) == "6938") & nchar(codgeo_init) == 5)
# Communes des collectivités d'outre-mer
temp.com <- temp %>%
filter((substr(codgeo_init, 1, 2) == "98" | substr(codgeo_init, 1, 3) %in% c("975", "977", "978", "979")) & nchar(codgeo_init) == 5)
# ****************************************************************************
# Diagnostic de COG
diacog.exp <- table_sortie
# Préparation des COG
#list_data <- data(package = "COGugaison")$results[, "Item"]
# list_an_COG <- list_data[substr(list_data, 1, 3) == "COG"] %>%
# substr(., 4, 7) %>%
# unique() %>%
# as.numeric() %>%
# sort(decreasing = T)
list_an_COG <- rev(annees_possibles)
# Algorithme de détection de COG
i <- 1
cog_propre <- FALSE
if(ign_na == F){
df_to_test <- temp %>%
filter(!(codgeo_init %in% temp.plm$codgeo_init) & !(codgeo_init %in% temp.com$codgeo_init))
} else if(ign_na == T) {
df_to_test <- temp %>%
filter(!is.na(codgeo_init)) %>%
filter(!(codgeo_init %in% temp.plm$codgeo_init) & !(codgeo_init %in% temp.com$codgeo_init))
}
while(cog_propre == FALSE){
an <- list_an_COG[i]
nom_COG <- paste0("COG", as.character(an))
if(!is.na(an)){
df_COG <- eval(parse(text = nom_COG))
obs_abs <- filter(df_to_test, !(codgeo_init %in% df_COG$CODGEO))
nb_obs_abs <- nrow(obs_abs)
if(nb_obs_abs == 0){
cog_propre <- TRUE
result <- nom_COG
# Compléter le fichier d'export
diacog.exp <- diacog.exp %>%
mutate(diag_cog = case_when(is.na(!!as.name(codgeo_entree)) ~ "code manquant",
!!as.name(codgeo_entree) %in% unique(temp.plm$codgeo_init) ~ "arrondissement municipal",
!!as.name(codgeo_entree) %in% unique(temp.com$codgeo_init) ~ "collectivité d'outre-mer",
!!as.name(codgeo_entree) %in% unique(df_COG$CODGEO) ~ nom_COG,
TRUE ~ "code indéterminé"))
} else {
i <- i+1
}
} else{
cog_propre <- "non identifiable"
result <- NULL
}
}
# Si COG indétectable
if(cog_propre == "non identifiable"){
codes_communes <- diacog.exp[[codgeo_entree]]
# Si on fait une hypothèse sur le COG, on change l'ordre de parcourt des années.
# On commence par l'hypothèses puis on parcourt les années des plus proches de celle-ci (plus proches voisins)
if(hypothese_COG!=annee_ref){
list_an_COG <- list_an_COG[order(abs(hypothese_COG-list_an_COG))]
}
# On parcourt toutes les années
for(an in list_an_COG){
nom_COG <- paste0("COG", as.character(an))
df_COG <- eval(parse(text = nom_COG))
codes_communes[which(codes_communes%in%df_COG$CODGEO)]<- as.character(an)
}
# On traite le cas des codes communes particuliers
codes_communes[which(is.na(codes_communes))]<- "code manquant"
codes_communes[which(!codes_communes%in%c("code manquant",temp.plm$codgeo_init, temp.com$codgeo_init, annees_possibles))]<- "code indéterminé"
codes_communes[which(codes_communes%in%temp.com$codgeo_init)]<- "collectivité d'outre-mer"
codes_communes[which(codes_communes%in%temp.plm$codgeo_init)]<- "arrondissement municipal"
diacog.exp[["diag_cog"]] <- codes_communes
}
# Export
if(id_doubl == F){
diacog.exp <- diacog.exp %>%
select(!!as.name(codgeo_entree), diag_cog, everything())
} else {
diacog.exp <- diacog.exp %>%
group_by(!!as.name(codgeo_entree)) %>%
mutate("code_doubl" = case_when(n()>1 ~ "code doublonné", TRUE ~ "code unique")) %>%
ungroup() %>%
select(!!as.name(codgeo_entree), diag_cog, code_doubl, everything())
}
# ****************************************************************************
# Export du diagnostic
# Diagnostic console
print("# ------------------------------")
print("# DIAGNOSTIC DE COG")
print("# ------------------------------")
print("# Synthèse")
recap.temp <- diacog.exp %>%
group_by(diag_cog) %>%
summarise("NB_OBS" = n()) %>%
ungroup() %>%
arrange(desc(NB_OBS)) %>%
rbind(data.frame("diag_cog" = "codes uniques",
"NB_OBS" = length(unique(diacog.exp[[codgeo_entree]])))) %>%
setNames(c("", "Nombre d'observations"))
# COG identifiable
if(!is.null(result)){
print(paste0("# ", result))
print("# ------------------------------")
print("# Diagnostic détaillé")
print(paste0("# Le fichier compte ", nrow(diacog.exp), " codes communes."))
print("# Le diagnostic de COG correspond au COG le plus récent dans lequel l'ensemble des codes communes du fichier en entrée sont présents.")
print(knitr::kable(recap.temp,
format = "markdown"))
# COG non identifiable
} else {
print("# COG non identifiable")
print("# ------------------------------")
print("# Diagnostic détaillé")
print(paste0("# Le fichier compte ", nrow(diacog.exp), " codes communes."))
if(hypothese_COG==annee_ref){
print("# Dans la mesure où le COG n'est pas identifiable, pour chaque commune considérée, le diagnostic de COG correspond au COG le plus récent qui contient son code commune.")
} else{
print(paste0("# Dans la mesure où le COG n'est pas identifiable, pour chaque commune considérée, le diagnostic de COG correspond au COG le plus proche de l'année de référence (", hypothese_COG,") qui contient son code commune."))
}
print(knitr::kable(recap.temp,
format = "markdown"))
}
if(table_diagnostic){
return(diacog.exp)
} else{
return(invisible(NULL))
}
}