R/fct_import_epmsi_1d2rtp.R

Defines functions import_eppsmi_1d2rtp_dir get_valeurs_table import_eppsmi_1d2rtp get_annee_periode get_mois_periode get_periode_titre get_mois_numero

# Importer

#source("dictionnaires.R", encoding = "UTF8")


import_eppsmi_1d2rtp_dir <- function(dir_path) {
  # Lister les fichiers
  files_paths <- dir(path = dir_path, full.names = TRUE)

  # importer toutes les tables depuis chaque fichier
  ltables <- lapply(X = files_paths, FUN = import_eppsmi_1d2rtp)

  # Empiler les tables
  db <- bind_rows(ltables)
  db %<>%
    mutate(
      mois_sortie = ordered(mois_sortie_nom, levels = names(.mois_fr)),
      mois_envois = ordered(mois_envois, levels = .mois_fr, labels = names(.mois_fr)),
      variable = as.factor(variable)
    ) %>%
    select(-mois_sortie_nom) %>%
    # Les mois_sortie NA sont ceux qui aggregent l'information. Inutile (sauf pour vérification)
    filter(!is.na(mois_sortie)) %>%
    as.tibble
}

get_valeurs_table <- function(table_node, periode) {

  df <- html_table(table_node)

  df2 <- df[, 1:2]
  names(df2) <- c("variable", "valeur")

  df2 %>%
    mutate(valeur = gsub(pattern = " ", replacement = "", valeur)) %>%
    mutate(valeur = gsub(pattern = ",", replacement = ".", valeur)) %>%
    mutate(valeur = as.numeric(valeur), mois_sortie_nom = periode)
}

import_eppsmi_1d2rtp <- function(file_path = "epmsi_1d2rtp_8_2016.htm") {
  a <- xml2::read_html(file_path)

  tables_data <- a %>%
    html_nodes("table[class='table']")

  tables_names <- a %>%
    html_nodes("div[class='c m byline']") %>%
    html_text() %>%
    gsub(pattern = "Mois=", replacement = "")

  tables_names <- c("Tout", tables_names)

  tables_importees <- mapply(get_valeurs_table, SIMPLIFY = FALSE, tables_data, tables_names)

  df <- bind_rows(tables_importees)
  df %<>% mutate(
    annee = get_annee_periode(a),
    mois_envois = get_mois_periode(a))

  df
  # df$mois_sortie <- get_mois_numero(df$mois_sortie_nom)
}

get_annee_periode <- function(epmsi_html) {

  get_periode_titre(epmsi_html) %>%
    str_extract(pattern = "\\d{4}") %>%
    as.integer
}

get_mois_periode <- function(epmsi_html) {
  get_periode_titre(epmsi_html) %>%
    str_extract(pattern = "(?<=M)\\d{1,2}") %>%
    as.integer
}

get_periode_titre <- function(epmsi_html) {
  epmsi_html %>%
    html_node("td[class='c systemtitle4']") %>%
    html_text()
}

get_mois_numero <- function(mois_noms, dictionnaire_mois = .mois_fr) {
  i <- which(names(.mois_fr) == mois_noms)
  .mois_fr[i]
}
jomuller/vvs documentation built on May 21, 2019, 2:05 p.m.