R/polynointer.R

In INESSSQC/polymedic: Calculs de la polypharmacie

#' Polypharmacie Continue Sans Interruption
#'
#' Vérifie si la personne a consommé sans interruption dans le temps [t1, t2] un médicament. Au final, on indique le nombre de médicaments consommés sans interruption.
#'
#' @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.
#' @param catage Borne(s) inférieure(s) des groupes d'âge.
#'
#' @import dplyr
#' @import data.table
#'
#' @export
polynointer <- function(x, t1, t2, catage = c(60,70,80,90)){

  ## Noms des colonnes
  # Conserver
  xcols_ <- names(x)
  # Modifier noms colonnes
  names(x)[[1]] <- "BenBanls"
  names(x)[[2]] <- "DIN"
  # Liste des ID
  xID <- unique(x$BenBanls)
  # Convertir t1 et t3 en Date
  t1 <- as.Date(t1)
  t2 <- as.Date(t2)
  # 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 <= t1 & t2 <= PerFinAjust]
  # 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]
  # Tableau indiquant leur consommation = 0
  if(length(xID) != 0){
    xID <- data.table(BenBanls = xID,
                      n = 0L)
    # Fusion des tableaux
    x <- rbind(x, xID)
  }
  setorder(x, BenBanls)

  ## Nombre d'usager
  nID <- nrow(x)


  ## Résultats
  # Statistiques
  x[, n := as.double(n)]
  nointer_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
  nointer_BD <- copy(x)
  names(nointer_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
  nointer_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)]
  nointer_AS <- merge(nointer_AS, nAS)
  # Par Age
  nA <- x[, .(n = .N), keyby = .(CatAge)]  # Nombre d'observation par groupe
  nointer_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)]
  nointer_A <- merge(nointer_A, nA)
  # Par Sexe
  nS <- x[, .(n = .N), keyby = .(Sexe)]  # Nombre d'observation par groupe
  nointer_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)]
  nointer_S <- merge(nointer_S, nS)


  # Distribution des maximums
  seq_values <- seq(0, max(nointer_BD$n)) #toutes les valeurs à afficher -> 0 à valeur max
  dist_max <- nointer_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
  nointer <- list(BD = nointer_BD,  # BD d'analyse
                  stats = nointer_stats,  # Statistiques
                  stats_group = list(`CatAge & Sexe` = nointer_AS,
                                     CatAge = nointer_A,
                                     Sexe = nointer_S),
                  dist_max = dist_max)  # Distribution des maximums

}