R/polycumul_data.R

In INESSS-QC/polymed1: Polymédication

#' Structure poly cumulée
#'
#' 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`.
#' @param nPeriod Nombre de période d'analyse à l'intérieur de `t1` et `t2`.
#'
#' @import data.table
#' @export
polycumul_data <- function(data_Rx,
                           data_cohorte=NULL,
                           t1, t2=NULL,
                           nPeriod = 4){
  x <- copy(data_Rx[, .(ID, Rx, DateServ, FinServAjust)]); rm(data_Rx)  # sélection des colonnes
  if(is.null(data_cohorte)){  # s'il n'y a pas de cohorte
    y <- unique(x[, .(ID)])  # devient celle de data_Rx
  } else {  # sinon
    y <- copy(data_cohorte)  # sélection de la cohorte d'étude
    rm(data_cohorte)
  }
  t1 <- as_date(t1)  # convertir en DATE
  if(is.null(t2)) t2 <- t1 else t2 <- as_date(t2)  # convertir en DATE si existe sinon prend la valeur de t1
  nJours_period <- (as.numeric(t2 - t1) + 1) / nPeriod  # nombre de jours par période
  if(nJours_period < 1) stop("Le nombre de périodes est trop élevé par rapport au nombre de jours. Veuillez le diminuer.")
  nJours_period <- ceiling(nJours_period)  # entier supérieur
  x <- x[DateServ <= t2 & FinServAjust >= t1]  # sélection des obs à l'intérieur de la période d'analyse
  x[DateServ < t1, DateServ := t1]  # ajuster la date de service et de fin à la période d'étude
  x[FinServAjust > t2, FinServAjust := t2]
  ### Créer variable début et fin de chaque période
  for(i in seq(0, nPeriod-1)){
    x[, paste0("d",i+1) := t1 + (nJours_period*i)]  # début
    if(i == nPeriod-1) x[, paste0("f",i+1) := FinServAjust] else x[, paste0("f",i+1) := t1 + (nJours_period*(i+1)) - 1]  # fin
  }
  x <- melt(  # transformer les colonnes en ligne
    x,
    measure.vars = list(paste0("d",seq(nPeriod)),
                        paste0("f",seq(nPeriod))),
    value.name = c("debut", "fin")
  )
  x[, Conso := 0]  # s'il n'y a pas de consommation
  x[DateServ <= fin & FinServAjust >= debut, Conso := 1]  # inscrire 1 si l'individu consomme un médicament au moins une journée
  x <- x[, .(ratio_Rx = mean(Conso)), keyby = .(ID, Rx)]  # [0, 1] moyenne des périodes
  x <- x[, .(nRx = sum(ratio_Rx)), .(ID)]  # nombre de médicaments consommés (à partir de la moyenne des périodes)
  if(nrow(y[!ID %in% x$ID, .(ID, nRx = 0)])) x <- rbind(x, y[!ID %in% x$ID, .(ID, nRx = 0)])  # ajouter ceux sans consommation
  setorder(x, ID)  # tri
  return(x)
}