R/struct_cohorte.R

In INESSS-QC/polymed1: Polymédication

#' Structure cohorte
#'
#' Structure le dataset pour l'analyse.
#'
#' @param x dataset de la cohorte
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param sexe Nom de la colonne contenant le sexe de l'individu.
#' @param age Nom de la colonne contenant l'âge de l'individu.
#' @param naiss Nom de la colonne indiquant la date de naissance de format "AAAA-MM-JJ".
#' @param origin Date de référence déterminant l'âge des individus de format "AAAA-MM-JJ".
#'
#' @return data.table. 3 colonnes : `ID`, `Sexe` et `Age`.
#' @import data.table
#' @export
struct_cohorte <- function(x, ID, sexe, age, naiss = NULL, origin = NULL){
  x <- struct_cohorte_verifications(x, ID, sexe, age, naiss, origin)  # vérifications
  x <- struct_cohorte_colSelect(x, ID, sexe, age, naiss)  # sélection des colonnes nécessaires
  x <- struct_cohorte_createAge(x, age, naiss, origin)  # créer age selon date naissance
  return(x)
}

#' Structure cohorte
#'
#' Sélection des colonne nécessaires et les renomme.
#'
#' Le nom des colonnes résultantes sont `ID`, `Sexe`, `Age` ou `Naiss`.
#'
#' @param x dataset de la cohorte
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param sexe Nom de la colonne contenant le sexe de l'individu.
#' @param age Nom de la colonne contenant l'âge de l'individu.
#' @param naiss Nom de la colonne contenant la date de naissance de format "AAAA-MM-JJ".
#'
#' @keywords internal
#' @export
struct_cohorte_colSelect <- function(x, ID, sexe, age, naiss = NULL){
  cols <- c(ID, sexe, age, naiss)  # colonnes à sélectionner
  x <- x[, ..cols]  # sélection des colonnes
  setnames(x, ID, "ID")  # renommer colonne
  if(!is.null(sexe))  # si colonne sexe existe
    setnames(x, sexe, "Sexe")  # renommer colonne
  if(is.null(age)){  # renommer les colonnes
    setnames(x, naiss, "Naiss")  # si on a la date de naissance
  } else {
    setnames(x, age, "Age")  # ou l'âge de l'individu
  }
  return(x)
}

#' Structure cohorte
#'
#' Créer âge à partir de la date de naissance si nécessaire. Convertir Age en INTEGER si nécessaire.
#'
#' @param x dataset de la cohorte
#' @param age Nom de la colonne contenant l'âge de l'individu.
#' @param naiss Nom de la colonne contenant la date de naissance de format "AAAA-MM-JJ".
#' @param origin Date de référence déterminant l'âge des individus de format "AAAA-MM-JJ".
#'
#' @keywords internal
#' @importFrom lubridate is.Date as_date
#' @export
struct_cohorte_createAge <- function(x, age, naiss, origin){
  x <- copy(x)
  if(is.null(age)){
    if(!is.Date(x$Naiss))
      x[, Naiss := as_date(Naiss)]  # convertir la colonne format DATE
    x[, Age := as.integer(floor((as_date(origin) - Naiss) / 365.25))]  # nJours en années
    x[, Naiss := NULL]  # supprimer col
  } else {
    if(!is.integer(x$Age))
      x[, Age := as.integer(Age)]  # convertir en INT
  }
  return(x)
}

#' Vérifications
#'
#' Renvoie des erreurs s'il y en a après les vérifications. Lors des vérifications, `x` est converti en `data.table`.
#'
#' @param x dataset de la cohorte
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param sexe Nom de la colonne contenant le sexe de l'individu.
#' @param age Nom de la colonne contenant l'âge de l'individu.
#' @param naiss Nom de la colonne indiquant la date de naissance de format "AAAA-MM-JJ".
#' @param origin Date de référence déterminant l'âge des individus de format "AAAA-MM-JJ".
#'
#' @return `x` converti en data.table.
#' @keywords internal
#' @importFrom stringr str_detect
#' @importFrom lubridate as_date
#' @export
struct_cohorte_verifications <- function(x, ID, sexe, age, naiss, origin){
  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.null(sexe))
    if(!is.character(sexe))
      addError("sexe n'est pas de type CHR", check)
  if(!is.null(age)){
    if(!is.character(age))
      addError("age n'est pas de type CHR", check)
    if(!is.null(naiss))
      addError("Les variables age et naiss, l'un doit être NULL tandis que l'autre non.", check)
  }
  if(!is.null(naiss)){
    if(!is.character(naiss))
      addError("naiss n'est pas de type CHR", check)
    if(!is.null(age))
      addError("Les variables age et naiss, l'un doit être NULL tandis que l'autre non.", check)
    if(!is.character(origin))
      addError("Si naiss est de type CHR, origin doit l'être également.", check)
  }
  finishArgCheck(check)
  for(col in c(ID, sexe, age, naiss))
    if(!col %in% names(x))
      addError(paste0(col," n'est pas un nom de colonne de x."), check)
  if(!is.null(origin))
    if(is.na(as_date(origin)))
      addError("origin n'est pas de la forme 'AAAA-MM-JJ'.", check)
  finishArgCheck(check)
  if(anyNA(x[[ID]]))
    addError(paste0("La colonne ",ID," contient des NA."), check)
  if(!is.null(sexe))
    if(anyNA(x[[sexe]]))
      addError(paste0("La colonne ",sexe," contient des NA."), check)
  if(!is.null(age))
    if(anyNA(x[[age]]))
      addError(paste0("La colonne ",age," contient des NA."), check)
  if(!is.null(naiss)){
    if(anyNA(as_date(x[[naiss]])))
      addError("x[[naiss]] n'est pas de la forme 'AAAA-MM-JJ'.", check)
    if(anyNA(x[[naiss]]))
      addError(paste0("La colonne ",naiss," contient des NA."), check)
  }
  if(!is.null(sexe))
    if(!is.character(x[[sexe]]))
      addError(paste0("La colonne ",sexe," (sexe) n'est pas de type CHR."), check)
  if(!is.null(age))
    if(!is.numeric(x[[age]]))
      addError(paste0("La colonne ",age," (age) n'est pas de type NUM."), check)
  if(!is.null(naiss))
    if(any(x[[naiss]] > origin))
      addError("Certaines dates de naissance sont plus grandes que origin.", check)
  finishArgCheck(check)

  return(x)
}