In INESSSQC/polymedic: Calculs de la polypharmacie
# Options RMarkdown par défaut pour chaque chunk
knitr::opts_chunk$set(echo = FALSE, #afficher code chunk
warning = FALSE, #afficher les avertissements
message = FALSE, #afficher les messages
results = "asis", #Afficher tableau latex
fig.align = "center",
eval = TRUE) #évaluer les chunks
systime <- format(Sys.time(), format = "%y%m%d_%Hh%Mm%Ss")
## Libraries
# Afficher tableau LaTeX
library(kableExtra)
# Manipulation de données - Bases de données
library(data.table); library(dplyr)
# Graphiques
library(ggplot2)
# Excel
library(writexl)
# Autres
library(polymedic)
## R options
# Options
options(scipen = 999) #notation scientifique = FALSE
\definecolor{astral}{RGB}{87,146,204}
\allsectionsfont{\color{astral}}
\tableofcontents
\newpage
# Importation de la BD
BDpoly <- readRDS("V:/GI-Data/_MedPersAg/POLYPHARMACIE/Data/EXTRACTION_POLYPHARMACIE/Ech1.rds")
# Arguments
Td <- "2016-04-01"; Tf <- "2017-03-31"
catage <- c(65,70,75,80,85,90,95,100)
cumulperiod <- 4 # diviser la cumulée en x periodes et en faire la moyenne
cumulpond_class <- 1 # intervalle des classes de cumulé pondéré
cumulpond_maxclass <- NULL
P1 <- 90 #poly continue - t1+P1
P2 <- 90 #poly continue - t2-P2
# Fonctions
# Affichages
# Stats descriptives
print_stats <- function(x) {
dt <- copy(x)
# Format des colonnes
dt <- dt[, c(lapply(.SD[, 1:11], round, digits = 2), .SD[, 12])] # arrondir à 2 decimales
dt <- dt[, c(lapply(.SD[, 1:11], format, nsmall = 2, decimal.mark = ","), .SD[, 12])] # afficher deux décimales
# Affichage du tableau
kable(as.data.frame(dt), "latex", longtable = TRUE, booktabs = TRUE,
align = rep("c", ncol(dt) + 1), row.names = FALSE, linesep = "") %>%
kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données
"hold_position",
"repeat_header"), # répéter le titre
repeat_header_text = "")
}
print_stats_nmed <- function(x) {
dt <- copy(x)
# Format des colonnes
dt <- dt[, c(.SD[,1], lapply(.SD[,2:12], round, digits = 2), .SD[,13])] # arrondir à 2 decimales
dt <- dt[, c(.SD[,1], lapply(.SD[, 2:12], format, nsmall = 2, decimal.mark = ","), .SD[,13])] # afficher deux décimales
# Affichage du tableau
kable(as.data.frame(dt), "latex", longtable = TRUE, booktabs = TRUE,
align = rep("c", ncol(dt) + 1), row.names = FALSE, linesep = "") %>%
kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données
"hold_position",
"repeat_header"), # répéter le titre
repeat_header_text = "")
}
# Distribution des valeurs
print_dist <- function(x) {
dt <- copy(x)
dt <- dt[, c(.SD[, 1:2], lapply(.SD[, 3:4], round, digits = 1))] # arrondir à 2 decimales
dt <- dt[, c(.SD[, 1:2], lapply(.SD[, 3:4], format, nsmall = 1, decimal.mark = ","))] # afficher deux décimales
# Affichage du tableau
dt %>%
mutate_all(linebreak) %>%
kable("latex", longtable = TRUE, booktabs = TRUE, escape = FALSE,
align = c("c", rep("r", ncol(dt) - 1)), row.names = FALSE, linesep = "",
col.names = linebreak(c("Valeur", "Freq", "Pourcentage\n(\\%)", "Cumul\n(\\%)"),
align = "c")) %>%
kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données
"HOLD_position",
"repeat_header"), # repeat header
repeat_header_text = "")
}
# Statistiques descriptive sur simultanée
stats_desc <- function(x) {
stats <- data.table(Moyenne = simul_moy[[x]],
`Écart-type` = simul_sd[[x]],
Min = simul_min[[x]],
P5 = simul_P5[[x]],
P10 = simul_P10[[x]],
Q1 = simul_Q1[[x]],
`Médiane` = simul_med[[x]],
Q3 = simul_Q3[[x]],
P90 = simul_P90[[x]],
P95 = simul_P95[[x]],
Max = simul_max[[x]]) %>%
cbind(nID)
stats
}
Polymédication simultanée
simul <- polysimul(BDpoly, Td, Tf, catage)
l <- "pop_stats"
nID <- simul[[l]][["n"]] #nombre de personnes
nID <- data.table(n = nID)
tab <- c("simul_min", "simul_max", "simul_moy", "simul_med",
"simul_sd", "simul_P5", "simul_P10", "simul_Q1",
"simul_Q3", "simul_P90", "simul_P95")
value <- c("Min", "Max", "Moyenne", "Médiane", "Écart-type", "P5", "P10", "Q1", "Q3", "P90", "P95")
for (i in seq(11)) {
assign(tab[[i]], simul[[l]][[value[[i]]]])
assign(tab[[i]], cbind(get(tab[[i]]), nID))
}
Paramètres d'analyse
- Début :
r Td
- Fin :
r Tf (r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1 jours)
- Échantillon : 10 %
Statistiques descriptives
Moyenne individuel
stats_Moy <- stats_desc("Moyenne")
print_stats(stats_Moy)
Minimum individuel
stats_Min <- stats_desc("Min")
print_stats(stats_Min)
Médiane individuel
stats_Med <- stats_desc("Médiane")
print_stats(stats_Med)
Maximum individuel
stats_Max <- stats_desc("Max")
print_stats(stats_Max)
\pagebreak
Distribution de l'indicateur
Moyenne
print_dist(simul$dist_values$Moy)
freqtable(simul$dist_values$Moy, "Moyennes") #tableau de fréquence
graphpoints(simul$dist_values$Moy, "Moyennes") #graphique pourcentage cumulé
\pagebreak
Minimum
print_dist(simul$dist_values$Min)
freqtable(simul$dist_values$Min, "Minimums") #tableau de fréquence
graphpoints(simul$dist_values$Min, "Minimums") #graphique pourcentage cumulé
\pagebreak
Médiane
print_dist(simul$dist_values$Med)
freqtable(simul$dist_values$Med, "Médianes") #tableau de fréquence
graphpoints(simul$dist_values$Med, "Médianes") #graphique pourcentage cumulé
\pagebreak
Maximum
print_dist(simul$dist_values$Max)
freqtable(simul$dist_values$Max, "Maximums") #tableau de fréquence
graphpoints(simul$dist_values$Max, "Maximums") #graphique pourcentage cumulé
\pagebreak
Consommation minimale
Nombre de jours qu'un usager consomme au moins X médicaments.
print_stats_nmed(simul$stats_nmed$stats)
\pagebreak
Polymédication cumulée
cumul <- polycumul(BDpoly, Td, Tf, cumulperiod, catage)
Paramètres d'analyse
- Début :
r Td
- Fin :
r Tf (r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1 jours)
- Nombre de périodes :
r cumulperiod
- Échantillon : 10 %
Statistiques descriptives
print_stats(cumul$stats)
Distribution de l'indicateur (arrondi)
print_dist(cumul$dist_max)
freqtable(cumul$dist_max) #tableau de fréquence
graphpoints(cumul$dist_max) #graphique pourcentage cumulé
\pagebreak
Polymédication cumulée pondérée
cumulpond <- polycumulpond(BDpoly, Td, Tf, catage, cumulpond_class, cumulpond_maxclass)
Paramètres d'analyse
- Début :
r Td
- Fin :
r Tf (r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1 jours)
- Échantillon : 10 %
Statistiques descriptives
print_stats(cumulpond$stats)
Distribution de l'indicateur (arrondi)
print_dist(cumulpond$dist_max_arrondi)
freqtable(cumulpond$dist_max_arrondi) #tableau de fréquence
graphpoints(cumulpond$dist_max_arrondi) #graphique pourcentage cumulé
\pagebreak
Polymédication continue
conti <- polyconti(BDpoly, Td, Tf, catage, P1, P2)
conti_param <- conti$Parameters
Paramètres d'analyse
- Début :
r Td
- Fin :
r Tf (r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1 jours)
- P1 :
r as.Date(as.numeric(as.Date(Td)) + P1 - 1, "1970-01-01") (r P1 jours)
- P2 :
r as.Date(as.numeric(as.Date(Tf)) - P2 + 1, "1970-01-01") (r P2 jours)
- $\Delta$t :
r conti_param$deltaT jours
- Échantillon : 10 %
Statistiques descriptives
print_stats(conti$stats)
Distribution de l'indicateur
print_dist(conti$dist_max)
freqtable(conti$dist_max) #tableau de fréquence
graphpoints(conti$dist_max) #graphique pourcentage cumulé
\pagebreak
Polymédication continue sans interruption
nointer <- polynointer(BDpoly, Td, Tf, catage)
Paramètres d'analyse
- Début :
r Td
- Fin :
r Tf (r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1 jours)
- Échantillon : 10 %
Statistiques descriptives
print_stats(nointer$stats)
Distribution de l'indicateur
print_dist(nointer$dist_max)
freqtable(nointer$dist_max) #tableau de fréquence
graphpoints(nointer$dist_max) #graphique pourcentage cumulé
\pagebreak
Annexe
Période de grâce
Par défaut, la durée d'une période de grâce est la moitié de la durée du traitement. On retrouve ci-dessous les codes de médicaments qui ont une période de grâce différente de celle-ci.
kable(as.data.frame(pgconstant), "latex", longtable = TRUE, booktabs = TRUE,
align = rep("c", ncol(pgconstant) + 1), row.names = FALSE, linesep = "") %>%
kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données
"hold_position",
"repeat_header"), # répéter le titre
repeat_header_text = "")
write_xlsx(EXCELexport(simul, cumul, cumulpond, conti, nointer), paste0("Analyse_PolyIndicateur_",systime,".xlsx"))
INESSSQC/polymedic documentation built on May 7, 2019, 2:26 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Options RMarkdown par défaut pour chaque chunk knitr::opts_chunk$set(echo = FALSE, #afficher code chunk warning = FALSE, #afficher les avertissements message = FALSE, #afficher les messages results = "asis", #Afficher tableau latex fig.align = "center", eval = TRUE) #évaluer les chunks systime <- format(Sys.time(), format = "%y%m%d_%Hh%Mm%Ss") ## Libraries # Afficher tableau LaTeX library(kableExtra) # Manipulation de données - Bases de données library(data.table); library(dplyr) # Graphiques library(ggplot2) # Excel library(writexl) # Autres library(polymedic) ## R options # Options options(scipen = 999) #notation scientifique = FALSE
\definecolor{astral}{RGB}{87,146,204} \allsectionsfont{\color{astral}}
\tableofcontents \newpage
# Importation de la BD BDpoly <- readRDS("V:/GI-Data/_MedPersAg/POLYPHARMACIE/Data/EXTRACTION_POLYPHARMACIE/Ech1.rds") # Arguments Td <- "2016-04-01"; Tf <- "2017-03-31" catage <- c(65,70,75,80,85,90,95,100) cumulperiod <- 4 # diviser la cumulée en x periodes et en faire la moyenne cumulpond_class <- 1 # intervalle des classes de cumulé pondéré cumulpond_maxclass <- NULL P1 <- 90 #poly continue - t1+P1 P2 <- 90 #poly continue - t2-P2 # Fonctions # Affichages # Stats descriptives print_stats <- function(x) { dt <- copy(x) # Format des colonnes dt <- dt[, c(lapply(.SD[, 1:11], round, digits = 2), .SD[, 12])] # arrondir à 2 decimales dt <- dt[, c(lapply(.SD[, 1:11], format, nsmall = 2, decimal.mark = ","), .SD[, 12])] # afficher deux décimales # Affichage du tableau kable(as.data.frame(dt), "latex", longtable = TRUE, booktabs = TRUE, align = rep("c", ncol(dt) + 1), row.names = FALSE, linesep = "") %>% kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données "hold_position", "repeat_header"), # répéter le titre repeat_header_text = "") } print_stats_nmed <- function(x) { dt <- copy(x) # Format des colonnes dt <- dt[, c(.SD[,1], lapply(.SD[,2:12], round, digits = 2), .SD[,13])] # arrondir à 2 decimales dt <- dt[, c(.SD[,1], lapply(.SD[, 2:12], format, nsmall = 2, decimal.mark = ","), .SD[,13])] # afficher deux décimales # Affichage du tableau kable(as.data.frame(dt), "latex", longtable = TRUE, booktabs = TRUE, align = rep("c", ncol(dt) + 1), row.names = FALSE, linesep = "") %>% kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données "hold_position", "repeat_header"), # répéter le titre repeat_header_text = "") } # Distribution des valeurs print_dist <- function(x) { dt <- copy(x) dt <- dt[, c(.SD[, 1:2], lapply(.SD[, 3:4], round, digits = 1))] # arrondir à 2 decimales dt <- dt[, c(.SD[, 1:2], lapply(.SD[, 3:4], format, nsmall = 1, decimal.mark = ","))] # afficher deux décimales # Affichage du tableau dt %>% mutate_all(linebreak) %>% kable("latex", longtable = TRUE, booktabs = TRUE, escape = FALSE, align = c("c", rep("r", ncol(dt) - 1)), row.names = FALSE, linesep = "", col.names = linebreak(c("Valeur", "Freq", "Pourcentage\n(\\%)", "Cumul\n(\\%)"), align = "c")) %>% kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données "HOLD_position", "repeat_header"), # repeat header repeat_header_text = "") } # Statistiques descriptive sur simultanée stats_desc <- function(x) { stats <- data.table(Moyenne = simul_moy[[x]], `Écart-type` = simul_sd[[x]], Min = simul_min[[x]], P5 = simul_P5[[x]], P10 = simul_P10[[x]], Q1 = simul_Q1[[x]], `Médiane` = simul_med[[x]], Q3 = simul_Q3[[x]], P90 = simul_P90[[x]], P95 = simul_P95[[x]], Max = simul_max[[x]]) %>% cbind(nID) stats }
Polymédication simultanée
simul <- polysimul(BDpoly, Td, Tf, catage) l <- "pop_stats" nID <- simul[[l]][["n"]] #nombre de personnes nID <- data.table(n = nID) tab <- c("simul_min", "simul_max", "simul_moy", "simul_med", "simul_sd", "simul_P5", "simul_P10", "simul_Q1", "simul_Q3", "simul_P90", "simul_P95") value <- c("Min", "Max", "Moyenne", "Médiane", "Écart-type", "P5", "P10", "Q1", "Q3", "P90", "P95") for (i in seq(11)) { assign(tab[[i]], simul[[l]][[value[[i]]]]) assign(tab[[i]], cbind(get(tab[[i]]), nID)) }
Paramètres d'analyse
- Début :
r Td - Fin :
r Tf(r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1jours) - Échantillon : 10 %
Statistiques descriptives
Moyenne individuel
stats_Moy <- stats_desc("Moyenne") print_stats(stats_Moy)
Minimum individuel
stats_Min <- stats_desc("Min") print_stats(stats_Min)
Médiane individuel
stats_Med <- stats_desc("Médiane") print_stats(stats_Med)
Maximum individuel
stats_Max <- stats_desc("Max") print_stats(stats_Max)
\pagebreak
Distribution de l'indicateur
Moyenne
print_dist(simul$dist_values$Moy) freqtable(simul$dist_values$Moy, "Moyennes") #tableau de fréquence graphpoints(simul$dist_values$Moy, "Moyennes") #graphique pourcentage cumulé
\pagebreak
Minimum
print_dist(simul$dist_values$Min) freqtable(simul$dist_values$Min, "Minimums") #tableau de fréquence graphpoints(simul$dist_values$Min, "Minimums") #graphique pourcentage cumulé
\pagebreak
Médiane
print_dist(simul$dist_values$Med) freqtable(simul$dist_values$Med, "Médianes") #tableau de fréquence graphpoints(simul$dist_values$Med, "Médianes") #graphique pourcentage cumulé
\pagebreak
Maximum
print_dist(simul$dist_values$Max) freqtable(simul$dist_values$Max, "Maximums") #tableau de fréquence graphpoints(simul$dist_values$Max, "Maximums") #graphique pourcentage cumulé
\pagebreak
Consommation minimale
Nombre de jours qu'un usager consomme au moins X médicaments.
print_stats_nmed(simul$stats_nmed$stats)
\pagebreak
Polymédication cumulée
cumul <- polycumul(BDpoly, Td, Tf, cumulperiod, catage)
Paramètres d'analyse
- Début :
r Td - Fin :
r Tf(r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1jours) - Nombre de périodes :
r cumulperiod - Échantillon : 10 %
Statistiques descriptives
print_stats(cumul$stats)
Distribution de l'indicateur (arrondi)
print_dist(cumul$dist_max) freqtable(cumul$dist_max) #tableau de fréquence graphpoints(cumul$dist_max) #graphique pourcentage cumulé
\pagebreak
Polymédication cumulée pondérée
cumulpond <- polycumulpond(BDpoly, Td, Tf, catage, cumulpond_class, cumulpond_maxclass)
Paramètres d'analyse
- Début :
r Td - Fin :
r Tf(r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1jours) - Échantillon : 10 %
Statistiques descriptives
print_stats(cumulpond$stats)
Distribution de l'indicateur (arrondi)
print_dist(cumulpond$dist_max_arrondi) freqtable(cumulpond$dist_max_arrondi) #tableau de fréquence graphpoints(cumulpond$dist_max_arrondi) #graphique pourcentage cumulé
\pagebreak
Polymédication continue
conti <- polyconti(BDpoly, Td, Tf, catage, P1, P2) conti_param <- conti$Parameters
Paramètres d'analyse
- Début :
r Td - Fin :
r Tf(r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1jours) - P1 :
r as.Date(as.numeric(as.Date(Td)) + P1 - 1, "1970-01-01")(r P1jours) - P2 :
r as.Date(as.numeric(as.Date(Tf)) - P2 + 1, "1970-01-01")(r P2jours) - $\Delta$t :
r conti_param$deltaTjours - Échantillon : 10 %
Statistiques descriptives
print_stats(conti$stats)
Distribution de l'indicateur
print_dist(conti$dist_max) freqtable(conti$dist_max) #tableau de fréquence graphpoints(conti$dist_max) #graphique pourcentage cumulé
\pagebreak
Polymédication continue sans interruption
nointer <- polynointer(BDpoly, Td, Tf, catage)
Paramètres d'analyse
- Début :
r Td - Fin :
r Tf(r as.numeric(as.Date(Tf)) - as.numeric(as.Date(Td)) + 1jours) - Échantillon : 10 %
Statistiques descriptives
print_stats(nointer$stats)
Distribution de l'indicateur
print_dist(nointer$dist_max) freqtable(nointer$dist_max) #tableau de fréquence graphpoints(nointer$dist_max) #graphique pourcentage cumulé
\pagebreak
Annexe
Période de grâce
Par défaut, la durée d'une période de grâce est la moitié de la durée du traitement. On retrouve ci-dessous les codes de médicaments qui ont une période de grâce différente de celle-ci.
kable(as.data.frame(pgconstant), "latex", longtable = TRUE, booktabs = TRUE, align = rep("c", ncol(pgconstant) + 1), row.names = FALSE, linesep = "") %>% kable_styling(latex_options = c("striped", # tableau ligné pour faciliter lecture données "hold_position", "repeat_header"), # répéter le titre repeat_header_text = "")
write_xlsx(EXCELexport(simul, cumul, cumulpond, conti, nointer), paste0("Analyse_PolyIndicateur_",systime,".xlsx"))
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.