Arthur Charpentier et Ewen Gallic
freakonometrics.hypotheses.org
egallic.fr
Janvier 2018.
Le nombre de données relevant quasiment du milliard d’observations, un ordinateur classique se révèle pour l’heure un peu capricieux lors de l’import. La stratégie adoptée consiste à segmenter les observations par morceaux.
Les données dont nous disposons sont partagées en trois tronçons. Malgré ce découpage, le nombre de lignes reste trop conséquent pour l’ordinateur. Nous décidons d’effectuer un découpage plus important.
Pour importer un tronçons, nous utilisons la fonction fread. Nous lisons les observations par petits morceaux de \(20\times10^6\) lignes. Dans un premier temps, il nous est nécessaire de connaître le nombre total d’observations du tronçons sur lequel nous travaillons. L’instruction suivante nous permet de révéler cette information :
```r library(dplyr) library(stringr) library(ggplot2) library(readr) library(tidyr) library(stringi) library(data.table) library(pbapply)
nrow(fread(fichier, select = 1L)) ```
Le nom des colonnes s’obtient facilement :
col_label <- fread(fichier, nrows = 0)
col_label <- colnames(col_label)Le premier tronçon contient \(412~406~274\) lignes. Nous pouvons créer une variable indiquant les valeurs de débuts et fins de lignes à importer, de manière à lire uniquement \(20\times10^6\) lignes au maximum à chaque importation.
seq_nbs <- seq(1, 412406274, by = 20*10^6)
seq_nbs <- c(seq_nbs, 412406274)
seq_nbs[1] <- 2 # La première ligne correspond aux noms de colonnes
a_parcourir <- data.frame(debut = seq_nbs[-length(seq_nbs)], fin = seq_nbs[-1]-1)L’importation de chaque tronçon se fait à l’aide de la fonction fread, comme suit (ici, pour le premier tronçon) :
numero_chunk <- 1 # Tronçon 1
val_deb <- a_parcourir$debut[numero_chunk]
val_fin <- a_parcourir$fin[numero_chunk]
val_skip <- val_deb-1
val_nrows <- val_fin-val_deb+1
chunk <- fread(fichier,
encoding = "Latin-1",
header = FALSE, sep = ";",
fill=TRUE, col.names=col_label, quote='',
stringsAsFactors = FALSE,
colClasses=c(rep("character",19)),
na.strings=c("NA","NaN"," ","","0"),
skip = val_skip,
nrows = val_nrows)Pour ce qui nous intéresse ici, nous pouvons nous permettre de séparer les observations les unes des autres, à condition de conserver celles provenant d’un même arbre d’utilisateur. Nous regroupons chaque observations en fonction du premier caractère alpha numérique des utilistaurs.
# Creation de chunks en fonction de la premiere lettre du nom du prorietaire
chunk[, prem_lettre:=str_to_lower(str_sub(sourcename, 1, 1))]
# Les valeurs différentes pour le nom d'utilisateur
motifs <- unique(chunk$prem_lettre) %>% sort()
# On conserve uniquement les lettres, et on ajoute une valeur pour "non-lettre" (pour les chiffres par exemple)
motifs <- c(motifs[str_detect(motifs, "[:letter:]")], "[^[:letter:]]")
# Sauvegarde dans des tronçons en fonction de la première lettre du nom d'utilisateur
pb2 <- txtProgressBar(min = 1, max = length(motifs), style = 3, char = "@")
for(ii in 1:length(motifs)){
prem <- motifs[ii]
if(ii == length(motifs)) prem <- "0"
chunk_lettre <- chunk[str_detect(prem_lettre, motifs[ii])]
chunk_lettre[,prem_lettre:=NULL]
save(chunk_lettre, file = str_c("../data/Geneanet/raw/chunks/chunk_", sprintf("%02s", no_chunks_geneanet), "_", sprintf("%02s", numero_chunk), "_", prem, ".rda"))
setTxtProgressBar(pb2, ii)
}Il suffit alors de créer une petite fonction pour faire tourner sur les trois fichiers fournis par Geneanet, et de sauvegarder le résultat dans un fichier de données.
Comme les données initiales sont réparties dans trois fichiers, les petits tronçons obtenus dans l’étape précédente doivent être regroupés (si jamais des données de l’utilisateur toto se trouvent dans au moins deux fichiers différents).
# Chemin vers les tronçons
path_to_files <- "../data/Geneanet/raw/chunks/"
# Liste des fichiers
fichiers <- list.files(path_to_files, pattern = "\\.rda", full.names = TRUE)
motifs <- list.files(path_to_files, pattern = "\\.rda")
motifs <- str_replace(motifs, "chunk_0(1|2|3)_[[:digit:]]{2}_", "") %>%
str_replace("\\.rda", "")
motifs <- unique(motifs) %>% sort()
motifs <- c(motifs[str_detect(motifs, "[:letter:]")], "[^[:letter:]]")
# Créé le dossier d'enregistrements des tronçons, si besoin
if(!dir.exists("../data/Geneanet/raw/chunks_letter/")) dir.create("../data/Geneanet/raw/chunks_letter/", recursive = TRUE)
# motif <- "z"
save_chunks_lettre <- function(motif){
fichiers_charger <- fichiers[str_detect(fichiers, str_c(motif, ".rda"))]
# Charger les
chunks <- pblapply(fichiers_charger, function(x) {load(x) ; unique(chunk_lettre)})
chunk_lettre <- rbindlist(chunks)
chunk_lettre <- unique(chunk_lettre)
if(motif == "[^[:letter:]]") motif <- "0"
save(chunk_lettre, file = str_c("../data/Geneanet/raw/chunks_letter/chunk_", motif, ".rda"))
}
# Regroupe les tronçons et sauvegarde le résultat
pblapply(motifs, save_chunks_lettre)Afin d’accélérer les étapes suivantes, les tronçons d’utilisateurs sont découpés en 5 parties contenant plus ou moins le même nombre d’utilisateurs différents.
# Les tronçons
N <- list.files("../data/Geneanet/raw/chunks_letter/", pattern = "*.rda", full.names = TRUE)
# Création du dossier d'enregistrement des petits tronçons
if(!dir.exists("../data/Geneanet/raw/chunks_letter_2/")) dir.create("../data/Geneanet/raw/chunks_letter_2/", recursive = TRUE)
# Fonction pour découper des vecteurs en parties à peu près égales
chunk2 <- function(x,n) split(x, cut(seq_along(x), n, labels = FALSE))
#' decouper_chunks
#' @i: indice de position du fichier dans N
decouper_chunks <- function(i){
# Obtenir la lettre des noms d'utilisateurs du tronçon courant
lettre <- str_replace(N[i], "../data/Geneanet/raw/chunks_letter//chunk_", "")
lettre <- str_replace(lettre, "\\.rda", "")
# Chargement du tronçon
load(N[i], envir = globalenv())
# Les noms d'utilisateurs
sourcenames <- unique(chunk_lettre$sourcename)
# Partage équitable des noms d'utilisateurs (!= des observations)
chunk_sourcenames <- chunk2(sourcenames, 5)
#' sauvegarder_chunk
#' @j: indice de chunk_sourcenames à extraire pour traiter
#' les utilisateurs qu'il contient
sauvegarder_chunk <- function(j){
sourcenames_chunk <- chunk_sourcenames[[j]]
chunk_lettre_tmp <- chunk_lettre[sourcename %in% sourcenames_chunk]
save(chunk_lettre_tmp, file = str_c("../data/Geneanet/raw/chunks_letter_2//chunk_lettre_tmp_",
lettre, "_", str_pad(j, width = 2, pad = "0"), ".rda"))
}# Fin de sauvegarder_chunk()
# Création de 5 petits tronçons pour le fichier courant
pblapply(1:5, sauvegarder_chunk)
}# Fin de decouper_chunks()
# Découper en 5 petits tronçons les fichiers
pblapply(1:length(N), decouper_chunks)Pour déployer les étapes de traitement des données suivantes sur plusieurs machines en même temps, nous regroupons les individus par département. Dans cette même étape, nous regroupons les informations de chaque individu sur une seule ligne. En effet, jusqu’à présent, une ligne correspond à un événement pour un individu dans l’arbre d’un utilisateur.
Pour commencer, nous consignons dans un tableau les différentes régions françaises présentes dans les données :
# Choix d'un tronçon
load("../data/Geneanet/raw/chunks_letter_2/chunk_lettre_tmp_0_05.rda")
liste_depts <-
chunk_lettre_tmp %>%
rename(dept = `sous-region`) %>%
select(pays, region, dept) %>%
filter(pays == "FRA") %>%
unique() %>%
arrange(region, dept) %>%
filter(!is.na(dept)) %>%
tbl_df()
save(liste_depts, file = "liste_depts.rda")Nous travaillons par tronçons obtenu dans l’étape précédente. Il est de fait nécessaire de les lister.
N <- list.files("../data/Geneanet/raw/chunks_letter_2/", full.names = TRUE)Le code qui suit permet de traiter un seul tronçon, dont la position dans N est notée i_fichier. Nous prenons le premier fichier en exemple dans le code qui suit. Un simple boucle sur les indices des éléments de N permet de traiter chaque tronçon.
i_fichier <- 1
fichier <- N[i_fichier]
# La première lettre du nom d'utilisateur
lettre <- str_replace(fichier, "../data/Geneanet/raw/chunks_letter_2//chunk_lettre_tmp_", "") %>%
str_replace(., "_..\\.rda", "")
# Le numéro de tronçon
num_chunk <- str_replace(fichier, "../data/Geneanet/raw/chunks_letter_2//chunk_lettre_tmp_", "") %>%
str_replace(., "._", "") %>%
str_replace(., "\\.rda", "")Trois types d’événements sont présents dans la base : naissance, mariage et décès. Nous créons une fonction pour indiquer les informations relatives à ces événements : géographie et date.
#' endroit_acte
#'
#' Retourne un tableau de donnees indiquant la geographie de l'enregistrement
#' pour un type d'acte donnee
#'
#' @x: (data.table) informations sur un individu
#' @acte : (string) type d'acte : "N" pour naissance, "M" pour mariage, ou "D" pour deces
#' x <- nai_per ; acte <- "N"
endroit_acte <- function(x, acte){
if(nrow(x)>0){
res <-
data.table(lieu = x$lieu,
dept = x$dept,
region = x$region,
pays = x$pays,
lat = x$latitude,
long = x$longitude,
stringsAsFactors = FALSE)
if(acte == "N"){
date <- x$date_naissance
}else if(acte == "M"){
date <- NA
}else{
date <- x$date_deces
}
res$date <- date
}else{
res <-
data.table(lieu = NA, dept = NA, region = NA, pays = NA, lat = NA, long = NA, date = NA, stringsAsFactors = FALSE)
}
res <- unique(res)
names(res) <- str_c(names(res), "_", acte)
res %>% tbl_df()
}# Fin de endroit_acte()La fonction simplifier_personne() permet de créer un seul enregistrement par individu, pour un arbre d’utilisateur donné. Ainsi, au lieu d’avoir une ligne par événement, nous n’en conservons plus qu’une. Cela a une incidence sur les différents mariages : nous ne pouvons de fait en conserver qu’un seul.
#' simplifier_personne
#'
#' Retourne les informations relatives a la naissance, le mariage et le deces
#' d'une personne
#'
#' @un_id_personne: (string) id unique de la personne
#' @dt_source: (data.table) tableau de donnees dans lequel chercher les
#' informations pour cette personne
#' dt_source <- chunk_user ; un_id_personne <- ids_personnes[1]
simplifier_personne <- function(un_id_personne, dt_source){
enregistrements_personne <- dt_source[id_personne == un_id_personne]
sourcename_per <- enregistrements_personne$sourcename %>% unique()
nom_per <- enregistrements_personne %>%
arrange(desc(str_length(nom))) %>%
slice(1) %>%
.$nom
prenoms_per <- enregistrements_personne %>%
arrange(desc(str_length(prenoms))) %>%
slice(1) %>%
.$prenoms
sexe_per <- enregistrements_personne$sexe %>% unique()
id_mere_per <- enregistrements_personne$id_mere %>% unique()
id_pere_per <- enregistrements_personne$id_pere %>% unique()
# Naissance
nai_per <- enregistrements_personne[stri_detect_regex(event_type, "N")]
nai <- endroit_acte(nai_per, "N")
# S'il y a plusieurs lieux de naissance, choisir celui le plus court
if(nrow(nai)>1){
nai <-
nai %>%
filter(!is.na(lieu_N)) %>%
arrange(str_length(lieu_N)) %>%
slice(1)
}
# Mariage
mar_per <- enregistrements_personne[stri_detect_regex(event_type, "M")]
mar <- endroit_acte(mar_per, "M")
# S'il y a plusieurs dates de mariages : on ne retient que la plus ancienne
if(nrow(mar)>1){
mar <-
mar %>%
arrange(date_M) %>%
slice(1)
}
# Deces
dec_per <- enregistrements_personne[stri_detect_regex(event_type, "D")]
dec <- endroit_acte(dec_per, "D")
# S'il y a plusieurs lieux de deces, choisir celui le plus court
if(nrow(dec)>1){
dec <-
dec %>%
filter(!is.na(lieu_D)) %>%
arrange(str_length(lieu_D)) %>%
slice(1)
}
nai$date_N <- enregistrements_personne$date_naissance %>% unique()
dec$date_D <- enregistrements_personne$date_deces %>% unique()
data.table(sourcename = sourcename_per, id_personne = un_id_personne,
nom = nom_per, prenoms = prenoms_per, sexe = sexe_per,
id_mere = id_mere_per, id_pere = id_pere_per, stringsAsFactors = FALSE) %>%
cbind(., nai) %>%
cbind(., mar) %>%
cbind(., dec) %>%
unique()
}# Fin de simplifier_personne()La fonction simplifier_proprietaire() permet de simplifier l’ensemble des individus présents dans l’arbre d’un usager de Geneanet. Elle s’appuie sur la fonction simplifier_personne() précédemment définie.
#' simplifier_proprietaire
#'
#' Pour un proprietaire, simplifie les informations de tous les individus
#'
#' @id_user: (string) identifiant d'un proprietaire d'arbre
#' @chunk_lettre: (tbl.df) base de donnees contenant les informations des utilisateurs dans le chunk
#' id_user <- "61p"
simplifier_proprietaire <- function(id_user, chunk_lettre){
# Se restreinde aux individus de l'arbre du proprietaire
chunk_user <- chunk_lettre[sourcename == id_user]
# Creation d'un identifiant unique par personne
chunk_user[, id_personne := str_c(sourcename, ref_locale, sep = "@")]
# Ajout de l'identifiant des parents
identifiants_mere <- chunk_user[, list(ID_num, id_personne)] %>%
rename(ID_num_mere = ID_num, id_mere = id_personne)
identifiants_pere <- chunk_user[, list(ID_num, id_personne)] %>%
rename(ID_num_pere = ID_num, id_pere = id_personne)
chunk_user <- identifiants_mere[chunk_user, on = "ID_num_mere"]
chunk_user <- identifiants_pere[chunk_user, on = "ID_num_pere"]
# Suppression de variables qui vont perturber la simplification
# chunk_user[, c("ref_locale", "ID_num", "ID_num_pere", "ID_num_mere", "ID_num_conjoint") := NULL]
chunk_user[, c("ID_num", "ID_num_pere", "ID_num_mere", "ID_num_conjoint") := NULL]
# Pour chaque personne, un enregistrement correspond soit :
# a une naissance (N), un mariage (M), un deces (D),
# ou un mixe de ces evenements (e.g., NM pour naissance et mariage)
# Cette distinction est faite parce que les lieux de N, M ou D peuvent varier
# On va prendre uniquement la date du premier mariage en compte ici.
ids_personnes <- chunk_user[!is.na(id_personne)]$id_personne %>% unique()
lapply(ids_personnes, simplifier_personne, dt_source = chunk_user) %>%
rbindlist
}# simplifier_proprietaireNous chargeons en mémoire un tronçon précédemment créé, et nous travaillons sur celui-ci. Nous donnons ici les étapes de traitement pour un tronçon ; il est aisé de créer par la suite une fonction et de l’appliquer à chaque tronçon.
# Chargement du chunk
fichier <- N[1]
load(fichier, envir = .GlobalEnv)
chunk_lettre <- chunk_lettre_tmp
rm(chunk_lettre_tmp)Nous listons les différents usagers (ou propriétaires d’arbre), et procédons à quelques opérations de nommage de variables, afin de faciliter l’écriture du code.
ids_sourcename <- chunk_lettre$sourcename %>% unique()
nbs_obs_ids_sourcename <- length(ids_sourcename)
chunk_lettre <- chunk_lettre %>% rename(dept = `sous-region`)
chunk_lettre <- chunk_lettre %>% rename(ID_num = increment,
ID_num_mere = numero_mere,
ID_num_pere = numero_pere,
ID_num_conjoint = numero_conjoint,
prenoms = prenom)Nous avons pris le parti de suivre les descendants d’individus nés entre 1800 et 1804 en France. La base est filtrée en conséquence.
gen_0 <- chunk_lettre
gen_0[, annee_nai := stri_sub(date_naissance, 1, 4)]
gen_0 <- gen_0[annee_nai %in% seq(1800, 1804)]
gen_0 <- gen_0[stri_detect_regex(event_type, "N")]
# Se restreindre uniquement aux abres dont un des individus est né entre 1800 et 1804
chunk_lettre <- chunk_lettre[sourcename %in% unique(gen_0$sourcename)]Afin d’alléger les opérations à faire subir aux machines, nous travaillons par départements. Nous proposons ici la méthode pour gérer le cas d’un département. À nouveau, une fonction englobant le code qui suit permet de traiter l’ensemble des départements ultérieurement.
i_departement <- "F01"
departement <- liste_depts$dept[i_departement]
# Création du dossier de sauvegarde des résultats
if(!dir.exists(str_c("../data/individuals/migration/", departement, "/"))) dir.create(str_c("../data/individuals/migration/", departement, "/"), recursive = TRUE)Nous filtrons la base pour se restreindre aux individus de première génération nés dans le département :
gen_0 <- gen_0[dept %in% departement]
# Noms d'utilisateurs de la sous-partie de la base de données
ids_sourcename <- gen_0$sourcename %>% unique()Il s’agit à présent de se restreindre aux parents et descendants des individus ainsi sélectionnés.
# Initialisation
# La generation courante
gen_n <- gen_0[, list(sourcename, ID_num, ID_num_mere, ID_num_pere)]
nb_obs_gen_0 <- nrow(gen_n)
conserver <- gen_n[, list(sourcename, ID_num)]
# Les generations restantes (on retire la generation courante)
chunk_lettre <- chunk_lettre[sourcename %in% unique(gen_0$sourcename)]
gen_restants <- chunk_lettre[,list(sourcename, ID_num, ID_num_mere, ID_num_pere)]
gen_restants <- fsetdiff(gen_restants, gen_n, all = FALSE)
# Les parents
parents_gen_0 <-
gen_n %>%
select(sourcename, ID_num_mere) %>%
rename(ID_num = ID_num_mere) %>%
bind_rows(
gen_n %>%
select(sourcename, ID_num_pere) %>%
rename(ID_num = ID_num_pere)
) %>%
unique()
parents_gen_0_complet <- gen_restants[parents_gen_0, on = c("sourcename", "ID_num")]
# On retire les individus trouvés
# Bémol : cette étape retire les individus nés d'une relation incestueuse
gen_restants <- fsetdiff(gen_restants, parents_gen_0_complet, all = FALSE)
# Boucle
# Parmi ces personnes, lesquelles ont pour parent quelqu'un de la generation precedente
compteur <- 0
while(nrow(gen_n) > 0){
compteur <- compteur+1
if(compteur>=15) stop("Trop de tours")
parents_m <- data.table(gen_n %>% select(sourcename, ID_num) %>% rename(ID_num_mere = ID_num))
parents_p <- data.table(gen_n %>% select(sourcename, ID_num) %>% rename(ID_num_pere = ID_num))
enfants <- data.table(gen_restants %>% select(sourcename, ID_num_mere, ID_num_pere, ID_num))
gen_n <- enfants[parents_m, on = c("sourcename", "ID_num_mere")][!is.na(ID_num)] %>%
rbind(
enfants[parents_p, on = c("sourcename", "ID_num_pere")][!is.na(ID_num)]
) %>%
unique()
conserver <- rbind(conserver, gen_n %>% select(sourcename, ID_num)) %>% unique()
# Les generations restantes
gen_restants <- gen_restants[!gen_n, on = c("sourcename", "ID_num")]
}# Fin du while
# Les individus à conserver
conserver <- rbind(parents_gen_0, conserver)
# La base concernant ces individus
chunk_partiel <- chunk_lettre[conserver, on = c("sourcename", "ID_num")]Reste alors à procéder à la simplification des lignes pour tous ces individus. Le code s’attache à le faire par utilisateur de Geneanet.
res <- pblapply(ids_sourcename, simplifier_proprietaire, chunk_lettre = chunk_partiel)Comme cette dernière opération informatique prend beaucoup de temps, il est possible de proposer une version parallélisée :
library(parallel)
# Nombre de clusters
ncl <- detectCores()-1
(cl <- makeCluster(ncl))
invisible(clusterEvalQ(cl, library(dplyr, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(stringr, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(tidyr, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(stringi, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(data.table, warn.conflicts=FALSE, quietly=TRUE)))
# Evnoi des fonctions/données aux clusters
clusterExport(cl, c("simplifier_personne", "endroit_acte"))
res <- pblapply(ids_sourcename, simplifier_proprietaire, cl = cl, chunk_lettre = chunk_partiel)
stopCluster(cl)Reste à rassembler chaque résultat dans un seul tableau :
res <-
res %>% rbindlistEt enfin de sauvegarder le résultat :
save(res, file = str_c("../data/individuals/migration/", departement,"/chunk_", lettre, "_", num_chunk, ".rda"))Comme chaque usager du site Geneanet peut construire son propre arbre, il existe de nombreux doublons. Nous adoptons une stratégie en plusieurs étapes pour tenter de joindre les arbres entre-eux, tout en évitant les doublons. Du fait de l’important des données manquantes, cette tâche s’avère délicate. Il persiste sûrement au final des doublons, qui ne seront, pour la plupart, pas utilisés dans l’analyse. En effet, s’ils n’ont pas été repérés en tant que doublons, c’est qu’ils sont porteur de très peu d’informations, et seront donc écartés par la suite.
Cette étape dans le processus de nettoyage des données permet non seulement de relier les arbres d’utilisateurs entre eux, mais également de compléter certaines informations qui pourraient manquer dans l’arbre d’un usager mais être présentes dans celui d’un autre.
Nous présentons ici quelques fonctions permettant d’effectuer les regroupements.
La fonction most_probable_value() permet de trouver la valeur la plus probable parmi les différentes proposées. Elle prend en entrée le nom de la variable à laquelle on s’intéresse, le tableau de données contenant les valeurs, et une variable indiquant si des poids dans les observations sont fournis. La valeur finale sera celle dont la fréquence (pondérée le cas échéant) est la plus élevée parmi les propositions.
Cette fonction s’utilise sur des données concernant des individus étant identifiés comme désignant la même personne.
#' most_probable_value
#' Find the most probable value for a variable
#' using the values found within all candidates
#' (excluding NAs)
#' @variable_name: (string) name of the variable
#' @df: (data.table)
#' @weights: (logic) should the simplification consider the weights? (default: FALSE)
#' variable_name <- "date_N"
most_probable_value <- function(df, variable_name, weights = FALSE){
valeurs <- df[[variable_name]]
if(!all(is.na(valeurs))){
if(weights){
poids <- df[["weight"]]
res <- data.frame(valeurs, poids, stringsAsFactors = FALSE) %>%
group_by(valeurs) %>%
summarise(poids = sum(poids)) %>%
ungroup()
# Si la variable est une date
# on va privilegier les informatins relatives aux dates completes
if(variable_name %in% c("date_N", "date_M", "date_D")){
tmp <- res %>%
mutate(mois = str_sub(valeurs, 5, 6),
jour = str_sub(valeurs, 7, 8)) %>%
filter(!(mois == "00" | jour == "00"))
# S'il reste des informations, on se base sur elles
if(nrow(tmp)>0) res <- tmp
}
res <-
res %>%
arrange(desc(poids)) %>%
slice(1) %>%
magrittr::extract2("valeurs")
}else{# Si pas de poids
table_freq <- sort(table(valeurs))
res <- names(table_freq)[1]
}
}else{
res <- NA
}
res
}# End of most_probable_value()La fonction simplifier_personne(), à partir d’individus identifiés comme désignant la même personne, simplifie les valeurs de chaque variable pour n’obtenir qu’une seule observation en sortie. Les valeurs de chaque variable sont obtenues en faisant appel à la fonction most_probable_value() précédemment définie.
# df_corresp <- corresp ; un_groupe_num <- 2 ; weights <- TRUE
# rm(df_corresp, un_groupe_num, groupe_cour, individus_cour, nouvelles_valeurs, weight)
#' @weights: (logic) should the simplification consider the weights? (default: TRUE)
simplifier_personne <- function(df_corresp, un_groupe_num, weights = TRUE){
groupe_cour <- df_corresp[id_personne_num_groupe %in% un_groupe_num]
individus_cour <- individus_simple[id_personne_num %in% groupe_cour$id_personne_num]
weight <- sum(individus_cour$weight)
if(nrow(individus_cour) == 1){
nouvelles_valeurs <- individus_cour[, mget(c(variables_names))]
}else{
# Les valeurs probables pour les variables d'interet
nouvelles_valeurs <-
variables_names %>%
sapply(., most_probable_value, df = individus_cour, weights = weights) %>%
t() %>%
data.table(stringsAsFactors = FALSE)
}
cbind(id_personne_num = un_groupe_num, nouvelles_valeurs, weight = weight)
}# End of simplifier_personne()Une fonction permettant de gérer les valeurs manquantes lors de l’utilisation de la fonction min().
my_min <- function(x) ifelse( !all(is.na(x)), min(x, na.rm=T), NA)Nous allons retenir uniquement certaines variables pour les individus. Les variables textuelles de lieu sont évincées ici.
# Les vairables qui nous interessent
variables_names <- c("nom", "prenoms",
"sexe",
"lieu_N", "dept_N", "region_N", "pays_N", "lat_N", "long_N", "date_N",
"lieu_M", "dept_M", "region_M", "pays_M", "lat_M", "long_M", "date_M",
"lieu_D", "dept_D", "region_D", "pays_D", "lat_D",