R/struct_hospit.R

In INESSS-QC/polymed1: Polymédication

#' Structure Hospit
#'
#' Structure le dataset des hospitalisations pour l'analyse.
#'
#' @param x dataset des hospitalisations.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param adm Nom de la colonne contenant la date d'arrivée.
#' @param dep Nom de la colonne contenant la date de départ.
#' @param ajust Nombre de jours sans hospitalisation entre deux observations. Si ce nombre de jours n'est pas dépassé, on regroupe ces observations.
#'
#' @return data.table. 3 colonnes : `ID`, `Adm` et `Dep`.
#' @import data.table
#' @export
struct_hospit <- function(x, ID, adm, dep, ajust = 0){
  x <- struct_hospit_verifications(x, ID, adm, dep)  # verifications
  x <- struct_hospit_colSelect(x, ID, adm, dep)  # colonnes nécessaires + renommer
  x <- struct_hospit_arrange(x)  # type des colonnes = DATE
  x <- struct_hospit_mergeDates(x, ajust)
  return(x)
}

#' Structure Hospit
#'
#' @param x dataset des hospitalisations.
#' @param ajust Nombre de jours sans hospitalisation entre deux observations. Si ce nombre de jours n'est pas dépassé, on regroupe ces observations.
#'
#' @keywords internal
#' @export
struct_hospit_mergeDates <- function(x, ajust = 0){
  x <- copy(x)
  setorder(x, ID, Adm)
  x[, diff := Adm - shift(Dep) - 1, .(ID)]
  x[is.na(diff), diff := 0]
  x[, period := 0]
  x[diff > ajust, period := 1]
  x[, period := cumsum(period)+1, .(ID)]
  x <- x[
    , .(Adm = min(Adm),
        Dep = max(Dep)),
    .(ID, period)
  ][, period := NULL]
  return(x)
}

#' Vérifications
#'
#' @param x dataset des hospitalisations.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param adm Nom de la colonne contenant la date d'arrivée.
#' @param dep Nom de la colonne contenant la date de départ.
#'
#' @return `x` converti en data.table.
#' @keywords internal
#' @importFrom stringr str_detect
#' @importFrom lubridate is.Date as_date
#' @export
struct_hospit_verifications <- function(x, ID, adm, dep){
  x <- copy(x)
  check <- newArgCheck()
  if(!is.data.frame(x)) addError("x n'est pas de type DATA.FRAME.", check)
  finishArgCheck(check)

  if(!is.data.table(x)) x <- as.data.table(x)

  if(!is.character(ID)) addError("ID n'est pas de type CHR.", check)
  if(!is.character(adm)) addError("adm n'est pas de type CHR.", check)
  if(!is.character(dep)) addError("dep n'est pas de type CHR.", check)
  finishArgCheck(check)
  for(col in c(ID, adm, dep)) if(!col %in% names(x)) addError(paste0(col," n'est pas une colonne de x"), check)
  finishArgCheck(check)
  for(col in c(ID, adm, dep)) if(anyNA(x[[col]])) addError(paste0("La colonne ",col," a des NA."), check)
  for(col in c(adm, dep)){
    if(!(is.character(x[[col]]) | is.Date(x[[col]]))) addError(paste0("La colonne ",col," n'est pas de type CHR ou DATE."), check)
    if(any(!str_detect(x[[col]], "^[1-2][0-9][0-9][0-9]-[0-1][0-9]-[0-3][0-9]$"))) addError(paste0("La colonne ",col," n'est pas de la forme 'AAAA-MM-JJ'."),
                                                                                            check)
  }
  finishArgCheck(check)
  return(x)
}

#' Structure Hospit
#'
#' Sélection des colonne nécessaires et les renomme.
#'
#' Le nom des colonnes résultantes sont `ID`, `Adm`, et `Dep`.
#'
#' @param x dataset des hospitalisations.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param adm Nom de la colonne contenant la date d'arrivée.
#' @param dep Nom de la colonne contenant la date de départ.
#'
#' @keywords internal
#' @export
struct_hospit_colSelect <- function(x, ID, adm, dep){
  x <- copy(x)
  cols <- c(ID, adm, dep)  # colonnes à sélectionner
  x <- x[, ..cols]  # sélection des colonnes
  setnames(x, names(x), c("ID", "Adm", "Dep"))  # renommer les colonnes
  return(x)
}

#' Structure Hospit
#'
#' Convertir les colonnes sous format DATE si nécessaire.
#'
#' @param x dataset créé par `struct_hospit_colSelect()`.
#'
#' @keywords internal
#' @importFrom lubridate is.Date as_date
#' @export
struct_hospit_arrange <- function(x){
  x <- copy(x)
  if(!is.Date(x$Adm)) x[, Adm := as_date(Adm)]  # convertir en format DATE si nécessaire
  if(!is.Date(x$Dep)) x[, Dep := as_date(Dep)]
  return(x)
}