admissibilite1: Admissibilité des individus

#' Importation data d'analyse.
#'
#' Création de la table d'étude à partir d'une ou plusieurs années financières pour déterminer la période d'admissibilité de chaque individu entre les dates de `DebutEtude` et de `FinEtude`.
#'
#' @param database Nom du type d'admissibilité à créer. `prior`, `rpam` ou `rqam`.
#' @param DebutEtude `"AAAA-MM-JJ"`. Date de début de l'étude.
#' @param FinEtude Idem que `DebutEtude`. Peut être `NULL` : prendra la même valeur que `DebutEtude`.
#' @param id_list Facultatif. Vecteur (`integer`) contenant le numéro d'individus en particulier (filtre).
#' @param id_absents Nom de la variable contenant les ID de `id_list` qui seraient absents du dataset d'analyse. S'il y en a au moins un, la variable contenant le ou les ID absents est créé dans le *Global Environment*.
#'
#' @return data.table de 7 variables : ID, SEXE, DDN, DDC, DDsld, DDP, DFP.
#' @importFrom lubridate as_date
#' @export
import_struct <- function (
  database,
  DebutEtude, FinEtude = NULL,
  id_list = NULL,
  id_absents = "id_absents"
) {

  self <- .import_struct_internal()
  DebutEtude <- as_date(DebutEtude)  # Convertir dates etude format DATE
  if (is.null(FinEtude)) {
    FinEtude <- DebutEtude
  } else {
    FinEtude <- as_date(FinEtude)
  }
  self$verif_args(database, DebutEtude, FinEtude, id_list, id_absents)  # verif arguments
  af_import <- self$find_af(DebutEtude, FinEtude)  # c(min, max) des AF à importer
  files2import <- self$verif_dispo(database, af_import)  # verif dispo + noms des fichiers à importer
  dt <- self$import_af(files2import, database)
  dt <- self$dt_arrange(dt, id_list, DebutEtude, FinEtude)
  if (!is.null(id_list)) {  # vérifier si les ID de id_list sont dans dt$ID
    id_not_in_dt <- id_list[!id_list %in% dt$ID]  # ID absents
    if (length(id_not_in_dt)) {
      assign(
        x = id_absents,
        value = id_not_in_dt,
        envir = globalenv()
      )  # créer variable dans le global env
    }
  }
  attr(dt, "dates_etude") <- list(
    Debut = DebutEtude,
    Fin = FinEtude
  )
  return(dt)

}

#' Internal
#' @keywords internal
#' @import data.table
#' @importFrom stringr str_sub str_detect
#' @importFrom crayon yellow green
#' @export
.import_struct_internal <- function () {return(list(

  ### Arguments
  dir_import = function (database) {
    # Répertoire où se situent les bases de données d'analyse
    return(paste0(
      database_dir(),
      toupper(database),"/"
    ))
  },
  ### Vérifications
  verif_args = function (database, DebutEtude, FinEtude, id_list, id_absents) {
    check <- newArgCheck()
    if (!database %in% c("prior", "rpam", "rqam"))
      addError("Valeurs permises de database : {'prior', 'rpam', 'rqam'}.", check)
    if (is.na(as_date(DebutEtude)))
      addError("DebutEtude n'est pas au format 'AAAA-MM-JJ'.", check)
    if (is.na(as_date(FinEtude)))
      addError("FinEtude n'est pas au format 'AAAA-MM-JJ'.", check)
    if (!is.null(id_list) && (!is.vector(id_list) | !is.integer(id_list)))
      addError("id_list n'est pas un vecteur de type integer.", check)
    if (!is.character(id_absents))
      addError("id_absents n'est pas de type character.", check)
    finishArgCheck(check)
  },
  verif_dispo = function (database, af_import) {
    # Vérifie si les années financières nécessaires à la création de l'intervale
    # [DebutEtude, FinEtude] sont disponibles.
    # @return Nom des fichiers à importer
    dir <- .import_struct_internal()$dir_import(database)
    af_dispo <- list.files(dir)
    af_dispo <- af_dispo[
      str_detect(af_dispo, paste0("AF",min(af_import):max(af_import), collapse = "|"))
    ]
    check <- newArgCheck()
    for (af in min(af_import):max(af_import)) {
      if (!length(af_dispo)) {
        addError(paste0(toupper(database)," AF",af," n'est pas disponible."), check)
      } else {
        if (!any(str_detect(af_dispo, paste0("AF",af)))) {
          addError(paste0(toupper(database)," AF",af," n'est pas disponible."), check)
        }
      }
    }
    finishArgCheck(check)
    return(af_dispo)
  },
  ### Fonctions
  find_af = function (DebutEtude, FinEtude) {
    # Déterminer les années financières nécessaires selon les dates d'études
    # @return vecteur de deux éléments (deb, fin)
    deb <- int(str_sub(DebutEtude, 1, 4))
    if (str_sub(DebutEtude, 6, 10) < "04-01")
      deb <- deb - 1L
    fin <- int(str_sub(FinEtude, 1, 4))
    if (str_sub(FinEtude, 6, 10) < "04-01")
      fin <- fin - 1
    return(c(deb, fin))
  },
  import_af = function (files2import, database) {
    # Importer toutes les années financières nécessaires à la période d'étude.
    # Affiche un message indiquant que l'importation est en cours, puis qu'elle est terminée.
    # Même chose s'il y a une restructuration à faire du dataset.
    # @return Data de toutes les années financières importées
    message(yellow("Importation en cours..."))
    t1 <- Sys.time()
    DT <- data.table()  # où stocker les datas importés
    for (file in files2import) {
      dt <- readRDS(paste0(  # import années financière
        .import_struct_internal()$dir_import(database),
        file
      ))
      DT <- rbind(DT, dt)  # ajouté les obs importées
    }
    t2 <- Sys.time()
    rm(dt)
    message(green(paste0(  # indiquer le temps nécessaire pour l'importation
      "Importation terminée (",
      round(difftime(t2, t1), 2)," ",
      attr(difftime(t2, t1), "units"),")"
    )))
    return(DT)
  },
  dt_arrange = function (dt, id_list, DebutEtude, FinEtude) {
    # Regroupe les obs contigues dans le temps pour un même id.
    # Filtre les id si id_list!=NULL
    message(yellow("Structuration des données en cours..."))
    t1 <- Sys.time()
    dt <- copy(dt)
    if (!is.null(id_list))  # filtrer les ID choisi par l'utilisateur
      dt <- dt[ID %in% id_list]
    if (nrow(dt)) {
      setkey(dt, ID, DDP)
      dt[DDP < DebutEtude, DDP := DebutEtude]
      dt[DFP > FinEtude, DFP := FinEtude]
      dt <- dt[DDP <= DFP]
      if (nrow(dt)) {
        idx <- dt[, .I[.N > 1], .(ID)]$V1
        if (length(idx)) {
          dt[idx, diff := int(DDP - shift(DFP)), .(ID)][is.na(diff), diff := 0L]
          dt[, period := 0L][diff > 1, period := 1L]
          dt[, period := cumsum(period) + 1, .(ID)]
          dt <- dt[
            , .(DDP = min(DDP),
                DFP = max(DFP)),
            .(ID, SEXE, DDN, DDC, DDsld, period)
          ][, period := NULL]
        }
        t2 <- Sys.time()
        message(green(paste0(
          "Structure terminée (",
          round(difftime(t2, t1), 2)," ",
          attr(difftime(t2, t1), "units"),")."
        )))
        return(dt)
      } else {
        return(NULL)
      }
    } else {
      return(NULL)
    }
  }

))}