R/polysimul1_data.R

In INESSS-QC/polymed1: Polymédication

#' Structure polysimul
#'
#' Structure le dataset d'analyse pour les statistiques descriptives.
#'
#' @param data_Rx Dataset des Rx créé par la fonction `struct_Rx_analyse()`.
#' @param data_cohorte Dataset de la cohorte créé par la fonction `struct_cohorte()`.
#' @param t1 Date de début de la période d'analyse. "AAAA-MM-JJ".
#' @param t2 Date de fin de la période d'analyse. "AAAA-MM-JJ". Peut être `NULL`, prends la valeur de `t1`.
#'
#' @import data.table
#' @importFrom lubridate as_date
#' @export
polysimul1_data <- function(
  data_Rx, data_cohorte = NULL,
  t1, t2 = NULL
){
  t1 <- as_date(t1)  # convertir t1 et t2 en DATE
  if(is.null(t2)) t2 <- t1 else t2 <- as_date(t2)
  x <- copy(data_Rx); rm(data_Rx)
  x <- polysimul1_colsSelect(x)  # sélection colonne pour x
  if(is.null(data_cohorte)){
    y <- data.table(ID = sunique(x$ID))
  } else {
    y <- copy(data_cohorte[, .(ID)]); rm(data_cohorte)
  }
  x <- polysimul1_nRxParJour(x, y, t1, t2)  # nombre de Rx par jour
  return(x)
}

#' Structure data_Rx
#'
#' Sélection des colonnes
#'
#' @keywords internal
#' @export
polysimul1_colsSelect <- function(x){
  x <- copy(x)
  cols <- c("ID", "Rx", "DateServ", "FinServAjust")  # colonnes à sélectionner
  x <- x[, ..cols]  # sélection des colonnes
  return(x)
}
#' Structure data_Rx
#'
#' Indique le nombre de Rx par jour pour chaque individu.
#'
#' @keywords internal
#' @export
polysimul1_nRxParJour <- function(x, y, t1, t2){
  x <- copy(x)
  Rx_par_jour <- data.table(ID = sunique(x$ID))  # tableau où seront ajouté le nombre de Rx par jour
  for(jour in as_date(t1:t2)){  # pour chaque jour de la période d'étude
    dtJour <- x[DateServ <= jour & jour <= FinServAjust, .N, .(ID)]  # tableau à ajouter à Rx_par_jour
    setnames(dtJour, "N", as.character(jour))  # renommer colonne pour la date du jour (date en NUM)
    Rx_par_jour <- merge(Rx_par_jour, dtJour, "ID", all = T)  # ajouter résultats
  }; rm(list = c("x", "dtJour"))  # supprimer variables non utilisées
  if(nrow(y[!ID %in% Rx_par_jour$ID])){
    Rx_par_jour <- rbind(Rx_par_jour, y[!ID %in% Rx_par_jour$ID], fill = TRUE); rm(y)  # ajouter individu manquant (sans consommation de Rx)
  }
  Rx_par_jour <- melt(Rx_par_jour, id.vars = "ID", variable.name = "Jour", value.name = "nRx")  # colonnes en ligne
  setorder(Rx_par_jour, ID, Jour)  # tri
  Rx_par_jour[is.na(nRx), nRx := 0]  # NA = 0 Rx consommé
  Rx_par_jour[, Jour := as_date(as.numeric(as.character(Jour)))]
  return(Rx_par_jour)
}