R/fct_import_fichier_visualvalo.R

In jomuller/vvs: Analyse des fichiers VisualValoSej

#' Importer un fichier de VisualValoSej
#' @param path Chemin d'accès du fichier VisualValoSej à importer
#' @return Un tibble
#' @import dplyr
#' @export
import_valo <- function(path) {

  # Message pour informer l'utilisateur de l'import en cours.
  # Utile car l'import est long (plusieurs minutes sur ma machine)
  message(sprintf(
    "Fichier en cours d'importation : %s (%.1fMo)",
		basename(path),
    file.size(path) / 10^6
    ))

  # Lire le fichier comme un fichier tabulé
  # Par défaut tout lire comme des caractères
  db <- readr::read_tsv(
    file = path,
    col_types = readr::cols(.default = readr::col_character())
    )

  # Remplacer les . par des NA
  db2 <- db %>%
    mutate_if(is.character, gsub, pattern = "^\\.$", replacement = NA)

  # Changer les types
  db2 %<>%
    mutate_at(vars(starts_with("MNT")), as.numeric)
  db2 %<>%
    mutate_at(vars(starts_with("DATE")), as.Date, format = "%d/%m/%Y")
  db2 %<>%
    mutate_at(vars(starts_with("NB")), as.integer)

  db2 %<>%
    mutate_at(c("PONDER", "GHS50", "GHSMIN", "FLAG_FIDES"), as.integer)

  db2 %<>%
    mutate_at(c("COEFTRANS", "COEFGEO", "TAUX2", "GHSMINAM", "coefp"), as.numeric)

  db2 %<>%
    mutate_at(vars(starts_with("SUPP")), as.integer)

  # Ajout du mois d'envois à partir du nom du fichier
  db2$mois_envoi <- path %>%
    stringr::str_extract(pattern = "(?<=\\d{4}.)\\d{1,2}(?=\\.valo)", string = .) %>%
    as.integer

  # Ajout de l'année d'envois à partir du nom du fichier
  db2$annee_envois <- path %>%
   stringr::str_extract(pattern = "(?<=\\d{4}.)\\d{4}(?=\\.\\d{1,2}\\.)", string = .) %>%
    as.integer

  # Retourner un tibble
  db2
}

#' Importer les données VisuaValoSej d'un dossier
#'
#' @param dir_path Chemin d'accès vers le dossier contenant les fichiers VisualValoSej
#' @return Une tibble avec les données des fichiers VisualValoSej avec en plus une colonne année d'envois et mois d'envois, trié par année d'envois, mois d'envois, date de sortie et date d'entrée.
#' @export
import_dir <- function(dir_path) {

  # Lister les fichiers à importer
  fichiers <- dir(dir_path, pattern = "valo\\.txt$", full.names = TRUE)

  message(length(fichiers), ' fichiers à importer')

  # Lire les fichiers et les concaténer dans une liste
  list_dbs <- lapply(X = fichiers, import_valo)

  # Retourner une tibble
  db <- dplyr::bind_rows(list_dbs)

  # Trier
  db %<>%
    arrange(annee_envois, mois_envoi, DATE_SOR, DATE_ENT)

  message("Fin de l'import. ", nrow(db), " enregistrements importés.")

  db
}

#' Importer et sauvegarder les données 2016
#'
#' Lit les fichiers visual valo, les transforme en tableau et les enregistre en RDS
#' @param dossier_source Chemin d'accès vers le dossier contenant les fichiers VisualValoSej
#' @param fichier_cible Nom du fichier cible. Par défaut, est *import_vss_debut_fin.rds* où *debut* et *fin* sont les envois les plus extrèmes au format annee-mois.
#' @param dossier_cible Dossier où le RDS doit être enregistré
#' @return Le chemin vers le fichier RDS de manière invisible
#' @export
import_save_vvs <- function(dossier_source,
                            fichier_cible = NULL,
                            dossier_cible = 'raw_data') {
  # Importer tous les fichiers sources
  db_vvs <- import_dir(dossier_source)

  # Créer un nom pour le fichier à sauvegarder
  if (is.null(fichier_cible))
    nom_rds <- paste0(
      'import_vvs_',
      range_date(mois = db_vvs$mois_envoi, annee = db_vvs$annee_envois),
      '.rds'
      )

  chemin_rds <- file.path(dossier_cible, nom_rds)

  saveRDS(db_vvs, file = chemin_rds)

  message('La tibble *db_vss* a été enregistrée\n', chemin_rds, '\n')

  invisible(chemin_rds)
}

range_date <- function(mois, annee) {
  mois_char <- gsub(pattern = ' ', replacement = 0, x = format(mois, width = 2))
  x <- paste(annee, mois_char, sep = '-')
  x <- sort(x)
  paste(x[c(1, length(x))], collapse = '_')
}