R/ajoute_evolution_valorisation.R

In jomuller/vvs: Analyse des fichiers VisualValoSej

#' Calcul évolution valorisation
#'
#' @description Ajoute l'évolution de la valorisation d'un séjour. En entrée,
#' cette fonction prends en charge une [base::data.frame()] contenant les
#' informations extraites des fichiers VisualValoSej d'une année.
#'
#' @details Cette fonction va calculer l'évolution de la valorisaion d'un séjour
#' donné et, si nécessaire, peut créer des lignes supplémentaires lorsqu'un
#' séjour n'est pas envoyé de manière consécutive jusqu'à M12.
#'
#' @param db Une `data.frame` avec les données de VisualValoSej et au minimum :
#'
#'   * `rss` Le numéro RSS
#'   * `mois_sortie`
#'   * `mois_envoi`
#'   * `mnt_tot_am`
#' @export
#' @import dplyr
#' @import magrittr
#' @md
ajoute_evolution_mnt_tot_am <- function(db) {

  # Vérifier que les colonnes nécessaires soient disponibles
  col_necessaires <- c('rss', 'mois_sortie', 'mois_envoi', 'mnt_tot_am')

  if (!all(col_necessaires %in% names(db)))
    stop("Une ou plusieurs colonnes nécessaires manquante")

  # Recherche de mois manquant successif
  db %<>%
    # Création d'une variablie rss_mois_sortie pour distinguer les différents
    # séjours dont le mois de sortie à changé à cause d'une correction admin
    mutate(rss_mois_sortie = paste(rss, mois_sortie , sep = "-")) %>%
    group_by(rss_mois_sortie) %>%
    arrange(mois_envoi) %>%
    # Ajouter une variable qui indique si l'observation du mois suivant
    # est manquate
    mutate(mois_suivant_manque = mois_suivant_manquant(mois_envoi)) %>%
    ungroup()

  # Créer les mois successifs manquants
  db %<>%
    filter(mois_suivant_manque) %>%
    mutate(
      mois_envoi = mois_envoi + 1,
      mnt_tot_am = 0,
      mois_suivant_manque = NA
    ) %>%
    # Les ajouter à ce qui existe déjà
    bind_rows(db) %>%
    arrange(rss, mois_envoi, mois_sortie)

  # Calculer évolution de la mnt_tot_am
  # merger sur rss_mois_sortie
  db %<>%
    mutate(mois_envoi = mois_envoi + 1) %>%
    rename(mnt_tot_am_mois_precedent = mnt_tot_am) %>%
    select(rss, mois_sortie, mois_envoi, mnt_tot_am_mois_precedent) %>%
    left_join(x = db, by = c("rss", "mois_sortie", "mois_envoi")) %>%
    mutate(
      mnt_tot_am_mois_precedent = replace(mnt_tot_am_mois_precedent, is.na(mnt_tot_am_mois_precedent), 0),
      evolution_mnt_tot_am = mnt_tot_am - mnt_tot_am_mois_precedent
      )

  db %>% select(-rss_mois_sortie, -mnt_tot_am_mois_precedent)
}

#' Recherche si un mois est manquant
#'
#' Helper pour [ajoute_evolution_mnt_tot_amrisation()]
mois_suivant_manquant <- function(mois) {
  mois_suivant <- mois + 1
  !(mois_suivant %in% mois | mois == 12)
}