R/polyconti.R

In INESSSQC/polymedic: Calculs de la polypharmacie

#' Polypharmacie Continue
#'
#' La polypharmacie continue vérifie s'il y a eu au moins une consommation dans l'intervalle [\code{t1}, \code{t2}] et une autre dans l'intervalle [\code{t3}, \code{t4}] pour un même médicament. Si c'est le cas, on fait +1 au nombre de médicaments consommés par une même personne.
#'
#' \strong{\code{P1}} et \strong{\code{P2}} servent à créer les intervallent [t1, t1+P1] et [t2-P2, t2] où l'usager doit avoir consommé au moins une fois un médicament dans chacun des intervalle pour que sa consommation soit considérée comme continue.
#'
#' @param x Base de données créée par \code{polyBD()}.
#' @param t1,t2 "AAAA-MM-JJ". Intervalle de temps [t1, t2] servant d'analyse. \code{t2} facultatif.
#' @param catage Borne(s) inférieure(s) des groupes d'âge.
#' @param P1 NUMERIC. Nombre de jours suivant \code{t1}. Voir détails.
#' @param P2 NUMERIC. Nombre de jours précédent \code{t2}. Voir détails.
#'
#' @import dplyr
#' @import data.table
#'
#' @export
polyconti <- function(x, t1, t2,
                      catage = c(60,70,80,90),
                      P1 = 90, P2 = 90){

  ## Noms des colonnes
  # Conserver
  xcols_ <- names(x)
  # Modifier
  names(x)[[1]] <- "BenBanls"
  names(x)[[2]] <- "DIN"
  # Liste des ID
  xID <- unique(x$BenBanls)

  # Convertir t1 et t3 en numeric
  t1 <- as.Date(t1)
  t2 <- as.Date(t2)
  deltaT <- as.numeric(t2 - t1 + 1 - (P1 + P2))
  P1 <- t1 + P1 - 1  # P1 premiers jours
  P2 <- t2 - P2 + 1  # P2 derniers jours
  # BD Age et Sexe
  BDage <- attributes(x)$Naissance
  BDsex <- attributes(x)$Sexe


  # Sélection des observations inclus dans l'interval [t1, t2]
  x <- x[PerDebut <= t2 & PerFinAjust >= t1]

  # Si l'observation se retrouve dans l'interval [t1, t1+P1] ou [t2-P2, t2]
  x[, t1P1 := F][PerDebut <= P1 & PerFinAjust >= t1, t1P1 := T]
  x[, P2t2 := F][PerDebut <= t2 & PerFinAjust >= P2, P2t2 := T]

  # Conserver les groupes d'observations (BenBanls + DIN) qui ont au moins un VRAI dans t1P1 et un VRAI dans P2t2
  idx <- x[, .I[any(t1P1) & any(P2t2)], .(BenBanls, DIN)]$V1 #numero de ligne
  x <- x[idx] #conserver les lignes identifiées dans idx


  # 1 observation par BenBanls + DIN
  x <- unique(x[, .(BenBanls, DIN)])
  # Nombre de médicaments (DIN) par BenBanls
  x <- x[, .(n = .N), .(BenBanls)]



  ## Ajouter les BenBanls manquants - sans consommation
  xID <- xID[!xID %in% x$BenBanls]
  if(length(xID) != 0){
    # Tableau indiquant leur consommation = 0
    xID <- data.table(BenBanls = xID,
                      n = 0L)
    # Fusion des tableaux
    x <- rbind(x, xID)
  }
  # Tri croissant par personne
  setorder(x, BenBanls)
  # Nombre d'usager
  nID <- nrow(x)


  ## Résultat
  # Statistiques
  x[, n := as.double(n)]
  conti_stats <- x[, .(Moyenne = mean(n),
                       `Écart-type` = sd(n),
                       Min = min(n),
                       P5 = quantile(n, 0.05),
                       P10 = quantile(n, 0.10),
                       Q1 = quantile(n, 0.25),
                       `Médiane` = median(n),
                       Q3 = quantile(n, 0.75),
                       P90 = quantile(n, 0.90),
                       P95 = quantile(n, 0.95),
                       Max = max(n),
                       n = nID)]
  # BD d'analyse
  conti_BD <- copy(x)
  names(conti_BD)[[1]] <- xcols_[[1]]

  # Ajout de la date de naissance
  x <- merge(x, unique(BDage),
             by.x = "BenBanls", by.y = xcols_[[1]])
  # Convertir date de naissance en Age (selon la date d'analyse de départ)
  x[
    , Age := as.integer(floor(difftime(t1, DatNais, units = "days") / 365.25))
  ]
  # Inclure tous les âges dans 'catage'
  catage <- c(catage, max(x[, Age]) + 1)
  # Création de la catégorie d'age
  x[
    , `:=` (CatAge = cut(Age, catage, right = FALSE),
            # Supprimer les colonnes non nécessaires
            Age = NULL,
            DatNais = NULL)
  ]
  # Ajout du Sexe
  x <- merge(x, unique(BDsex),
             by.x = "BenBanls", by.y = xcols_[[1]])

  # Statistiques descriptives
  # Par Age et Sexe
  nAS <- x[, .(n = .N), keyby = .(CatAge, Sexe)]  # Nombre d'observation par groupe
  conti_AS <- x[, .(Moyenne = mean(n),
                    `Écart-type` = sd(n),
                    Min = min(n),
                    P5 = quantile(n, 0.05),
                    P10 = quantile(n, 0.10),
                    Q1 = quantile(n, 0.25),
                    `Médiane` = median(n),
                    Q3 = quantile(n, 0.75),
                    P90 = quantile(n, 0.90),
                    P95 = quantile(n, 0.95),
                    Max = max(n)),
                keyby = .(CatAge, Sexe)]
  conti_AS <- merge(conti_AS, nAS)
  # Par Age
  nA <- x[, .(n = .N), keyby = .(CatAge)]  # Nombre d'observation par groupe
  conti_A <- x[, .(Moyenne = mean(n),
                   `Écart-type` = sd(n),
                   Min = min(n),
                   P5 = quantile(n, 0.05),
                   P10 = quantile(n, 0.10),
                   Q1 = quantile(n, 0.25),
                   `Médiane` = median(n),
                   Q3 = quantile(n, 0.75),
                   P90 = quantile(n, 0.90),
                   P95 = quantile(n, 0.95),
                   Max = max(n)),
               keyby = .(CatAge)]
  conti_A <- merge(conti_A, nA)
  # Par Sexe
  nS <- x[, .(n = .N), keyby = .(Sexe)]  # Nombre d'observation par groupe
  conti_S <- x[, .(Moyenne = mean(n),
                   `Écart-type` = sd(n),
                   Min = min(n),
                   P5 = quantile(n, 0.05),
                   P10 = quantile(n, 0.10),
                   Q1 = quantile(n, 0.25),
                   `Médiane` = median(n),
                   Q3 = quantile(n, 0.75),
                   P90 = quantile(n, 0.90),
                   P95 = quantile(n, 0.95),
                   Max = max(n)),
               keyby = .(Sexe)]
  conti_S <- merge(conti_S, nS)


  # Distribution des maximums
  seq_values <- seq(0, max(conti_BD$n)) #toutes les valeurs à afficher -> 0 à valeur max
  dist_max <- conti_BD[, .(Freq = .N), n] #fréquence pour chaque valeur des maximums
  names(dist_max) <- c("Valeur", "Freq")
  if(length(seq_values[!seq_values %in% dist_max$Valeur]) != 0){
    dist_max <- rbind(dist_max, data.table(Valeur = seq_values[!seq_values %in% dist_max$Valeur],
                                           Freq = 0)) #ajouter les valeurs manquante -> Freq = 0
  }
  setorder(dist_max, Valeur) #tri croissant par Max
  dist_max[, Pourcentage := Freq / sum(Freq) * 100]  # pourcentage
  dist_max[, Cumul := cumsum(Pourcentage)] #pourcentage cumulé


  # Liste des résultats
  conti <- list(BD = conti_BD,  # BD d'analyse
                stats = conti_stats,  # Statistiques
                stats_group = list(`CatAge & Sexe` = conti_AS,
                                   CatAge = conti_A,
                                   Sexe = conti_S),
                dist_max = dist_max,  # Distribution des maximums
                Parameters = list(P1 = P1,
                                  P2 = P2,
                                  deltaT = deltaT))

}