tools/importer-eacr.R

In legiretraite: Recueil De Paramètres Législatifs et Réglementaires Sur Les Retraites Françaises

# Import de l'EACR (enquete annuelle aupres des caisses de retraite), diffusee
# en open data par la Drees :
# https://data.drees.solidarites-sante.gouv.fr/explore/dataset/donnes_eacr/
#
# La source est publiee en deux classeurs Excel de 24 et 16 Mo, qui portent
# douze feuilles et pres d'un million de lignes. Ce script les telecharge dans
# `drees/eacr` -- dossier ignore par Git --, normalise les colonnes, puis ecrit
# une table par feuille dans inst/extdata/drees/eacr au format parquet. Ce sont
# ces parquets que le depot versionne et que `lireEacr()` relit : comme pour les
# baremes de l'IPP, on embarque le resultat de la lecture et non les fichiers
# bruts.
#
# Usage :
#   devtools::load_all()
#   source("tools/importer-eacr.R")
#   importerEacr()                    # telecharge, puis reecrit les parquets
#   importerEacr(telecharger = FALSE) # reutilise les classeurs deja presents
#
# A relancer a chaque millesime (la Drees publie au printemps). Le script
# retrouve les pieces jointes par leur titre et non par leur identifiant, qui
# porte la date de publication ; il ecrit ce titre dans millesime.csv, a cote
# des parquets, pour que le depot dise quelle version il embarque.
#
# Si la Drees ajoute ou renomme une colonne, l'import s'arrete sur le nom
# inconnu : le dictionnaire ci-dessous doit alors etre complete a la main, ce
# qui vaut mieux qu'une colonne muette ou mal typee.

library(data.table)

# Le jeu de donnees ne porte aucun enregistrement interrogeable : tout est en
# pieces jointes, dont on ne connait l'identifiant qu'en lisant les metadonnees.
urlJeuDeDonnees <- paste0(
  "https://data.drees.solidarites-sante.gouv.fr/api/datasets/1.0/donnes_eacr/"
)

# Dictionnaire des colonnes : nom dans la source, nom retenu, type.
#
# Les noms de la source melangent accents, casses et separateurs ("PlusRecent",
# "Champ_FluxStock", "ageconj", "txReduit") et une meme grandeur change de nom
# d'une feuille a l'autre ("Annee" en H, "Annee" ailleurs). Le dictionnaire est
# donc global : une entree par nom rencontre, appliquee a toute feuille qui le
# porte.
#
# `age`, `ageQuinquennal` et `nbTrim` restent des chaines : la source y place la
# marge ("Ensemble") a cote des valeurs, et la coercition en entier la perdrait.
colonnesEacr <- data.table(
  nomSource = c(
    "Année",
    "Annee",
    "Source",
    "CC",
    "Caisse",
    "Sexe",
    "Resid",
    "Naiss",
    "Champ",
    "Champ_FluxStock",
    "Liq",
    "StatutSNCF",
    "PlusRécent",
    "AgeQuin",
    "Age",
    "Nb_trim",
    "Type",
    "Type_depart",
    "Type_montant",
    "Taux",
    "PSoc",
    "Droit",
    "effectifs",
    "m1",
    "m2",
    "mont",
    "montant",
    "rente",
    "ageliq",
    "ageconj",
    "eqcc",
    "exonération",
    "txRéduit",
    "txMédian",
    "txPlein",
    "txInconnu",
    "ensemble"
  ),
  nom = c(
    "annee",
    "annee",
    "source",
    "cc",
    "caisseEacr",
    "sexe",
    "resid",
    "naiss",
    "champ",
    "champFluxStock",
    "liq",
    "statutSncf",
    "plusRecent",
    "ageQuinquennal",
    "age",
    "nbTrim",
    "type",
    "typeDepart",
    "typeMontant",
    "taux",
    "prelevement",
    "droit",
    "effectifs",
    "m1",
    "m2",
    "mont",
    "montant",
    "rente",
    "ageLiq",
    "ageConjoncturel",
    "eqcc",
    "exoneration",
    "txReduit",
    "txMedian",
    "txPlein",
    "txInconnu",
    "ensemble"
  ),
  type = c(
    "entier",
    "entier",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "booleen",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "chaine",
    "entier",
    "reel",
    "reel",
    "reel",
    "reel",
    "reel",
    "reel",
    "reel",
    "reel",
    "entier",
    "entier",
    "entier",
    "entier",
    "entier",
    "entier"
  )
)

# Coercition qui refuse de perdre une valeur en silence : toute chaine que la
# conversion transforme en NA arrete l'import. Une virgule decimale ou un
# marqueur de secret statistique glisse dans un fichier a chaque millesime.
convertirColonne <- function(valeurs, type, colonne) {
  converti <- switch(
    type,
    chaine = valeurs,
    entier = as.integer(suppressWarnings(as.numeric(valeurs))),
    reel = suppressWarnings(as.numeric(valeurs)),
    booleen = c("TRUE" = TRUE, "FALSE" = FALSE)[valeurs],
    stop("type inconnu : ", type)
  )
  perdues <- unique(valeurs[is.na(converti) & !is.na(valeurs)])
  if (length(perdues) > 0) {
    stop(
      "La colonne '",
      colonne,
      "' porte ",
      length(perdues),
      " valeur(s) que la conversion en '",
      type,
      "' perdrait : ",
      paste0("'", utils::head(perdues, 5), "'", collapse = ", ")
    )
  }
  unname(converti)
}

# Renvoie les pieces jointes du jeu de donnees, titre et url de telechargement.
piecesJointesEacr <- function() {
  metadonnees <- jsonlite::fromJSON(urlJeuDeDonnees, simplifyVector = FALSE)
  pieces <- rbindlist(lapply(metadonnees$attachments, function(piece) {
    data.table(
      titre = piece$title,
      url = paste0(urlJeuDeDonnees, "attachments/", piece$id, "/")
    )
  }))
  # Les deux classeurs sont les seules pieces jointes utiles : la documentation
  # (PDF) et les exports HTML des tables A, C et D disent la meme chose.
  pieces[grepl("[Pp]art 1", titre), partie := 1L]
  pieces[grepl("[Pp]art 2", titre), partie := 2L]
  classeurs <- pieces[!is.na(partie)][order(partie)]
  if (nrow(classeurs) != 2L) {
    stop(
      "Le jeu de donnees ne porte plus exactement deux classeurs 'Part 1' et ",
      "'Part 2' mais : ",
      paste0("'", pieces$titre, "'", collapse = ", ")
    )
  }
  classeurs[]
}

telechargerEacr <- function(classeurs, chemin) {
  if (!dir.exists(chemin)) {
    dir.create(chemin, recursive = TRUE)
  }
  for (ligne in seq_len(nrow(classeurs))) {
    destination <- file.path(chemin, classeurs$fichierLocal[ligne])
    logger::log_info("Téléchargement de {classeurs$titre[ligne]}")
    utils::download.file(
      url = classeurs$url[ligne],
      destfile = destination,
      mode = "wb",
      quiet = TRUE
    )
  }
}

# Lit une feuille en chaines de caracteres, renomme et type ses colonnes.
lireFeuilleEacr <- function(classeur, feuille) {
  brut <- setDT(readxl::read_excel(
    path = classeur,
    sheet = feuille,
    col_types = "text"
  ))
  inconnues <- setdiff(names(brut), colonnesEacr$nomSource)
  if (length(inconnues) > 0) {
    stop(
      "La feuille '",
      feuille,
      "' porte des colonnes absentes du dictionnaire : ",
      paste0("'", inconnues, "'", collapse = ", ")
    )
  }
  dictionnaire <- colonnesEacr[match(names(brut), nomSource)]
  colonnes <- Map(
    convertirColonne,
    valeurs = as.list(brut),
    type = dictionnaire$type,
    colonne = dictionnaire$nom
  )
  # `Map` reprend les noms de son premier argument, donc ceux de la source
  names(colonnes) <- dictionnaire$nom
  setDT(colonnes)[]
}

#' Reecrit les tables de l'EACR embarquees par le paquet
#'
#' @param chemin ou ecrire les parquets
#' @param cheminClasseurs ou telecharger et relire les classeurs Excel
#' @param telecharger faut-il retelecharger les classeurs
importerEacr <- function(
  chemin = here::here("inst", "extdata", "drees", "eacr"),
  cheminClasseurs = here::here("drees", "eacr"),
  telecharger = TRUE
) {
  classeurs <- piecesJointesEacr()
  classeurs[, fichierLocal := paste0("eacr-part", partie, ".xlsx")]

  if (telecharger) {
    telechargerEacr(classeurs, cheminClasseurs)
  }
  for (fichier in file.path(cheminClasseurs, classeurs$fichierLocal)) {
    checkmate::assert_file_exists(fichier, access = "r")
  }

  if (!dir.exists(chemin)) {
    dir.create(chemin, recursive = TRUE)
  }

  registre <- tablesEacr()
  for (ligne in seq_len(nrow(registre))) {
    tableEacr <- registre[ligne]
    classeur <- file.path(
      cheminClasseurs,
      classeurs$fichierLocal[classeurs$partie == tableEacr$partie]
    )
    logger::log_info("Lecture de la feuille '{tableEacr$feuille}'")
    dt <- lireFeuilleEacr(classeur, tableEacr$feuille)
    logger::log_info("{nrow(dt)} lignes écrites dans {tableEacr$fichier}")
    # compression = "uncompressed" (et non "zstd") : le décodage zstd suppose
    # une libarrow compilée avec ARROW_WITH_ZSTD, ce qui n'est PAS le cas de
    # l'arrow de la machine de check Debian du CRAN (ni d'un arrow « minimal »
    # côté utilisateur). Un .parquet non compressé se lit sans aucun codec
    # optionnel, donc partout. Le surcoût de taille est absorbé par le gzip du
    # tarball source. NE PAS repasser en "zstd" : ce serait de nouveau illisible
    # sur l'arrow sans zstd de la machine de check du CRAN (rejet de la 0.1.5).
    arrow::write_parquet(
      dt,
      sink = file.path(chemin, tableEacr$fichier),
      compression = "uncompressed"
    )
  }

  fwrite(
    classeurs[, list(
      partie,
      titre,
      url,
      dateTelechargement = format(Sys.Date())
    )],
    file = file.path(chemin, "millesime.csv")
  )
  logger::log_info("Import terminé dans {chemin}")
}