In INESSSQC/variation: Analyse Coefficient Variation Systématique
# 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")
# time exécution
time_system <- paste0(substr(Sys.time(),3,4),
substr(Sys.time(),6,7),
substr(Sys.time(),9,10),
"_",
substr(Sys.time(),12,13),"h",
substr(Sys.time(),15,16),"m",
substr(Sys.time(),18,19),"s")
## Libraries
# Afficher tableau LaTeX
library(kableExtra)
# Fonctions variations
library(variation)
# Format du texte
library(pander)
# Manipulation données
library(data.table)
library(plyr)
library(dplyr)
library(stringr)
# Sauvegarder les graphiques
library(ggplot2)
## R options
options(scipen = 999, # annuler notation scientifique
kableExtra.latex.load_packages = FALSE # ne pas loader les packages LaTeX - ÉVITER ERREUR
)
source("Arguments.R", local = T, echo = F, encoding = "UTF-8")
# Tous les code.analyse
if(code.analyse == "all"){
code.analyse <- sort(unique(DT[[code]]))
allcodes <- TRUE
} else {
allcodes <- FALSE
}
cvs <- cvs.ref
variable.code <- code
# Supprimer RLS hors analyse
pop <- pop[!(`Niveau géographique` == "RLS"
& `Code du territoire` %in% c(801, 1001, 1701, 1801))]
# Structure de la base de données
BDanal <- BD_CVS(DT, an, id, region, code, descriptif,
age, sexe, indic,
pop, pop.geo, pop.geocode, pop.an, pop.pop,
pop.age, pop.sexe, pop.indic, pop.geo_select,
catage, catage.max, sex.select,
an.analyse, code.analyse)
# Population
pop.region <- BDanal$pop.region[, .(an, geocode, pop, pop.totale)]
pop.totale <- unique(BDanal$pop.region[, .(an, pop.totale)])
region.list <- sort(unique(BDanal$pop.region$geocode))
# Calculs CVS
if(is.null(age)) {col.catage <- NULL} else {col.catage <- "catage"}
if(is.null(sexe)) {col.sexe <- NULL} else {col.sexe <- "sexe"}
if(is.null(indic)) {col.indic <- NULL} else {col.indic <- "indic"}
CVStab <- cvs_val(BDanal, "an", "region", "code", "pop", "obs",
col.sexe, col.catage, col.indic,
cvs, nsim, p100, pctl, alpha0,
min.zone, min.obs, length(an.analyse))
if(nrow(CVStab$result) == 0){
stop("Aucun DRG à analyser après exclusion.")
}
# Ajouter les descriptions des codes si nécessaire
if(is.null(descriptif)){
CVStab$result$descriptif <- ""
CVStab$exclus$descriptif <- ""
} else {
if(nrow(CVStab$result) > 0){
CVStab$result <- merge(CVStab$result, BDanal$code.descriptif, by = "code")
} else {
CVStab$result$descriptif <- ""
}
if(nrow(CVStab$exclus) > 0){
CVStab$exclus <- merge(CVStab$exclus, BDanal$code.descriptif, by = "code")
} else {
CVStab$exclus$descriptif <- ""
}
}
CVStab$result[, Tstd.ind := Tbrute * RTj]
CVStab$result[, Tj.region := obsj / pop / length(an.analyse)]
for(i in cvs){
set(CVStab$result, NULL, paste0("Tj_sup_cvsref",i),
(CVStab$result$obsj + round(CVStab$result[[paste0("gsup_cvs",i)]])) / CVStab$result$pop / length(an.analyse))
set(CVStab$result, NULL, paste0("Tj_inf_cvsref",i),
(CVStab$result$obsj + round(CVStab$result[[paste0("ginf_cvs",i)]])) / CVStab$result$pop / length(an.analyse))
}
# Standardisation directe
pop.std.dir <- as.data.table(pop.reference)
pop.std.dir[, geo := NULL]
pop.std.dir <- pop.std.dir[, catage := cut(age, BDanal$catage, right = FALSE)][!is.na(catage)]
pop.std.dir <- pop.std.dir[, .(n = sum(n)), .(sex, catage)]
tstddir <- copy(BDanal$BD.analyse)
tstddir[, ratio := obs / pop]
tstddir[is.na(pop), pop := 0]
tstddir[is.na(ratio), ratio := 0]
tstddir <- merge(tstddir, pop.std.dir, by.x = c("sexe", "catage"), by.y = c("sex", "catage"))
tstddir[, obs_std := ratio * n]
tstddir[, taux_region_dir := sum(obs_std) / sum(pop.std.dir$n) / length(an.analyse), .(an, code, region)]
tstddir[, taux_prov_dir := sum(obs_std) / (sum(pop.std.dir$n) * as.numeric(nrow(pop.region))), .(an, code)]
tstddir <- unique(tstddir[, .(an, code, region, taux_prov_dir, taux_region_dir)])
attach(CVStab)
Taux <- as.data.table(expand.grid(an = unique(result$an), code = unique(result$code), region = unique(result$region)))
detach(CVStab)
Taux <- merge(Taux, tstddir, all.x = T)
Taux <- as.data.table(rbind.fill(lapply(split(Taux, by = c("an", "code")), function(x){
Tprov <- unique(x$taux_prov_dir)
Tprov <- Tprov[!is.na(Tprov)]
x[is.na(taux_prov_dir), taux_prov_dir := Tprov]
x[is.na(taux_region_dir), taux_region_dir := 0]
x
})))
Taux <- merge(Taux,
CVStab$result %>%
select(an, code, region, Tj.region,
starts_with("Tj_sup_cvsref"),
starts_with("Tj_inf_cvsref")) %>%
as.data.table(),
all.x = T,
by = c("an", "code", "region"))
setnames(Taux, c("taux_prov_dir", "taux_region_dir"), c("Tstd.dir", "Tstd.region"))
# Decriptif
tabdesc <- unique(CVStab$result[, .(code, descriptif)])
CVStab$result <- gain_percentile_norm(CVStab$result, cvs, pctl)
pctl_initial <- pctl
\definecolor{astral}{RGB}{87,146,204}
\allsectionsfont{\color{astral}}
\setcounter{tocdepth}{5}
\includegraphics[width=7cm]{INESSSlogo.jpg}
\begin{center}\begin{Large}
Analyse de Variation Systématique
\end{Large}\end{center}
\vfill
\begin{center}\begin{Huge}
r titre
\end{Huge}\end{center}
\vspace{0.5cm}
\begin{center}\begin{huge}
r ifelse(is.null(soustitre), "", soustitre)
\end{huge}\end{center}
\vfill
Notes de production
- Laboratoire de développement méthodologique.
- Ce rapport a été exécuté par
r ifelse(is.null(utilisateur), toupper(Sys.info()[["user"]]), utilisateur).
- Ce rapport Markdown est réalisé selon la version 1.0.
- L'analyse est réalisée selon la version
r packageDescription("variation")[["Version"]] du package variation.
- La méthodologie est décrite dans le document
r nomDocMetho.
\pagebreak
\tableofcontents
\pagebreak
Arguments de l'analyse
arg <- data.frame(
Variables = c(
# Documentation
"titre",
"soustitre",
"utilisateur",
"nomDocMetho",
# BD d'analyse
"an",
"id",
"region",
"code",
"descriptif",
"age",
"sexe",
"indic",
# Population d'analyse
"pop.geo",
"pop.geocode",
"pop.an",
"pop.pop",
"pop.age",
"pop.sexe",
"pop.indic",
"pop.geo\\_select",
"catage",
"catage.max",
"sex.select",
"pop.ref.loc",
"pop.ref.yr",
# Paramètres d'analyse
"an.analyse",
"code.analyse",
"cvs.ref",
"cvs.norm",
"min.zone",
"min.obs",
"nsim",
"p100",
"pctl",
"nbr.pers",
"ci",
"prec.suff",
"prec.lim",
# Paramètres graphiques
"cvslabel",
"max.ratio",
"save.graph"
),
Valeur = c(
# Documentation
titre,
ifelse(is.null(soustitre), "---", gsub("_","\\\\_", soustitre)),
ifelse(is.null(utilisateur), "---", gsub("_","\\\\_", utilisateur)),
ifelse(is.null(nomDocMetho), "---", gsub("_","\\\\_", nomDocMetho)),
# BD d'analyse
gsub("_","\\\\_",an),
gsub("_","\\\\_",id),
gsub("_","\\\\_",region),
gsub("_","\\\\_",code),
ifelse(is.null(descriptif), "---", gsub("_","\\\\_",descriptif)),
gsub("_","\\\\_",age),
gsub("_","\\\\_",sexe),
ifelse(is.null(indic), "---", indic),
# Population d'analyse
pop.geo,
pop.geocode,
pop.an,
pop.pop,
pop.age,
pop.sexe,
ifelse(is.null(pop.indic), "---", pop.indic),
pop.geo_select,
paste(catage, collapse = "; "),
catage.max,
paste(sex.select, collapse = "; "),
pop.ref.loc,
pop.ref.yr,
# Paramètres d'analyse
paste(sort(an.analyse), collapse = "; "),
ifelse(allcodes, "---", paste(sort(code.analyse[code.analyse %in% DT[[code]]]), collapse = "; ")),
paste(sort(cvs.ref, decreasing = T), collapse = "; "),
cvs.norm,
min.zone,
min.obs,
nsim,
paste(sort(p100, decreasing = T), collapse = "; "),
paste(sort(pctl, decreasing = T), collapse = "; "),
nbr.pers,
ci,
prec.suff,
prec.lim,
# Paramètres graphiques
cvslabel,
max.ratio,
save.graph
),
Description = c(
# Documentation
"Titre de l'analyse.",
"Sous-titre de l'analyse.",
"Nom de l'utilisateur ayant exécuté l'analyse.",
"Nom du document méthodologique.",
# BD d'analyse
"Nom de la colonne indiquant l'année ou la période.",
"Nom de la colonne indiquant l'usager.",
"Nom de la colonne indiquant le code de la zone géographique.",
"Nom de la colonne indiquant le code de regroupement.",
"Facultatif. Nom de la colonne indiquant la description de chaque code de regroupement.",
"Nom de la colonne indiquant l'âge de l'usager.",
"Nom de la colonne indiquant le sexe de l'usager.",
"Nom de la colonne indiquant l'indice social (défavorisation ou autre).",
# Population d'analyse
"Nom de la colonne indiquant le type de zone géographique.",
"Nom de la colonne indiquant le code de la zone géographique.",
"Nom de la colonne indiquant l'année ou la période.",
"Nom de la colonne indiquant la population totale.",
"Nom de la colonne indiquant les âges.",
"Nom de la colonne indiquant les sexes.",
"Facultatif. Nom de la colonne indiquant l'indice social (défavorisation ou autre).",
"Zone géographique à utiliser lors de l'analyse.",
"Bornes inférieures (incluse) des âges.",
"Si TRUE, le dernier nombre est la borne inférieure incluse de la dernière strate et tous les âges supérieur sont inclus dans cette strate. Si FALSE, le dernier nombre est la borne supérieure excluse de la dernière strate.",
"Sélection des sexes : 'M' pour Masculin, 'F' pour Féminin et c('M', 'F') pour les deux.",
"L'endroit associé à la base de données populationnelle utilisée pour la standardisation directe (pays, province, état, etc.).",
"L'année associée à la base de données populationnelle pour la standardisation directe.",
# Paramètres d'analyse
"Années (périodes) à analyser.",
"Codes de regroupement à analyser",
"Valeur(s) du(des) CVS de référence.",
"Valeur du CVS principal de référence.",
"Le minimum de zone géographique requis pour inclure un code de regroupement.",
"Le minimum d'observations requis dans chaque zone géographique pour inclure un code de regroupement, sinon il sera exclu de l'analyse.",
"Nombre de simulations pour le calcul du coefficient de variation (cv) du CVS. Au minimum 5000. 20000 et plus offre une bonne estimation.",
"Pourcentages de réduction et de hausse à utiliser lors du calcul des gains potentiels.",
"Percentiles de réduction et de hausse à utiliser lors du calcul des gains potentiels.",
"Dénominateur du ratio des taux",
"Pourcentage à utiliser pour les intervalles de confiance",
"Pourcentage pour que la précision soit suffisante",
"Pourcentage pour que la précision soit limite. Doit être plus petit ou égal à ce pourcentage, sinon sera insuffisant.",
# Paramètres graphiques
"Indique, dans les graphiques, le code de la zone géographique des valeurs hors norme. On entend par extrême les points qui sont au-dessous ou au-dessus des limites des cvs. Les valeurs possibles sont celles de l'argument cvs, soit la limite.",
"Limiter l'affichage des résultats sur les graphiques en indiquant un $\\hat{\\theta}_{j}$ maximal. Seuls les ratios plus petits ou égaux seront visibles.",
"Sauvegarder les graphiques dans un dossier en tant que fichiers .PNG."
)
)
print(kable(arg, "latex", longtable = T, booktabs = T, escape = F, row.names = F, linesep = "") %>%
kable_styling(latex_options = c("hold_position", "repeat_header"),
position = "center",
repeat_header_text = "") %>%
# group_rows("Documentation", 1, 5) %>%
# group_rows("Base de données d'analyse", 6, 13, hline_before = T) %>%
# group_rows("Population d'analyse", 14, 26, hline_before = T) %>%
# group_rows("Paramètres d'analyse", 27, 39, hline_before = T) %>%
# group_rows("Paramètres graphique", 40, 46, hline_before = T) %>%
column_spec(1, "2.7cm") %>%
column_spec(2, "4.9cm") %>%
column_spec(3, "9.2cm")
)
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
Messages d'erreurs ou d'avertissements de l'analyse
RLS exclus des analyses
Les RLS 1001, 1701 et 1801 sont automatiquement exclus de toutes les analyses, et ce, même s'ils sont présents dans les bases de données d'analyse ou de population.
Codes de regroupement exclus
tab <- copy(CVStab$exclus)
for (yr in an.analyse[1]) {
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 3)
tab_ <- tab[an == yr]
tab_ <- tab_ %>% select(-an) %>% as.data.frame()
if(is.null(descriptif)){
names(tab_) <- "Code"
} else {
names(tab_) <- c("Code", "Dénomination")
}
if(nrow(tab_) > 0) {
cat(paste0("Liste des ",variable.code," exclus, car il n'y a pas au moins ",min.zone," ",region," avec au moins ",min.obs," observations.\\newline\n\n"))
print_exclu(tab_)
} else {
cat(paste0("Pour chaque ",variable.code,", il y a au moins ",min.zone," ",region," avec ",min.obs," observations : Aucune exclusion.\\newline\n\n"))
}
}
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
Définitions et abréviations
$cv$ : Coefficient de variation de l'estimé du $CVS$.\newline
$CVS$: Coefficient de variation systématique (Systematic component of variation - SCV).\newline
$CVS_{réf}$: Coefficient de variation systématique de référence utilisé pour calculer les limites d’un intervalle de confiance à l’intérieur duquel devraient se trouver 95% des taux $RT_{j}$ observés dans les subdivisions géographiques j.\newline
j: Indice représentant la subdivision géographique j.\newline
$O_{j}$: Nombre total d'observations dans la subdivision géographique j.\newline
$nbre$: Abbréviation de nombre \newline
$n_{j}$: Nombre de personnes parmi lesquelles les observations $O_{j}$ ont été comptabilisées dans la subdivision géographiques j.\newline
$N_{obs}$: Nombre total d'observations dans l'ensemble des subdivisions géographiques analysées.\newline
$N$: Nombre total de personnes parmi lesquelles les observations ont été comptabilisées dans l'ensemble des subdivisions géographiques analysées.\newline
Outlier: Subdivision géographique dont le $RT_{j}$ est soit supérieure (Sup) soit inférieure (Inf) à l'intervalle de confiance déterminé selon un CVS de référence ($CVS_{réf}$).\newline
Préc: Code de précision de la valeur estimée du CVS. Les abréviations suivantes sont utilisées pour catégoriser la précision selon trois niveaux:
\vspace{-10pt}
\begin{myindentpar}{0.5cm}
Suffisante (Suff) = le $cv$ est $\leq$ r prettyNum(prec.suff, decimal.mark=",")\% (Aucune restriction à la diffusion publique).\newline
Limite (Lim) = le $cv$ est > r prettyNum(prec.suff, decimal.mark=",")\% mais $\leq$ r prettyNum(prec.lim, decimal.mark=",")\% (Pas d'utilisation mais peut être diffusé à titre informatif sans interprétation).\newline
Insuffisante (Ins) = le $cv$ est > r prettyNum(prec.lim, decimal.mark=",")\% (Aucune utilisation ni diffusion publique).\newline
\end{myindentpar}
QP90/10 : Quotient des valeurs aux 90e et 10e percentiles des taux standardisés estimés dans chacune des subdivisions géographiques j ($T_{Std~ind_{j}}$). Aussi appelé Utility Ratio.(UR)\newline
$RT_{j}$: Ratio des taux standardisés par méthode indirecte; est égale au taux de la subdivision géographique j standardisé à la population de l'ensemble des subdivisions géographiques analysées, divisé par le taux moyen $\bar{T}$ de l'ensemble des subdivisions géographiques analysées.\newline
$\bar{T}$: Taux moyen brut calculé sur l'ensemble des subdivisions géographiques analysées. Les $T_{Std~ind_{j}}$ peuvent être comparés à ce taux moyens puisqu’ils sont standardisés à la même population.\newline
$T_{j}$: Taux brut de la subdivision geographique $j$.\newline
$\bar{T}_{Std~dir}$: Taux moyen standardisé par méthode directe sur l'ensemble des subdivisions géographiques analysées. La population et l'année de référence sont spécifiées en note de bas de tableaux.\newline
$T_{Std~dir_{j}}$: Taux standardisé par méthode directe de la subdivision géographique j. La population et l'année de référence sont spécifiées en note de bas de tableaux.\newline
$T_{Std~ind_{j}}$: Taux standardisé par méthode indirecte de la subdivision géographique j. Correspond au numérateur du ratio de taux standardisés $RT_{j}$.\newline
$\hat{\theta}_{j}$: Estimation de la variation systématique associée à la région j.
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
tab <- CVStab$result[, .(obs = sum(obsj)),
.(an, code, descriptif, CVS, cv, Tbrute, QP9010)]
tab <- merge(tab, unique(tstddir[, .(an, code, region, Tstd = taux_prov_dir)], by = c("an", "code", "Tstd")), by = c("an", "code"))
exclu <- CVStab$exclus
# Précision
tab[, prec := "Ins"][cv <= prec.lim, prec := "Lim"][cv <= prec.suff, prec := "Suff"]
tab <- merge(tab, pop.totale, by = "an")
setorder(tab, an, -CVS)
Coefficients de Variation Systématique (CVS)
# pandoc.header(paste("Tous les", variable.code, "analysés"), level = 2)
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr])
exclu_ <- exclu[an == yr]
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 2)
pandoc.header("Tableau des $CVS$", 3)
# Nombre de regroupement analysés
cat("\\textbf{Nombre de regroupement}\\newline\n")
cat("\\null\\quad Demandés = ", length(code.analyse)); cat("\\newline\n")
cat("\\null\\quad Analysés = ", nrow(tab_)); cat("\\newline\n")
cat("\\null\\quad Exclus = ", length(code.analyse)-nrow(tab_)); cat("\\newline")
if(nrow(exclu_)>0) cat(" (voir le détail à la section 2)")
cat("\n\n")
# Distribution des valeurs de CVS dont la précision est suffisante
cat("\\textbf{Distribution des valeurs de \\textit{CVS}}\\newline\n")
if(nrow(tab_) > 0){
# Max
cat("\\null\\quad\\quad\\quad\\quad Max = ",
formatC(max(tab_$CVS),
format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n")
# Q3
cat("\\null\\quad\\quad\\quad\\quad Q3 = ",
formatC(quantile(tab_$CVS, 0.75),
format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n")
# Median
cat("\\null\\quad\\quad\\quad\\quad Médiane = ",
formatC(median(tab_$CVS),
format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n")
# Q1
cat("\\null\\quad\\quad\\quad\\quad Q1 = ",
formatC(quantile(tab_$CVS, 0.25),
format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n")
# Min
cat("\\null\\quad\\quad\\quad\\quad Min = ",
formatC(min(tab_$CVS),
format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n")
# Affichage tableau
tab_ <- tab_[, .(code, descriptif, CVS, cv, prec, Tbrute, Tstd, QP9010, obs, pop.totale)]
tab_[, `:=` (CVS = formatC(CVS, format = "f", big.mark = " ", decimal.mark = ",", digits = 1),
cv = formatC(cv, format = "f", big.mark = " ", decimal.mark = ",", digits = 2),
Tbrute = Tbrute * nbr.pers,
Tstd = Tstd * nbr.pers,
QP9010 = formatC(QP9010, format = "f", big.mark = " ", decimal.mark = ",", digits = 1))]
tab_[, `:=` (Tbrute = sapply(Tbrute, function(x) nsignif(x, 3, decimal.mark = ",")),
Tstd = sapply(Tstd, function(x) nsignif(x, 3, decimal.mark = ",")))]
print_drgCVS(tab_)
# Note définition précisions
cat("\\vspace{-15pt}\n",
"\\begin{footnotesize}\n",
"$^{\\dagger}$ Précision :\n",
"\\vspace{-2pt}\n",
"\\begin{myindentpar}{0.5cm}\n",
"Suff = Suffisante, c.-à-d. que le $cv$ est $\\leq$ ",prettyNum(prec.suff,decimal.mark=","),"\\% (Aucune restriction à la diffusion publique).\\newline\n",
"Lim = Limite, c.-à-d. que le $cv$ est > ",prettyNum(prec.suff,decimal.mark=","),"\\%, mais $\\leq$ ",prettyNum(prec.lim,decimal.mark=","),"\\% (Pas d'utilisation, mais peut être diffusé à titre informatif sans interprétation).\\newline\n",
"Ins = Insuffisante, c.-à-d. que le $cv$ est > ",prettyNum(prec.lim,decimal.mark=","),"\\% (Aucune utilisation ni diffusion publique).\n",
"\\end{myindentpar}\n",
"\\end{footnotesize}\n",
sep = "") #équivalent de paste0()
# Note sur standardisation
cat(paste0("\\begin{footnotesize}$^{\\ddagger}$ Population de référence de la standardisation directe: ",pop.ref.loc," / ",pop.ref.yr,
".\\end{footnotesize}\n\n"))
}
### dotplot_multi
if(nrow(tab_)){
cat("\\pagebreak\n\n")
pandoc.header("Distribution des $\\hat{\\theta}_{j}$", 3)
gg_dotplotmulti(CVStab$result, max.ratio, cvslabel)
i = 1
while(i <= ceiling(length(unique(CVStab$result$code))/5)){
cat("\\includegraphics{dotplot_multi/",i,".png}", sep = "")
cat("\n\n")
i = i + 1
}
}
fin_de_la_section()
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab_)
\pagebreak
Gains potentiels
Hypothèse de normalisation des outliers
pandoc.header(paste0("Réduction des *outliers* supérieurs au(x) $CVS_{réf}$"), level = 3)
cvs <- sort(cvs, T)
tab <- CVStab$result %>% select(an, code, obsj, Tbrute, starts_with("gainsup_cvs")) %>% as.data.table()
tab <- merge(tab, tab[, .(obsjtot = sum(obsj)), .(an, code)], by = c("an", "code"))
tab <- tab %>% select(-obsj) %>% rename(obsj = obsjtot) %>% as.data.table()
tab <- unique(tab)
for(cvsi in cvs) {
tab[[paste0("gainsup_cvs",cvsi)]] <- round(tab[[paste0("gainsup_cvs",cvsi)]])
tab[[paste0("gainsup_cvs",cvsi)]] <-
paste0(tab[[paste0("gainsup_cvs",cvsi)]]," (",format(round(tab[[paste0("gainsup_cvs",cvsi)]]/tab[["obsj"]]*100,1),
nsmall = 1,
decimal.mark = ","),")")
}
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj))
tab_[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")]
setnames(tab_, c("code", "Tbrute"), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")")))
setnames(tab_, paste0("gainsup_cvs",cvs), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))"))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
print_outliers(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Accroissement des *outliers* inférieurs au(x) $CVS_{réf}$"), level = 3)
cvs <- sort(cvs, T)
tab <- CVStab$result %>% select(an, code, obsj, Tbrute, starts_with("gaininf_cvs")) %>% as.data.table()
tab <- merge(tab, tab[, .(obsjtot = sum(obsj)), .(an, code)], by = c("an", "code"))
tab <- tab %>% select(-obsj) %>% rename(obsj = obsjtot) %>% as.data.table()
tab <- unique(tab)
for(cvsi in cvs) {
tab[[paste0("gaininf_cvs",cvsi)]] <- round(tab[[paste0("gaininf_cvs",cvsi)]])
tab[[paste0("gaininf_cvs",cvsi)]] <-
paste0(tab[[paste0("gaininf_cvs",cvsi)]]," (",format(round(tab[[paste0("gaininf_cvs",cvsi)]]/tab[["obsj"]]*100,1),
nsmall = 1,
decimal.mark = ","),")")
}
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj))
tab_[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")]
setnames(tab_, c("code", "Tbrute"), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")")))
setnames(tab_, paste0("gaininf_cvs",cvs), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))"))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
print_outliers(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
\pagebreak
Hypothèse d'un taux moyen cible avec normalisation selon un $CVS_{réf}$
pandoc.header(paste0("Taux cibles inférieurs au taux moyen"), level = 3)
tab <- copy(CVStab$result)
tab <- unique(tab[, .(Tbrute, obsj = sum(obsj)), keyby = .(an, code)])
for(p100i in p100*100){
tab[[paste0("Tbrute",p100i)]] <- tab[["Tbrute"]] * ((100-p100i)/100) * nbr.pers
tab[[paste0("gain",p100i)]] <- unique(CVStab$result[[paste0("gainsup_p",p100i,"_cvs",cvs.norm)]])
tab[[paste0("Tbrute",p100i)]] <- sapply(tab[[paste0("Tbrute",p100i)]], nsignif, 3, decimal.mark = ",")
tab[[paste0("gain",p100i)]] <- round(tab[[paste0("gain",p100i)]])
tab[[paste0("gain",p100i)]] <- paste0(format(tab[[paste0("gain",p100i)]], big.mark = " "), " (",
format(round(tab[[paste0("gain",p100i)]] / tab[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ",", big.mark = " "),
")")
}
tab[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")]
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj) %>% as.data.table())
setnames(tab_, c("code", "Tbrute",
paste0("Tbrute",p100*100),
paste0("gain",p100*100)),
c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"),
paste0("$\\bar{T}$ -",p100*100,"\\%\n(/",nbr.pers,")"),
rep(paste0("Gain\n(nbre (\\%))"), length(p100))))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "")
print_p100(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Taux cibles supérieurs au taux moyen"), level = 3)
tab <- copy(CVStab$result)
tab <- unique(tab[, .(Tbrute, obsj = sum(obsj)), keyby = .(an, code)])
for(p100i in p100*100){
tab[[paste0("Tbrute",p100i)]] <- tab[["Tbrute"]] * ((100+p100i)/100) * nbr.pers
tab[[paste0("gain",p100i)]] <- unique(CVStab$result[[paste0("gaininf_p",p100i,"_cvs",cvs.norm)]])
tab[[paste0("Tbrute",p100i)]] <- sapply(tab[[paste0("Tbrute",p100i)]], nsignif, 3, decimal.mark = ",")
tab[[paste0("gain",p100i)]] <- round(tab[[paste0("gain",p100i)]])
tab[[paste0("gain",p100i)]] <- paste0(format(tab[[paste0("gain",p100i)]], big.mark = " "), " (",
format(round(tab[[paste0("gain",p100i)]] / tab[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ",", big.mark = " "),
")")
}
tab[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")]
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj) %>% as.data.table())
setnames(tab_, c("code", "Tbrute",
paste0("Tbrute",p100*100),
paste0("gain",p100*100)),
c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"),
paste0("$\\bar{T}$ +",p100*100,"\\%\n(/",nbr.pers,")"),
rep(paste0("Gain\n(nbre (\\%))"), length(p100))))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "")
print_p100(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
\pagebreak
Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ avec normalisation selon un $CVS_{réf}$
pandoc.header(paste0("Percentiles cibles inférieurs à la médiane"), level = 3)
tab <- copy(CVStab$result)
cols <- c("an", "code", "Tbrute", paste0("gainpctl",pctl*100,"_cvs",cvs.norm), "obsj", "pop.totale")
tab <- tab[, ..cols]
tab[, obsj := sum(obsj), .(code)]
tab <- unique(tab, by = names(tab))
for(j in pctl*100){
# arrondir les gains
set(tab, NULL,
paste0("gainpctl",j,"_cvs",cvs.norm),
round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]))
# Tj au xe pctl
set(tab, NULL,
paste0("tjpctl",j),
(tab[["obsj"]] + tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]) / tab[["pop.totale"]] / length(an.analyse))
set(tab, NULL,
paste0("tjpctl",j),
sapply(tab[[paste0("tjpctl",j)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " "))
# ajouter les pourcentages de gains
set(tab, NULL,
paste0("gainpctl",j,"_cvs",cvs.norm),
paste0(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]," (",
format(round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]] / tab[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ","),")"))
}
cols <- c("an", "code", "Tbrute",
as.vector(sapply(pctl*100, function(x) c(paste0("tjpctl",x), paste0("gainpctl",x,"_cvs",cvs.norm)))))
tab <- tab[, ..cols]
tab[, Tbrute := sapply(Tbrute * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")]
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr,]) %>% select(-an) %>% as.data.table()
setnames(tab_, c("code", "Tbrute",
paste0("tjpctl",pctl*100),
paste0("gainpctl",pctl*100,"_cvs",cvs.norm)),
c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"),
paste0(pctl*100,"$^{e}$~perc\ndes $T_{j}$\n(/",nbr.pers,")"),
rep("Gain\n(nbre (\\%))", length(pctl))))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]) set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "")
print_pctl(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Percentiles cibles supérieurs à la médiane"), level = 3)
pctl <- 1 - pctl
tab <- copy(CVStab$result)
cols <- c("an", "code", "Tbrute", paste0("gainpctl",pctl*100,"_cvs",cvs.norm), "obsj", "pop.totale")
tab <- tab[, ..cols]
tab[, obsj := sum(obsj), .(code)]
tab <- unique(tab, by = names(tab))
for(j in pctl*100){
# arrondir les gains
set(tab, NULL,
paste0("gainpctl",j,"_cvs",cvs.norm),
round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]))
# Tj au xe pctl
set(tab, NULL,
paste0("tjpctl",j),
(tab[["obsj"]] + tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]) / tab[["pop.totale"]] / length(an.analyse))
set(tab, NULL,
paste0("tjpctl",j),
sapply(tab[[paste0("tjpctl",j)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " "))
# ajouter les pourcentages de gains
set(tab, NULL,
paste0("gainpctl",j,"_cvs",cvs.norm),
paste0(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]," (",
format(round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]] / tab[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ","),")"))
}
cols <- c("an", "code", "Tbrute",
as.vector(sapply(pctl*100, function(x) c(paste0("tjpctl",x), paste0("gainpctl",x,"_cvs",cvs.norm)))))
tab <- tab[, ..cols]
tab[, Tbrute := sapply(Tbrute * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")]
for(yr in unique(tab$an)) {
tab_ <- copy(tab[an == yr,]) %>% select(-an) %>% as.data.table()
setnames(tab_, c("code", "Tbrute",
paste0("tjpctl",pctl*100),
paste0("gainpctl",pctl*100,"_cvs",cvs.norm)),
c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"),
paste0(pctl*100,"$^{e}$~perc\ndes $T_{j}$\n(/",nbr.pers,")"),
rep("Gain\n(nbre (\\%))", length(pctl))))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "")
print_pctl(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n")
}
rm(tab); rm(tab_)
pctl <- pctl_initial
\pagebreak
Résultats par r variable.code
plotlist <- split(CVStab$result, by = c("an", "code"))
ll <- list()
i <- 1
for(p in plotlist){
if(nrow(p)) ll[[names(plotlist)[i]]] <- p
i <- i + 1
}
plotlist <- lapply(ll, function(x) ggplot_dot(x, cvs, cvslabel, max.ratio))
if(save.graph){
wd <- getwd()
dir <- paste0("Graphiques_",time_system)
dir.create(dir) # création dossier
setwd(paste0(wd,"/",dir))
suppressMessages(
lapply(names(plotlist),
function(x) ggsave(filename = paste0(x,".png"), plot = plotlist[[x]]))
)
}
k <- 1
for(i in 1:length(unique(CVStab$result$code))){
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
tabtaux <- copy(Taux[code == unique(code)[[i]]])
pandoc.header(paste0(variable.code," = ", tabdesc$code[[i]],
ifelse(is.null(descriptif), "", paste0(
" « ",tabdesc$descriptif[[i]]," »"
))),
level = 2)
pandoc.header("Distribution des $\\hat{\\theta}_{j}$", level = 3)
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr])
pop_ <- copy(pop.totale[an == yr])
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
print(plotlist[[k]]); k <- k + 1
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+
warn <- tab_[thetaj > max.ratio, .(region, thetaj)]
warn[, `:=` (region = as.character(region),
thetaj = round(thetaj, 2))]
if(nrow(warn)){
cat(paste0("\\vspace{-15pt}\n",
"\\begin{center}\n",
"\\footnotesize{Ratio des taux ajustés des ",variable.code," qui sont hors échelle et qui ne sont donc pas affichés}\n",
"\\end{center}\n",
"\\vspace{-10pt}\n"))
print_warn(warn)
} else {
cat(paste0("\\vspace{-15pt}\n",
"\\begin{center}\\footnotesize{Tous les ",variable.code," sont affichés}\\end{center}"))
}
cat("\n\n")
cat("\\textbf{Résultats principaux}\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad \\textit{CVS} =", # CVS
formatC(unique(tab_$CVS), decimal.mark = ",", big.mark = " ", digits = 1, format = "f"),
"\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad \\textit{cv} = ", # cv du CVS
formatC(unique(tab_$cv), decimal.mark = ",", big.mark = " ", digits = 2, format = "f"),
" (", ifelse(unique(tab_$cv) <= prec.suff, "Suff", ifelse(unique(tab_$cv) <= prec.lim, "Lim", "Ins")),"$^{\\dagger}$) ",
"\\newline\n", sep = "")
cat("\\null\\quad\\quad\\quad\\quad \\textit{QP90/10} =", # QP9010
formatC(unique(tab_$QP9010), decimal.mark = ",", big.mark = " ", digits = 1, format = "f"),
"\\newline\n")
cat(paste0("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ", # Tbrute
nsignif(unique(tab_$Tbrute)*nbr.pers, 3, decimal.mark = ",")),
"\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}_{Std~dir}$$^{\\ddagger}$ (/",nbr.pers,") = ", # Tstd.dir
nsignif(unique(tab_$Tstd.dir)*nbr.pers, 3, decimal.mark = ","),
"\\newline\n", sep = "")
cat("\\null\\quad\\quad\\quad\\quad $N_{obs}$ =", # Nobs
formatC(sum(tab_$obsj), format = "d", big.mark = " "),
"\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad \\textit{N} =", # N
formatC(unique(pop_$pop.totale), big.mark = " ", format = "d"),
"\\newline\n")
# Note définition précisions
cat("\\vspace{-15pt}\n",
"\\begin{footnotesize}\n",
"$^{\\dagger}$ Précision :\n",
"\\vspace{-2pt}\n",
"\\begin{myindentpar}{0.5cm}\n",
"Suff = Suffisante, c.-à-d. que le $cv$ est $\\leq$ ",prettyNum(prec.suff,decimal.mark=","),"\\% (Aucune restriction à la diffusion publique).\\newline\n",
"Lim = Limite, c.-à-d. que le $cv$ est > ",prettyNum(prec.suff,decimal.mark=","),"\\%, mais $\\leq$ ",prettyNum(prec.lim,decimal.mark=","),"\\% (Pas d'utilisation, mais peut être diffusé à titre informatif sans interprétation).\\newline\n",
"Ins = Insuffisante, c.-à-d. que le $cv$ est > ",prettyNum(prec.lim,decimal.mark=","),"\\% (Aucune utilisation ni diffusion publique).\n",
"\\end{myindentpar}\n",
"\\end{footnotesize}\n",
sep = "") #équivalent de paste0()
# Note sur standardisation
cat(paste0("\\begin{footnotesize}$^{\\ddagger}$ Population de référence de la standardisation directe: ",pop.ref.loc," / ",pop.ref.yr,
".\\end{footnotesize}\n\n"))
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
}
rm(tab); rm(tab_)
# ------------------------------------------------------------------------------------------------- #
# Résultat par zone géographique
pandoc.header(paste("Résultat par", region), level = 3)
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr])
tab_ <- tab_ %>%
select(region, Tstd.region, Tstd.ind, thetaj, obsj, pop, starts_with("ginf_cvs"), starts_with("gsup_cvs")) %>%
as.data.table()
for(cvsi in cvs){
set(tab_, which(tab_[[paste0("ginf_cvs",cvsi)]] == 0 & tab_[[paste0("gsup_cvs",cvsi)]] == 0),
paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "---")
set(tab_, which(tab_[[paste0("ginf_cvs",cvsi)]] != 0),
paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "Inf")
set(tab_, which(tab_[[paste0("gsup_cvs",cvsi)]] != 0),
paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "Sup")
}
tab_ <- tab_ %>% select(region, Tstd.region, Tstd.ind, thetaj, obsj, pop, starts_with("$Outlier^{\\dagger}$\n$CVS_{réf}=$"))
tab_[, `:=` (Tstd.region = Tstd.region * nbr.pers,
Tstd.ind = Tstd.ind * nbr.pers,
region = as.character(region),
thetaj = round(thetaj, 2))]
tab_[, `:=` (Tstd.region = sapply(Tstd.region, nsignif, 3, decimal.mark = ","),
Tstd.ind = sapply(Tstd.ind, nsignif, 3, decimal.mark = ","))]
setnames(tab_, c("region", "Tstd.region", "Tstd.ind", "thetaj", "obsj", "pop"),
c(region, paste0("$T_{Std~dir_{j}}$\n(/",nbr.pers,")"), paste0("$T_{Std~ind_{j}}$\n(/",nbr.pers,")"),
"$\\hat{\\theta}_{j}$", "$O_{j}$", "$n_{j}$"))
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
print_resultzone(tab_)
# Note de bas de tableau
cat("\\vspace{-15pt}\n", #espace entre tableau et note de bas
"\\begin{footnotesize}\n",
"$^{\\dagger}$ Outlier :\n",
"\\vspace{-2pt}\n",
"\\begin{myindentpar}{0.5cm}\n",
"Sup = Supérieur, c.-à-d. que le $\\hat{\\theta}_{j}$ est supérieur à l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\\newline\n",
"Inf = Inférieur, c.-à-d. que le $\\hat{\\theta}_{j}$ est inférieur à l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\\newline\n",
"--- = le $\\hat{\\theta}_{j}$ est à l'intérieur de l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\n",
"\\end{myindentpar}\n",
"\\end{footnotesize}\n",
sep = "")
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
}
rm(tab); rm(tab_)
# ------------------------------------------------------------------------------------------------- #
# Gains par région
pandoc.header(paste("Gain par", region), level = 3)
pandoc.header("Hypothèse de réduction des *outliers* supérieurs au CVS de référence ($CVS_{réf})$", level = 4)
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr]) %>% select(region, obsj, starts_with("gsup_cvs")) %>% as.data.table()
tab_ <- melt(tab_, id.vars = c("region", "obsj"))
setorder(tab_, region)
tab_ <- tab_[, flag := FALSE][tab_[, .I[any(value < -0.5)], .(region)]$V1, flag := TRUE]
tab_ <- tab_[flag == T][, flag:=NULL]
if(nrow(tab_) > 0){ # s'il y a des gains
tab_ <- dcast(tab_, region + obsj ~ variable)
for(cvsi in cvs){
temp <- copy(tab_) %>% select(region, obsj, one_of(paste0("gsup_cvs",cvsi)))
setnames(temp, paste0("gsup_cvs",cvsi), "gain")
temp <- temp[, gain := round(gain)][gain != 0]
temp[, p100 := round(gain / obsj * 100, 1)]
temp[, cvsref := cvsi]
if(cvsi == cvs[[1]]){
tempfinal <- temp
} else {
tempfinal <- rbind(tempfinal, temp)
}
}
setorder(tempfinal, region, -cvsref)
tempfinal[, p100 := format(p100, decimal.mark = ",", nsmall = 1)]
tempfinal[, gain_pourcent := paste0(gain," (",p100,")")]
tempfinal <- dcast(tempfinal, region + obsj ~ cvsref, value.var = "gain_pourcent", fill = "---")
setcolorder(tempfinal, c("region", "obsj", paste(cvs[cvs %in% names(tempfinal)])))
tab_ <- copy(tempfinal) %>% select(-obsj) %>% as.data.table(); rm(tempfinal)
tabtaux_ <- copy(tabtaux[an == yr]) %>%
select(region, Tj.region, starts_with("Tj_sup_cvsref")) %>%
as.data.table()
tabtaux_ <- tabtaux_[, c(.SD[,1], lapply(.SD[,2:ncol(tabtaux_)], function(x) sapply(x * nbr.pers, nsignif, 3, decimal.mark = ",")))]
tab_ <- merge(tab_, tabtaux_, by = "region")
tabfinal <- tab_[, .(region, Tj.region)]
for(cvsi in cvs){
tabfinal <- merge(tabfinal, tabtaux_[, .(region, get(paste0("Tj_sup_cvsref",cvsi)))],
by = "region")
setnames(tabfinal, "V2", paste0("Tj_sup_cvsref",cvsi))
if(exists(paste0(cvsi), tab_)){
tabfinal <- merge(tabfinal, tab_[, .(region, get(paste(cvsi)))])
setnames(tabfinal, "V2", paste0("gain",cvsi))
} else {
temp <- tab_[, .(region)][, paste(cvsi) := "---"]
tabfinal <- merge(tabfinal, temp)
setnames(tabfinal, paste0(cvsi), paste0("gain",cvsi))
}
}
tab_ <- copy(tabfinal); rm(tabfinal)
tab_[, region := as.character(region)]
for(j in cvs){
set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_sup_cvsref",j)]]), paste0("Tj_sup_cvsref",j), "---")
}
setnames(tab_, c("region", "Tj.region",
paste0("Tj_sup_cvsref",cvs),
paste0("gain",cvs)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$T_{j}$ si\n$CVS_{réf}$ = ",cvs,"\n(/",nbr.pers,")"),
paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))")))
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
print_gainzones(tab_)
} else {
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\begin{center} \\textbf{Cette hypothèse n'offre aucun gain pour cette période financière.} \\end{center}")
}
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
}
rm(tab); rm(tab_)
pandoc.header("Hypothèse d'accroissement des *outliers* inférieurs au CVS de référence ($CVS_{réf})$", level = 4)
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr]) %>% select(region, obsj, starts_with("ginf_cvs")) %>% as.data.table()
tab_ <- melt(tab_, id.vars = c("region", "obsj"))
setorder(tab_, region)
tab_ <- tab_[, flag := FALSE][tab_[, .I[any(value > 0.5)], .(region)]$V1, flag := TRUE]
tab_ <- tab_[flag == T][, flag:=NULL]
if(nrow(tab_) > 0){
tab_ <- dcast(tab_, region + obsj ~ variable)
for(cvsi in cvs){
temp <- copy(tab_) %>% select(region, obsj, one_of(paste0("ginf_cvs",cvsi)))
setnames(temp, paste0("ginf_cvs",cvsi), "gain")
temp <- temp[, gain := round(gain)][gain != 0]
temp[, p100 := round(gain / obsj * 100, 1)]
temp[, cvsref := cvsi]
if(cvsi == cvs[[1]]){
tempfinal <- temp
} else {
tempfinal <- rbind(tempfinal, temp)
}
}
setorder(tempfinal, region, -cvsref)
tempfinal[, p100 := format(p100, decimal.mark = ",", nsmall = 1)]
tempfinal[, gain_pourcent := paste0(gain," (",p100,")")]
cvsref <- sort(unique(tempfinal$cvsref), decreasing = T)
tempfinal <- dcast(tempfinal, region + obsj ~ cvsref, value.var = "gain_pourcent", fill = "---")
setcolorder(tempfinal, c("region", "obsj", paste(cvsref)))
tab_ <- copy(tempfinal) %>% select(-obsj) %>% as.data.table(); rm(tempfinal)
tabtaux_ <- copy(tabtaux[an == yr]) %>%
select(region, Tj.region, starts_with("Tj_inf_cvsref")) %>%
as.data.table()
tabtaux_ <- tabtaux_[, c(.SD[,1], lapply(.SD[,2:ncol(tabtaux_)], function(x) sapply(x * nbr.pers, nsignif, 3, decimal.mark = ",")))]
tab_ <- merge(tab_, tabtaux_, by = "region")
tabfinal <- tab_[, .(region, Tj.region)]
for(cvsi in cvs){
tabfinal <- merge(tabfinal, tabtaux_[, .(region, get(paste0("Tj_inf_cvsref",cvsi)))],
by = "region")
setnames(tabfinal, "V2", paste0("Tj_inf_cvsref",cvsi))
if(exists(paste0(cvsi), tab_)){
tabfinal <- merge(tabfinal, tab_[, .(region, get(paste(cvsi)))])
setnames(tabfinal, "V2", paste0("gain",cvsi))
} else {
temp <- tab_[, .(region)][, paste(cvsi) := "---"]
tabfinal <- merge(tabfinal, temp)
setnames(tabfinal, paste0(cvsi), paste0("gain",cvsi))
}
}
tab_ <- copy(tabfinal); rm(tabfinal)
tab_[, region := as.character(region)]
for(j in cvs){
set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_inf_cvsref",j)]]), paste0("Tj_inf_cvsref",j), "---")
}
setnames(tab_, c("region", "Tj.region",
paste0("Tj_inf_cvsref",cvs),
paste0("gain",cvs)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$T_{j}$ si\n$CVS_{réf}$ = ",cvs,"\n(/",nbr.pers,")"),
paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))")))
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
print_gainzones(tab_)
} else {
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\begin{center} \\textbf{Cette hypothèse n'offre aucun gain pour cette période financière.} \\end{center}")
}
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
}
rm(tab); rm(tab_)
#-----------------------------------------------------------------------------------------------#
# Réduction/Accroissement du taux moyen normalisé selon CVS.norm ####
# Réduction
pandoc.header("Hypothèse de réduction du taux moyen avec normalisation selon un $CVS_{réf}$", level = 4)
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr]) %>% select(-an, -code) %>% as.data.table()
Tbrute <- copy(nsignif(unique(tab_$Tbrute) * nbr.pers, 3, decimal.mark = ",", big.mark = " "))
cols <- c("region", "obsj", "pop.totale", "Tj.region")
for(p100i in p100*100) cols <- c(cols, paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm), paste0("gsup_p",p100i,"_cvs",cvs.norm))
tab_ <- tab_[, ..cols]
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\textbf{Cibles}\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ",Tbrute,"\\newline\n",
sep = "")
for(p100i in p100*100) {
Tbrute <- nsignif(sum(tab_[["obsj"]] + round(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]])) / unique(tab_[["pop.totale"]]) * nbr.pers / length(an.analyse),
3, decimal.mark = ",", big.mark = " ")
cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") - ",p100i,"% = ",
Tbrute,"\\newline\n",
sep = "")
}
cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n",
sep = "")
tab_ <- tab_ %>% select(-pop.totale) %>% as.data.table()
tab_[, `:=` (Tj.region = sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = "."),
region = as.character(region))]
for(p100i in p100*100){
tab_[[paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm)]] <-
sapply(tab_[[paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm)]] * nbr.pers,
nsignif, 3, decimal.mark = ",", big.mark = " ")
tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]] <- paste0(
formatC(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]],
format = "f", digits = 0, decimal.mark = ",", big.mark = " "),
" (",
formatC(round(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]]) / tab_[["obsj"]] * 100,
format = "f", digits = 1, decimal.mark = ",", big.mark = " "),
")"
)
}
tab_ <- tab_ %>% select(-obsj) %>% as.data.table()
for(j in p100*100){
set(tab_,
which(tab_[["Tj.region"]] == tab_[[paste0("Tj_sup_region_p",j,"_cvs",cvs.norm)]]),
paste0("Tj_sup_region_p",j,"_cvs",cvs.norm),
"---")
}
setnames(tab_, c("region", "Tj.region",
paste0("Tj_sup_region_p",p100*100,"_cvs",cvs.norm),
paste0("gsup_p",p100*100,"_cvs",cvs.norm)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$T_{j}$ $-",p100*100,"$\\%\n(/",nbr.pers,")"),
paste0("Gain\n$T_{j}$ $-",p100*100,"$\\%\n(nbre (\\%))")))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
print_gainzones_p100(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
}
rm(tab); rm(tab_)
# Accroissement
pandoc.header("Hypothèse d'accroissement du taux moyen avec normalisation selon un $CVS_{réf}$", level = 4)
tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region"))
for(yr in unique(tab$an)){
tab_ <- copy(tab[an == yr]) %>% select(-an, -code) %>% as.data.table()
Tbrute <- copy(nsignif(unique(tab_$Tbrute) * nbr.pers, 3, decimal.mark = ",", big.mark = " "))
cols <- c("region", "obsj", "pop.totale", "Tj.region")
for(p100i in p100*100) cols <- c(cols, paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm), paste0("ginf_p",p100i,"_cvs",cvs.norm))
tab_ <- tab_[, ..cols]
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\textbf{Cibles}\\newline\n")
cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ",Tbrute,"\\newline\n",
sep = "")
for(p100i in p100*100) {
Tbrute <- nsignif(sum(tab_[["obsj"]] + round(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]])) / unique(tab_[["pop.totale"]]) * nbr.pers / length(an.analyse),
3, decimal.mark = ",", big.mark = " ")
cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") + ",p100i,"% = ",
Tbrute,"\\newline\n",
sep = "")
}
cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n",
sep = "")
tab_ <- tab_ %>% select(-pop.totale) %>% as.data.table()
tab_[, `:=` (Tj.region = sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = "."),
region = as.character(region))]
for(p100i in p100*100){
tab_[[paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm)]] <-
sapply(tab_[[paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm)]] * nbr.pers,
nsignif, 3, decimal.mark = ",", big.mark = " ")
tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]] <- paste0(
formatC(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]],
format = "f", digits = 0, decimal.mark = ",", big.mark = " "),
" (",
formatC(round(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]]) / tab_[["obsj"]] * 100,
format = "f", digits = 1, decimal.mark = ",", big.mark = " "),
")"
)
}
tab_ <- tab_ %>% select(-obsj) %>% as.data.table()
for(j in p100*100){
set(tab_,
which(tab_[["Tj.region"]] == tab_[[paste0("Tj_inf_region_p",j,"_cvs",cvs.norm)]]),
paste0("Tj_inf_region_p",j,"_cvs",cvs.norm),
"---")
}
setnames(tab_, c("region", "Tj.region",
paste0("Tj_inf_region_p",p100*100,"_cvs",cvs.norm),
paste0("ginf_p",p100*100,"_cvs",cvs.norm)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$T_{j}$ $+",p100*100,"$\\%\n(/",nbr.pers,")"),
paste0("Gain\n$T_{j}$ $+",p100*100,"$\\%\n(nbre (\\%))")))
for(j in names(tab_)[startsWith(names(tab_), "Gain")]){
set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---")
}
print_gainzones_p100(tab_)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n") }
rm(tab); rm(tab_)
#---------------------------------------------------------------------------------------------#
# Taux au percentile cible ####
# Inférieur à la médiane
pandoc.header("Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ observés (inférieur à la médiane) avec normalisation selon un $CVS_{réf}$",
level = 4)
gains_pctl <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
cols <- c("region", "Tbrute", "Tj.region", "Tstd.ind", "obsj",
paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm),
paste0("gpctl",pctl*100,"_cvs",cvs.norm),
paste0("tcible_pctl",pctl*100,"_cvs",cvs.norm),
paste0("pctl_en_pourcent",pctl*100,"_cvs",cvs.norm))
gains_pctl <- gains_pctl[, ..cols]
Tbrute <- unique(gains_pctl$Tbrute) * nbr.pers
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\textbf{Cibles}\\newline\n")
for(pctli in pctl){
tj.cible <- unique(gains_pctl[[paste0("tcible_pctl",pctli*100,"_cvs",cvs.norm)]]) * nbr.pers
tj_pourcent <- unique(gains_pctl[[paste0("pctl_en_pourcent",pctli*100,"_cvs",cvs.norm)]]) * 100
cat("\\null\\quad\\quad\\quad\\quad ",
"Déplacement du $\\bar{T}$ (",nsignif(Tbrute, 3, decimal.mark = ",", big.mark = " "),"/",nbr.pers,") ",
"au $",pctli*100,"^{e}$ percentile des $T_{j}$ (/",nbr.pers," (\\%)) = ",
nsignif(tj.cible, 3, decimal.mark = ",", big.mark = " "),
" (",format(round(tj_pourcent,1), decimal.mark = ",", big.mark = " ", nsmall = 1),")",
"\\newline\n",
sep = "")
}
cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n\n", sep = "")
for(j in pctl*100){
# arrondir les gains
set(gains_pctl, NULL,
paste0("gpctl",j,"_cvs",cvs.norm),
round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]))
# pourcentage de gains
set(gains_pctl, NULL,
paste0("gpctl",j,"_cvs",cvs.norm),
paste0(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]," (",
format(round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]] / gains_pctl[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ","),")"))
# format tj.region
set(gains_pctl, NULL,
paste0("Tj.region.pctl",j,"_cvs",cvs.norm),
sapply(gains_pctl[[paste0("Tj.region.pctl",j,"_cvs",cvs.norm)]]*nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " "))
}
gains_pctl[, Tj.region := sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")]
cols <- c("region", "Tj.region",
as.vector(sapply(pctl*100, function(x) c(paste0("Tj.region.pctl",x,"_cvs",cvs.norm), paste0("gpctl",x,"_cvs",cvs.norm)))))
gains_pctl <- gains_pctl[, ..cols]
setnames(gains_pctl, c("region", "Tj.region",
paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm),
paste0("gpctl",pctl*100,"_cvs",cvs.norm)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$\\bar{T}_{",pctl*100,"^{e} perc}$\n(/",nbr.pers,")"),
paste0("Gain$_{",pctl*100,"^{e} perc}$\n(nbre (\\%))")))
for(j in names(gains_pctl)[startsWith(names(gains_pctl), "Gain")]) set(gains_pctl, which(substr(gains_pctl[[j]],1,1) == "0" | substr(gains_pctl[[j]],1,2) == "-0"), j, "---")
for(j in names(gains_pctl)[startsWith(names(gains_pctl), "$\\bar{T}_{")]) set(gains_pctl, which(gains_pctl[[j]] == "0,000"), j, "---")
print_gainzones_pctl(gains_pctl)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
rm(gains_pctl)
# Spérieur à la médiane
pandoc.header("Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ observés (supérieur à la médiane) avec normalisation selon un $CVS_{réf}$",
level = 4)
pctl <- 1 - pctl
gains_pctl <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]])
cols <- c("region", "Tbrute", "Tj.region", "Tstd.ind", "obsj",
paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm),
paste0("gpctl",pctl*100,"_cvs",cvs.norm),
paste0("tcible_pctl",pctl*100,"_cvs",cvs.norm),
paste0("pctl_en_pourcent",pctl*100,"_cvs",cvs.norm))
gains_pctl <- gains_pctl[, ..cols]
Tbrute <- unique(gains_pctl$Tbrute) * nbr.pers
pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5)
cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+
cat("\\textbf{Cibles}\\newline\n")
for(pctli in pctl){
tj.cible <- unique(gains_pctl[[paste0("tcible_pctl",pctli*100,"_cvs",cvs.norm)]]) * nbr.pers
tj_pourcent <- unique(gains_pctl[[paste0("pctl_en_pourcent",pctli*100,"_cvs",cvs.norm)]]) * 100
cat("\\null\\quad\\quad\\quad\\quad ",
"Déplacement du $\\bar{T}$ (",nsignif(Tbrute, 3, decimal.mark = ",", big.mark = " "),"/",nbr.pers,") ",
"au $",pctli*100,"^{e}$ percentile des $T_{j}$ (/",nbr.pers," (\\%)) = ",
nsignif(tj.cible, 3, decimal.mark = ",", big.mark = " "),
" (",format(round(tj_pourcent,1), decimal.mark = ",", big.mark = " ", nsmall = 1),")",
"\\newline\n",
sep = "")
}
cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n\n", sep = "")
for(j in pctl*100){
# arrondir les gains
set(gains_pctl, NULL,
paste0("gpctl",j,"_cvs",cvs.norm),
round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]))
# pourcentage de gains
set(gains_pctl, NULL,
paste0("gpctl",j,"_cvs",cvs.norm),
paste0(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]," (",
format(round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]] / gains_pctl[["obsj"]] * 100, 1),
nsmall = 1, decimal.mark = ","),")"))
# format tj.region
set(gains_pctl, NULL,
paste0("Tj.region.pctl",j,"_cvs",cvs.norm),
sapply(gains_pctl[[paste0("Tj.region.pctl",j,"_cvs",cvs.norm)]]*nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " "))
}
gains_pctl[, Tj.region := sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")]
cols <- c("region", "Tj.region",
as.vector(sapply(pctl*100, function(x) c(paste0("Tj.region.pctl",x,"_cvs",cvs.norm), paste0("gpctl",x,"_cvs",cvs.norm)))))
gains_pctl <- gains_pctl[, ..cols]
setnames(gains_pctl, c("region", "Tj.region",
paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm),
paste0("gpctl",pctl*100,"_cvs",cvs.norm)),
c(region, paste0("$T_{j}$\n(/",nbr.pers,")"),
paste0("$\\bar{T}_{",pctl*100,"^{e} perc}$\n(/",nbr.pers,")"),
paste0("Gain$_{",pctl*100,"^{e} perc}$\n(nbre (\\%))")))
for(j in names(gains_pctl)[startsWith(names(gains_pctl), "Gain")]) set(gains_pctl, which(substr(gains_pctl[[j]],1,1) == "0" | substr(gains_pctl[[j]],1,2) == "-0"), j, "---")
for(j in names(gains_pctl)[startsWith(names(gains_pctl), "$\\bar{T}_{")]) set(gains_pctl, which(gains_pctl[[j]] == "0,000"), j, "---")
print_gainzones_pctl(gains_pctl)
cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}")
cat("\n\\pagebreak\n\n")
rm(gains_pctl)
pctl <- pctl_initial
}
library(writexl)
if(save.result) write_xlsx(CVStab$result, "AnalyseCVS.xlsx")
\vfill
\begin{center}
\Large{Fin du rapport (dernière page)}
\end{center}
\sectionfont{\color{white}}
Fin du rapport (dernière page)
library(inesss)
send_email("guillaume.boucher@inesss.qc.ca", start_time = NULL)
INESSSQC/variation documentation built on July 3, 2019, 11:33 a.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") # time exécution time_system <- paste0(substr(Sys.time(),3,4), substr(Sys.time(),6,7), substr(Sys.time(),9,10), "_", substr(Sys.time(),12,13),"h", substr(Sys.time(),15,16),"m", substr(Sys.time(),18,19),"s") ## Libraries # Afficher tableau LaTeX library(kableExtra) # Fonctions variations library(variation) # Format du texte library(pander) # Manipulation données library(data.table) library(plyr) library(dplyr) library(stringr) # Sauvegarder les graphiques library(ggplot2) ## R options options(scipen = 999, # annuler notation scientifique kableExtra.latex.load_packages = FALSE # ne pas loader les packages LaTeX - ÉVITER ERREUR )
source("Arguments.R", local = T, echo = F, encoding = "UTF-8")
# Tous les code.analyse if(code.analyse == "all"){ code.analyse <- sort(unique(DT[[code]])) allcodes <- TRUE } else { allcodes <- FALSE } cvs <- cvs.ref variable.code <- code # Supprimer RLS hors analyse pop <- pop[!(`Niveau géographique` == "RLS" & `Code du territoire` %in% c(801, 1001, 1701, 1801))] # Structure de la base de données BDanal <- BD_CVS(DT, an, id, region, code, descriptif, age, sexe, indic, pop, pop.geo, pop.geocode, pop.an, pop.pop, pop.age, pop.sexe, pop.indic, pop.geo_select, catage, catage.max, sex.select, an.analyse, code.analyse) # Population pop.region <- BDanal$pop.region[, .(an, geocode, pop, pop.totale)] pop.totale <- unique(BDanal$pop.region[, .(an, pop.totale)]) region.list <- sort(unique(BDanal$pop.region$geocode)) # Calculs CVS if(is.null(age)) {col.catage <- NULL} else {col.catage <- "catage"} if(is.null(sexe)) {col.sexe <- NULL} else {col.sexe <- "sexe"} if(is.null(indic)) {col.indic <- NULL} else {col.indic <- "indic"} CVStab <- cvs_val(BDanal, "an", "region", "code", "pop", "obs", col.sexe, col.catage, col.indic, cvs, nsim, p100, pctl, alpha0, min.zone, min.obs, length(an.analyse)) if(nrow(CVStab$result) == 0){ stop("Aucun DRG à analyser après exclusion.") } # Ajouter les descriptions des codes si nécessaire if(is.null(descriptif)){ CVStab$result$descriptif <- "" CVStab$exclus$descriptif <- "" } else { if(nrow(CVStab$result) > 0){ CVStab$result <- merge(CVStab$result, BDanal$code.descriptif, by = "code") } else { CVStab$result$descriptif <- "" } if(nrow(CVStab$exclus) > 0){ CVStab$exclus <- merge(CVStab$exclus, BDanal$code.descriptif, by = "code") } else { CVStab$exclus$descriptif <- "" } } CVStab$result[, Tstd.ind := Tbrute * RTj] CVStab$result[, Tj.region := obsj / pop / length(an.analyse)] for(i in cvs){ set(CVStab$result, NULL, paste0("Tj_sup_cvsref",i), (CVStab$result$obsj + round(CVStab$result[[paste0("gsup_cvs",i)]])) / CVStab$result$pop / length(an.analyse)) set(CVStab$result, NULL, paste0("Tj_inf_cvsref",i), (CVStab$result$obsj + round(CVStab$result[[paste0("ginf_cvs",i)]])) / CVStab$result$pop / length(an.analyse)) } # Standardisation directe pop.std.dir <- as.data.table(pop.reference) pop.std.dir[, geo := NULL] pop.std.dir <- pop.std.dir[, catage := cut(age, BDanal$catage, right = FALSE)][!is.na(catage)] pop.std.dir <- pop.std.dir[, .(n = sum(n)), .(sex, catage)] tstddir <- copy(BDanal$BD.analyse) tstddir[, ratio := obs / pop] tstddir[is.na(pop), pop := 0] tstddir[is.na(ratio), ratio := 0] tstddir <- merge(tstddir, pop.std.dir, by.x = c("sexe", "catage"), by.y = c("sex", "catage")) tstddir[, obs_std := ratio * n] tstddir[, taux_region_dir := sum(obs_std) / sum(pop.std.dir$n) / length(an.analyse), .(an, code, region)] tstddir[, taux_prov_dir := sum(obs_std) / (sum(pop.std.dir$n) * as.numeric(nrow(pop.region))), .(an, code)] tstddir <- unique(tstddir[, .(an, code, region, taux_prov_dir, taux_region_dir)]) attach(CVStab) Taux <- as.data.table(expand.grid(an = unique(result$an), code = unique(result$code), region = unique(result$region))) detach(CVStab) Taux <- merge(Taux, tstddir, all.x = T) Taux <- as.data.table(rbind.fill(lapply(split(Taux, by = c("an", "code")), function(x){ Tprov <- unique(x$taux_prov_dir) Tprov <- Tprov[!is.na(Tprov)] x[is.na(taux_prov_dir), taux_prov_dir := Tprov] x[is.na(taux_region_dir), taux_region_dir := 0] x }))) Taux <- merge(Taux, CVStab$result %>% select(an, code, region, Tj.region, starts_with("Tj_sup_cvsref"), starts_with("Tj_inf_cvsref")) %>% as.data.table(), all.x = T, by = c("an", "code", "region")) setnames(Taux, c("taux_prov_dir", "taux_region_dir"), c("Tstd.dir", "Tstd.region")) # Decriptif tabdesc <- unique(CVStab$result[, .(code, descriptif)]) CVStab$result <- gain_percentile_norm(CVStab$result, cvs, pctl) pctl_initial <- pctl
\definecolor{astral}{RGB}{87,146,204} \allsectionsfont{\color{astral}} \setcounter{tocdepth}{5}
\includegraphics[width=7cm]{INESSSlogo.jpg}
\begin{center}\begin{Large} Analyse de Variation Systématique \end{Large}\end{center}
\vfill
\begin{center}\begin{Huge}
r titre
\end{Huge}\end{center}
\vspace{0.5cm}
\begin{center}\begin{huge}
r ifelse(is.null(soustitre), "", soustitre)
\end{huge}\end{center}
\vfill
Notes de production
- Laboratoire de développement méthodologique.
- Ce rapport a été exécuté par
r ifelse(is.null(utilisateur), toupper(Sys.info()[["user"]]), utilisateur). - Ce rapport Markdown est réalisé selon la version 1.0.
- L'analyse est réalisée selon la version
r packageDescription("variation")[["Version"]]du package variation. - La méthodologie est décrite dans le document
r nomDocMetho.
\pagebreak
\tableofcontents
\pagebreak
Arguments de l'analyse
arg <- data.frame( Variables = c( # Documentation "titre", "soustitre", "utilisateur", "nomDocMetho", # BD d'analyse "an", "id", "region", "code", "descriptif", "age", "sexe", "indic", # Population d'analyse "pop.geo", "pop.geocode", "pop.an", "pop.pop", "pop.age", "pop.sexe", "pop.indic", "pop.geo\\_select", "catage", "catage.max", "sex.select", "pop.ref.loc", "pop.ref.yr", # Paramètres d'analyse "an.analyse", "code.analyse", "cvs.ref", "cvs.norm", "min.zone", "min.obs", "nsim", "p100", "pctl", "nbr.pers", "ci", "prec.suff", "prec.lim", # Paramètres graphiques "cvslabel", "max.ratio", "save.graph" ), Valeur = c( # Documentation titre, ifelse(is.null(soustitre), "---", gsub("_","\\\\_", soustitre)), ifelse(is.null(utilisateur), "---", gsub("_","\\\\_", utilisateur)), ifelse(is.null(nomDocMetho), "---", gsub("_","\\\\_", nomDocMetho)), # BD d'analyse gsub("_","\\\\_",an), gsub("_","\\\\_",id), gsub("_","\\\\_",region), gsub("_","\\\\_",code), ifelse(is.null(descriptif), "---", gsub("_","\\\\_",descriptif)), gsub("_","\\\\_",age), gsub("_","\\\\_",sexe), ifelse(is.null(indic), "---", indic), # Population d'analyse pop.geo, pop.geocode, pop.an, pop.pop, pop.age, pop.sexe, ifelse(is.null(pop.indic), "---", pop.indic), pop.geo_select, paste(catage, collapse = "; "), catage.max, paste(sex.select, collapse = "; "), pop.ref.loc, pop.ref.yr, # Paramètres d'analyse paste(sort(an.analyse), collapse = "; "), ifelse(allcodes, "---", paste(sort(code.analyse[code.analyse %in% DT[[code]]]), collapse = "; ")), paste(sort(cvs.ref, decreasing = T), collapse = "; "), cvs.norm, min.zone, min.obs, nsim, paste(sort(p100, decreasing = T), collapse = "; "), paste(sort(pctl, decreasing = T), collapse = "; "), nbr.pers, ci, prec.suff, prec.lim, # Paramètres graphiques cvslabel, max.ratio, save.graph ), Description = c( # Documentation "Titre de l'analyse.", "Sous-titre de l'analyse.", "Nom de l'utilisateur ayant exécuté l'analyse.", "Nom du document méthodologique.", # BD d'analyse "Nom de la colonne indiquant l'année ou la période.", "Nom de la colonne indiquant l'usager.", "Nom de la colonne indiquant le code de la zone géographique.", "Nom de la colonne indiquant le code de regroupement.", "Facultatif. Nom de la colonne indiquant la description de chaque code de regroupement.", "Nom de la colonne indiquant l'âge de l'usager.", "Nom de la colonne indiquant le sexe de l'usager.", "Nom de la colonne indiquant l'indice social (défavorisation ou autre).", # Population d'analyse "Nom de la colonne indiquant le type de zone géographique.", "Nom de la colonne indiquant le code de la zone géographique.", "Nom de la colonne indiquant l'année ou la période.", "Nom de la colonne indiquant la population totale.", "Nom de la colonne indiquant les âges.", "Nom de la colonne indiquant les sexes.", "Facultatif. Nom de la colonne indiquant l'indice social (défavorisation ou autre).", "Zone géographique à utiliser lors de l'analyse.", "Bornes inférieures (incluse) des âges.", "Si TRUE, le dernier nombre est la borne inférieure incluse de la dernière strate et tous les âges supérieur sont inclus dans cette strate. Si FALSE, le dernier nombre est la borne supérieure excluse de la dernière strate.", "Sélection des sexes : 'M' pour Masculin, 'F' pour Féminin et c('M', 'F') pour les deux.", "L'endroit associé à la base de données populationnelle utilisée pour la standardisation directe (pays, province, état, etc.).", "L'année associée à la base de données populationnelle pour la standardisation directe.", # Paramètres d'analyse "Années (périodes) à analyser.", "Codes de regroupement à analyser", "Valeur(s) du(des) CVS de référence.", "Valeur du CVS principal de référence.", "Le minimum de zone géographique requis pour inclure un code de regroupement.", "Le minimum d'observations requis dans chaque zone géographique pour inclure un code de regroupement, sinon il sera exclu de l'analyse.", "Nombre de simulations pour le calcul du coefficient de variation (cv) du CVS. Au minimum 5000. 20000 et plus offre une bonne estimation.", "Pourcentages de réduction et de hausse à utiliser lors du calcul des gains potentiels.", "Percentiles de réduction et de hausse à utiliser lors du calcul des gains potentiels.", "Dénominateur du ratio des taux", "Pourcentage à utiliser pour les intervalles de confiance", "Pourcentage pour que la précision soit suffisante", "Pourcentage pour que la précision soit limite. Doit être plus petit ou égal à ce pourcentage, sinon sera insuffisant.", # Paramètres graphiques "Indique, dans les graphiques, le code de la zone géographique des valeurs hors norme. On entend par extrême les points qui sont au-dessous ou au-dessus des limites des cvs. Les valeurs possibles sont celles de l'argument cvs, soit la limite.", "Limiter l'affichage des résultats sur les graphiques en indiquant un $\\hat{\\theta}_{j}$ maximal. Seuls les ratios plus petits ou égaux seront visibles.", "Sauvegarder les graphiques dans un dossier en tant que fichiers .PNG." ) ) print(kable(arg, "latex", longtable = T, booktabs = T, escape = F, row.names = F, linesep = "") %>% kable_styling(latex_options = c("hold_position", "repeat_header"), position = "center", repeat_header_text = "") %>% # group_rows("Documentation", 1, 5) %>% # group_rows("Base de données d'analyse", 6, 13, hline_before = T) %>% # group_rows("Population d'analyse", 14, 26, hline_before = T) %>% # group_rows("Paramètres d'analyse", 27, 39, hline_before = T) %>% # group_rows("Paramètres graphique", 40, 46, hline_before = T) %>% column_spec(1, "2.7cm") %>% column_spec(2, "4.9cm") %>% column_spec(3, "9.2cm") )
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
Messages d'erreurs ou d'avertissements de l'analyse
RLS exclus des analyses
Les RLS 1001, 1701 et 1801 sont automatiquement exclus de toutes les analyses, et ce, même s'ils sont présents dans les bases de données d'analyse ou de population.
Codes de regroupement exclus
tab <- copy(CVStab$exclus) for (yr in an.analyse[1]) { pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 3) tab_ <- tab[an == yr] tab_ <- tab_ %>% select(-an) %>% as.data.frame() if(is.null(descriptif)){ names(tab_) <- "Code" } else { names(tab_) <- c("Code", "Dénomination") } if(nrow(tab_) > 0) { cat(paste0("Liste des ",variable.code," exclus, car il n'y a pas au moins ",min.zone," ",region," avec au moins ",min.obs," observations.\\newline\n\n")) print_exclu(tab_) } else { cat(paste0("Pour chaque ",variable.code,", il y a au moins ",min.zone," ",region," avec ",min.obs," observations : Aucune exclusion.\\newline\n\n")) } }
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
Définitions et abréviations
$cv$ : Coefficient de variation de l'estimé du $CVS$.\newline
$CVS$: Coefficient de variation systématique (Systematic component of variation - SCV).\newline
$CVS_{réf}$: Coefficient de variation systématique de référence utilisé pour calculer les limites d’un intervalle de confiance à l’intérieur duquel devraient se trouver 95% des taux $RT_{j}$ observés dans les subdivisions géographiques j.\newline
j: Indice représentant la subdivision géographique j.\newline
$O_{j}$: Nombre total d'observations dans la subdivision géographique j.\newline
$nbre$: Abbréviation de nombre \newline
$n_{j}$: Nombre de personnes parmi lesquelles les observations $O_{j}$ ont été comptabilisées dans la subdivision géographiques j.\newline
$N_{obs}$: Nombre total d'observations dans l'ensemble des subdivisions géographiques analysées.\newline
$N$: Nombre total de personnes parmi lesquelles les observations ont été comptabilisées dans l'ensemble des subdivisions géographiques analysées.\newline
Outlier: Subdivision géographique dont le $RT_{j}$ est soit supérieure (Sup) soit inférieure (Inf) à l'intervalle de confiance déterminé selon un CVS de référence ($CVS_{réf}$).\newline
Préc: Code de précision de la valeur estimée du CVS. Les abréviations suivantes sont utilisées pour catégoriser la précision selon trois niveaux:
\vspace{-10pt}
\begin{myindentpar}{0.5cm}
Suffisante (Suff) = le $cv$ est $\leq$ r prettyNum(prec.suff, decimal.mark=",")\% (Aucune restriction à la diffusion publique).\newline
Limite (Lim) = le $cv$ est > r prettyNum(prec.suff, decimal.mark=",")\% mais $\leq$ r prettyNum(prec.lim, decimal.mark=",")\% (Pas d'utilisation mais peut être diffusé à titre informatif sans interprétation).\newline
Insuffisante (Ins) = le $cv$ est > r prettyNum(prec.lim, decimal.mark=",")\% (Aucune utilisation ni diffusion publique).\newline
\end{myindentpar}
QP90/10 : Quotient des valeurs aux 90e et 10e percentiles des taux standardisés estimés dans chacune des subdivisions géographiques j ($T_{Std~ind_{j}}$). Aussi appelé Utility Ratio.(UR)\newline
$RT_{j}$: Ratio des taux standardisés par méthode indirecte; est égale au taux de la subdivision géographique j standardisé à la population de l'ensemble des subdivisions géographiques analysées, divisé par le taux moyen $\bar{T}$ de l'ensemble des subdivisions géographiques analysées.\newline
$\bar{T}$: Taux moyen brut calculé sur l'ensemble des subdivisions géographiques analysées. Les $T_{Std~ind_{j}}$ peuvent être comparés à ce taux moyens puisqu’ils sont standardisés à la même population.\newline
$T_{j}$: Taux brut de la subdivision geographique $j$.\newline
$\bar{T}_{Std~dir}$: Taux moyen standardisé par méthode directe sur l'ensemble des subdivisions géographiques analysées. La population et l'année de référence sont spécifiées en note de bas de tableaux.\newline
$T_{Std~dir_{j}}$: Taux standardisé par méthode directe de la subdivision géographique j. La population et l'année de référence sont spécifiées en note de bas de tableaux.\newline
$T_{Std~ind_{j}}$: Taux standardisé par méthode indirecte de la subdivision géographique j. Correspond au numérateur du ratio de taux standardisés $RT_{j}$.\newline
$\hat{\theta}_{j}$: Estimation de la variation systématique associée à la région j.
\begin{center}__________Fin de la section__________\end{center}
\pagebreak
tab <- CVStab$result[, .(obs = sum(obsj)), .(an, code, descriptif, CVS, cv, Tbrute, QP9010)] tab <- merge(tab, unique(tstddir[, .(an, code, region, Tstd = taux_prov_dir)], by = c("an", "code", "Tstd")), by = c("an", "code")) exclu <- CVStab$exclus # Précision tab[, prec := "Ins"][cv <= prec.lim, prec := "Lim"][cv <= prec.suff, prec := "Suff"] tab <- merge(tab, pop.totale, by = "an") setorder(tab, an, -CVS)
Coefficients de Variation Systématique (CVS)
# pandoc.header(paste("Tous les", variable.code, "analysés"), level = 2) for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr]) exclu_ <- exclu[an == yr] pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 2) pandoc.header("Tableau des $CVS$", 3) # Nombre de regroupement analysés cat("\\textbf{Nombre de regroupement}\\newline\n") cat("\\null\\quad Demandés = ", length(code.analyse)); cat("\\newline\n") cat("\\null\\quad Analysés = ", nrow(tab_)); cat("\\newline\n") cat("\\null\\quad Exclus = ", length(code.analyse)-nrow(tab_)); cat("\\newline") if(nrow(exclu_)>0) cat(" (voir le détail à la section 2)") cat("\n\n") # Distribution des valeurs de CVS dont la précision est suffisante cat("\\textbf{Distribution des valeurs de \\textit{CVS}}\\newline\n") if(nrow(tab_) > 0){ # Max cat("\\null\\quad\\quad\\quad\\quad Max = ", formatC(max(tab_$CVS), format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n") # Q3 cat("\\null\\quad\\quad\\quad\\quad Q3 = ", formatC(quantile(tab_$CVS, 0.75), format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n") # Median cat("\\null\\quad\\quad\\quad\\quad Médiane = ", formatC(median(tab_$CVS), format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n") # Q1 cat("\\null\\quad\\quad\\quad\\quad Q1 = ", formatC(quantile(tab_$CVS, 0.25), format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n") # Min cat("\\null\\quad\\quad\\quad\\quad Min = ", formatC(min(tab_$CVS), format = "f", big.mark = " ", decimal.mark = ",", digits = 1)); cat("\\newline\n") # Affichage tableau tab_ <- tab_[, .(code, descriptif, CVS, cv, prec, Tbrute, Tstd, QP9010, obs, pop.totale)] tab_[, `:=` (CVS = formatC(CVS, format = "f", big.mark = " ", decimal.mark = ",", digits = 1), cv = formatC(cv, format = "f", big.mark = " ", decimal.mark = ",", digits = 2), Tbrute = Tbrute * nbr.pers, Tstd = Tstd * nbr.pers, QP9010 = formatC(QP9010, format = "f", big.mark = " ", decimal.mark = ",", digits = 1))] tab_[, `:=` (Tbrute = sapply(Tbrute, function(x) nsignif(x, 3, decimal.mark = ",")), Tstd = sapply(Tstd, function(x) nsignif(x, 3, decimal.mark = ",")))] print_drgCVS(tab_) # Note définition précisions cat("\\vspace{-15pt}\n", "\\begin{footnotesize}\n", "$^{\\dagger}$ Précision :\n", "\\vspace{-2pt}\n", "\\begin{myindentpar}{0.5cm}\n", "Suff = Suffisante, c.-à-d. que le $cv$ est $\\leq$ ",prettyNum(prec.suff,decimal.mark=","),"\\% (Aucune restriction à la diffusion publique).\\newline\n", "Lim = Limite, c.-à-d. que le $cv$ est > ",prettyNum(prec.suff,decimal.mark=","),"\\%, mais $\\leq$ ",prettyNum(prec.lim,decimal.mark=","),"\\% (Pas d'utilisation, mais peut être diffusé à titre informatif sans interprétation).\\newline\n", "Ins = Insuffisante, c.-à-d. que le $cv$ est > ",prettyNum(prec.lim,decimal.mark=","),"\\% (Aucune utilisation ni diffusion publique).\n", "\\end{myindentpar}\n", "\\end{footnotesize}\n", sep = "") #équivalent de paste0() # Note sur standardisation cat(paste0("\\begin{footnotesize}$^{\\ddagger}$ Population de référence de la standardisation directe: ",pop.ref.loc," / ",pop.ref.yr, ".\\end{footnotesize}\n\n")) } ### dotplot_multi if(nrow(tab_)){ cat("\\pagebreak\n\n") pandoc.header("Distribution des $\\hat{\\theta}_{j}$", 3) gg_dotplotmulti(CVStab$result, max.ratio, cvslabel) i = 1 while(i <= ceiling(length(unique(CVStab$result$code))/5)){ cat("\\includegraphics{dotplot_multi/",i,".png}", sep = "") cat("\n\n") i = i + 1 } } fin_de_la_section() if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab_)
\pagebreak
Gains potentiels
Hypothèse de normalisation des outliers
pandoc.header(paste0("Réduction des *outliers* supérieurs au(x) $CVS_{réf}$"), level = 3) cvs <- sort(cvs, T) tab <- CVStab$result %>% select(an, code, obsj, Tbrute, starts_with("gainsup_cvs")) %>% as.data.table() tab <- merge(tab, tab[, .(obsjtot = sum(obsj)), .(an, code)], by = c("an", "code")) tab <- tab %>% select(-obsj) %>% rename(obsj = obsjtot) %>% as.data.table() tab <- unique(tab) for(cvsi in cvs) { tab[[paste0("gainsup_cvs",cvsi)]] <- round(tab[[paste0("gainsup_cvs",cvsi)]]) tab[[paste0("gainsup_cvs",cvsi)]] <- paste0(tab[[paste0("gainsup_cvs",cvsi)]]," (",format(round(tab[[paste0("gainsup_cvs",cvsi)]]/tab[["obsj"]]*100,1), nsmall = 1, decimal.mark = ","),")") } for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj)) tab_[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")] setnames(tab_, c("code", "Tbrute"), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"))) setnames(tab_, paste0("gainsup_cvs",cvs), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))")) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ print_outliers(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Accroissement des *outliers* inférieurs au(x) $CVS_{réf}$"), level = 3) cvs <- sort(cvs, T) tab <- CVStab$result %>% select(an, code, obsj, Tbrute, starts_with("gaininf_cvs")) %>% as.data.table() tab <- merge(tab, tab[, .(obsjtot = sum(obsj)), .(an, code)], by = c("an", "code")) tab <- tab %>% select(-obsj) %>% rename(obsj = obsjtot) %>% as.data.table() tab <- unique(tab) for(cvsi in cvs) { tab[[paste0("gaininf_cvs",cvsi)]] <- round(tab[[paste0("gaininf_cvs",cvsi)]]) tab[[paste0("gaininf_cvs",cvsi)]] <- paste0(tab[[paste0("gaininf_cvs",cvsi)]]," (",format(round(tab[[paste0("gaininf_cvs",cvsi)]]/tab[["obsj"]]*100,1), nsmall = 1, decimal.mark = ","),")") } for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj)) tab_[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")] setnames(tab_, c("code", "Tbrute"), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"))) setnames(tab_, paste0("gaininf_cvs",cvs), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))")) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ print_outliers(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_)
\pagebreak
Hypothèse d'un taux moyen cible avec normalisation selon un $CVS_{réf}$
pandoc.header(paste0("Taux cibles inférieurs au taux moyen"), level = 3) tab <- copy(CVStab$result) tab <- unique(tab[, .(Tbrute, obsj = sum(obsj)), keyby = .(an, code)]) for(p100i in p100*100){ tab[[paste0("Tbrute",p100i)]] <- tab[["Tbrute"]] * ((100-p100i)/100) * nbr.pers tab[[paste0("gain",p100i)]] <- unique(CVStab$result[[paste0("gainsup_p",p100i,"_cvs",cvs.norm)]]) tab[[paste0("Tbrute",p100i)]] <- sapply(tab[[paste0("Tbrute",p100i)]], nsignif, 3, decimal.mark = ",") tab[[paste0("gain",p100i)]] <- round(tab[[paste0("gain",p100i)]]) tab[[paste0("gain",p100i)]] <- paste0(format(tab[[paste0("gain",p100i)]], big.mark = " "), " (", format(round(tab[[paste0("gain",p100i)]] / tab[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ",", big.mark = " "), ")") } tab[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")] for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj) %>% as.data.table()) setnames(tab_, c("code", "Tbrute", paste0("Tbrute",p100*100), paste0("gain",p100*100)), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"), paste0("$\\bar{T}$ -",p100*100,"\\%\n(/",nbr.pers,")"), rep(paste0("Gain\n(nbre (\\%))"), length(p100)))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "") print_p100(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Taux cibles supérieurs au taux moyen"), level = 3) tab <- copy(CVStab$result) tab <- unique(tab[, .(Tbrute, obsj = sum(obsj)), keyby = .(an, code)]) for(p100i in p100*100){ tab[[paste0("Tbrute",p100i)]] <- tab[["Tbrute"]] * ((100+p100i)/100) * nbr.pers tab[[paste0("gain",p100i)]] <- unique(CVStab$result[[paste0("gaininf_p",p100i,"_cvs",cvs.norm)]]) tab[[paste0("Tbrute",p100i)]] <- sapply(tab[[paste0("Tbrute",p100i)]], nsignif, 3, decimal.mark = ",") tab[[paste0("gain",p100i)]] <- round(tab[[paste0("gain",p100i)]]) tab[[paste0("gain",p100i)]] <- paste0(format(tab[[paste0("gain",p100i)]], big.mark = " "), " (", format(round(tab[[paste0("gain",p100i)]] / tab[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ",", big.mark = " "), ")") } tab[, Tbrute := Tbrute * nbr.pers][, Tbrute := sapply(Tbrute, nsignif, 3, decimal.mark = ",")] for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr,] %>% select(-an, -obsj) %>% as.data.table()) setnames(tab_, c("code", "Tbrute", paste0("Tbrute",p100*100), paste0("gain",p100*100)), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"), paste0("$\\bar{T}$ +",p100*100,"\\%\n(/",nbr.pers,")"), rep(paste0("Gain\n(nbre (\\%))"), length(p100)))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "") print_p100(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_)
\pagebreak
Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ avec normalisation selon un $CVS_{réf}$
pandoc.header(paste0("Percentiles cibles inférieurs à la médiane"), level = 3) tab <- copy(CVStab$result) cols <- c("an", "code", "Tbrute", paste0("gainpctl",pctl*100,"_cvs",cvs.norm), "obsj", "pop.totale") tab <- tab[, ..cols] tab[, obsj := sum(obsj), .(code)] tab <- unique(tab, by = names(tab)) for(j in pctl*100){ # arrondir les gains set(tab, NULL, paste0("gainpctl",j,"_cvs",cvs.norm), round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]])) # Tj au xe pctl set(tab, NULL, paste0("tjpctl",j), (tab[["obsj"]] + tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]) / tab[["pop.totale"]] / length(an.analyse)) set(tab, NULL, paste0("tjpctl",j), sapply(tab[[paste0("tjpctl",j)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")) # ajouter les pourcentages de gains set(tab, NULL, paste0("gainpctl",j,"_cvs",cvs.norm), paste0(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]," (", format(round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]] / tab[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ","),")")) } cols <- c("an", "code", "Tbrute", as.vector(sapply(pctl*100, function(x) c(paste0("tjpctl",x), paste0("gainpctl",x,"_cvs",cvs.norm))))) tab <- tab[, ..cols] tab[, Tbrute := sapply(Tbrute * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")] for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr,]) %>% select(-an) %>% as.data.table() setnames(tab_, c("code", "Tbrute", paste0("tjpctl",pctl*100), paste0("gainpctl",pctl*100,"_cvs",cvs.norm)), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"), paste0(pctl*100,"$^{e}$~perc\ndes $T_{j}$\n(/",nbr.pers,")"), rep("Gain\n(nbre (\\%))", length(pctl)))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]) set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "") print_pctl(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_)
\pagebreak
pandoc.header(paste0("Percentiles cibles supérieurs à la médiane"), level = 3) pctl <- 1 - pctl tab <- copy(CVStab$result) cols <- c("an", "code", "Tbrute", paste0("gainpctl",pctl*100,"_cvs",cvs.norm), "obsj", "pop.totale") tab <- tab[, ..cols] tab[, obsj := sum(obsj), .(code)] tab <- unique(tab, by = names(tab)) for(j in pctl*100){ # arrondir les gains set(tab, NULL, paste0("gainpctl",j,"_cvs",cvs.norm), round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]])) # Tj au xe pctl set(tab, NULL, paste0("tjpctl",j), (tab[["obsj"]] + tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]) / tab[["pop.totale"]] / length(an.analyse)) set(tab, NULL, paste0("tjpctl",j), sapply(tab[[paste0("tjpctl",j)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")) # ajouter les pourcentages de gains set(tab, NULL, paste0("gainpctl",j,"_cvs",cvs.norm), paste0(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]]," (", format(round(tab[[paste0("gainpctl",j,"_cvs",cvs.norm)]] / tab[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ","),")")) } cols <- c("an", "code", "Tbrute", as.vector(sapply(pctl*100, function(x) c(paste0("tjpctl",x), paste0("gainpctl",x,"_cvs",cvs.norm))))) tab <- tab[, ..cols] tab[, Tbrute := sapply(Tbrute * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")] for(yr in unique(tab$an)) { tab_ <- copy(tab[an == yr,]) %>% select(-an) %>% as.data.table() setnames(tab_, c("code", "Tbrute", paste0("tjpctl",pctl*100), paste0("gainpctl",pctl*100,"_cvs",cvs.norm)), c("Code", paste0("$\\bar{T}$\n(/",nbr.pers,")"), paste0(pctl*100,"$^{e}$~perc\ndes $T_{j}$\n(/",nbr.pers,")"), rep("Gain\n(nbre (\\%))", length(pctl)))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ cat("\\textbf{Normalisé selon $CVS_{réf}$ = ",cvs.norm,"}", sep = "") print_pctl(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") if(yr != unique(tab$an)[[length(unique(tab$an))]]) cat("\n\n\\pagebreak\n") } rm(tab); rm(tab_) pctl <- pctl_initial
\pagebreak
Résultats par r variable.code
plotlist <- split(CVStab$result, by = c("an", "code")) ll <- list() i <- 1 for(p in plotlist){ if(nrow(p)) ll[[names(plotlist)[i]]] <- p i <- i + 1 } plotlist <- lapply(ll, function(x) ggplot_dot(x, cvs, cvslabel, max.ratio)) if(save.graph){ wd <- getwd() dir <- paste0("Graphiques_",time_system) dir.create(dir) # création dossier setwd(paste0(wd,"/",dir)) suppressMessages( lapply(names(plotlist), function(x) ggsave(filename = paste0(x,".png"), plot = plotlist[[x]])) ) } k <- 1 for(i in 1:length(unique(CVStab$result$code))){ tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) tabtaux <- copy(Taux[code == unique(code)[[i]]]) pandoc.header(paste0(variable.code," = ", tabdesc$code[[i]], ifelse(is.null(descriptif), "", paste0( " « ",tabdesc$descriptif[[i]]," »" ))), level = 2) pandoc.header("Distribution des $\\hat{\\theta}_{j}$", level = 3) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) pop_ <- copy(pop.totale[an == yr]) pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ print(plotlist[[k]]); k <- k + 1 cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les header lvl 4+ warn <- tab_[thetaj > max.ratio, .(region, thetaj)] warn[, `:=` (region = as.character(region), thetaj = round(thetaj, 2))] if(nrow(warn)){ cat(paste0("\\vspace{-15pt}\n", "\\begin{center}\n", "\\footnotesize{Ratio des taux ajustés des ",variable.code," qui sont hors échelle et qui ne sont donc pas affichés}\n", "\\end{center}\n", "\\vspace{-10pt}\n")) print_warn(warn) } else { cat(paste0("\\vspace{-15pt}\n", "\\begin{center}\\footnotesize{Tous les ",variable.code," sont affichés}\\end{center}")) } cat("\n\n") cat("\\textbf{Résultats principaux}\\newline\n") cat("\\null\\quad\\quad\\quad\\quad \\textit{CVS} =", # CVS formatC(unique(tab_$CVS), decimal.mark = ",", big.mark = " ", digits = 1, format = "f"), "\\newline\n") cat("\\null\\quad\\quad\\quad\\quad \\textit{cv} = ", # cv du CVS formatC(unique(tab_$cv), decimal.mark = ",", big.mark = " ", digits = 2, format = "f"), " (", ifelse(unique(tab_$cv) <= prec.suff, "Suff", ifelse(unique(tab_$cv) <= prec.lim, "Lim", "Ins")),"$^{\\dagger}$) ", "\\newline\n", sep = "") cat("\\null\\quad\\quad\\quad\\quad \\textit{QP90/10} =", # QP9010 formatC(unique(tab_$QP9010), decimal.mark = ",", big.mark = " ", digits = 1, format = "f"), "\\newline\n") cat(paste0("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ", # Tbrute nsignif(unique(tab_$Tbrute)*nbr.pers, 3, decimal.mark = ",")), "\\newline\n") cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}_{Std~dir}$$^{\\ddagger}$ (/",nbr.pers,") = ", # Tstd.dir nsignif(unique(tab_$Tstd.dir)*nbr.pers, 3, decimal.mark = ","), "\\newline\n", sep = "") cat("\\null\\quad\\quad\\quad\\quad $N_{obs}$ =", # Nobs formatC(sum(tab_$obsj), format = "d", big.mark = " "), "\\newline\n") cat("\\null\\quad\\quad\\quad\\quad \\textit{N} =", # N formatC(unique(pop_$pop.totale), big.mark = " ", format = "d"), "\\newline\n") # Note définition précisions cat("\\vspace{-15pt}\n", "\\begin{footnotesize}\n", "$^{\\dagger}$ Précision :\n", "\\vspace{-2pt}\n", "\\begin{myindentpar}{0.5cm}\n", "Suff = Suffisante, c.-à-d. que le $cv$ est $\\leq$ ",prettyNum(prec.suff,decimal.mark=","),"\\% (Aucune restriction à la diffusion publique).\\newline\n", "Lim = Limite, c.-à-d. que le $cv$ est > ",prettyNum(prec.suff,decimal.mark=","),"\\%, mais $\\leq$ ",prettyNum(prec.lim,decimal.mark=","),"\\% (Pas d'utilisation, mais peut être diffusé à titre informatif sans interprétation).\\newline\n", "Ins = Insuffisante, c.-à-d. que le $cv$ est > ",prettyNum(prec.lim,decimal.mark=","),"\\% (Aucune utilisation ni diffusion publique).\n", "\\end{myindentpar}\n", "\\end{footnotesize}\n", sep = "") #équivalent de paste0() # Note sur standardisation cat(paste0("\\begin{footnotesize}$^{\\ddagger}$ Population de référence de la standardisation directe: ",pop.ref.loc," / ",pop.ref.yr, ".\\end{footnotesize}\n\n")) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) # ------------------------------------------------------------------------------------------------- # # Résultat par zone géographique pandoc.header(paste("Résultat par", region), level = 3) tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) tab_ <- tab_ %>% select(region, Tstd.region, Tstd.ind, thetaj, obsj, pop, starts_with("ginf_cvs"), starts_with("gsup_cvs")) %>% as.data.table() for(cvsi in cvs){ set(tab_, which(tab_[[paste0("ginf_cvs",cvsi)]] == 0 & tab_[[paste0("gsup_cvs",cvsi)]] == 0), paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "---") set(tab_, which(tab_[[paste0("ginf_cvs",cvsi)]] != 0), paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "Inf") set(tab_, which(tab_[[paste0("gsup_cvs",cvsi)]] != 0), paste0("$Outlier^{\\dagger}$\n$CVS_{réf}=$",cvsi), "Sup") } tab_ <- tab_ %>% select(region, Tstd.region, Tstd.ind, thetaj, obsj, pop, starts_with("$Outlier^{\\dagger}$\n$CVS_{réf}=$")) tab_[, `:=` (Tstd.region = Tstd.region * nbr.pers, Tstd.ind = Tstd.ind * nbr.pers, region = as.character(region), thetaj = round(thetaj, 2))] tab_[, `:=` (Tstd.region = sapply(Tstd.region, nsignif, 3, decimal.mark = ","), Tstd.ind = sapply(Tstd.ind, nsignif, 3, decimal.mark = ","))] setnames(tab_, c("region", "Tstd.region", "Tstd.ind", "thetaj", "obsj", "pop"), c(region, paste0("$T_{Std~dir_{j}}$\n(/",nbr.pers,")"), paste0("$T_{Std~ind_{j}}$\n(/",nbr.pers,")"), "$\\hat{\\theta}_{j}$", "$O_{j}$", "$n_{j}$")) pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 4) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ print_resultzone(tab_) # Note de bas de tableau cat("\\vspace{-15pt}\n", #espace entre tableau et note de bas "\\begin{footnotesize}\n", "$^{\\dagger}$ Outlier :\n", "\\vspace{-2pt}\n", "\\begin{myindentpar}{0.5cm}\n", "Sup = Supérieur, c.-à-d. que le $\\hat{\\theta}_{j}$ est supérieur à l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\\newline\n", "Inf = Inférieur, c.-à-d. que le $\\hat{\\theta}_{j}$ est inférieur à l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\\newline\n", "--- = le $\\hat{\\theta}_{j}$ est à l'intérieur de l'intervalle de confiance déterminé selon le CVS de référence ($CVS_{réf}$) spécifié.\n", "\\end{myindentpar}\n", "\\end{footnotesize}\n", sep = "") cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) # ------------------------------------------------------------------------------------------------- # # Gains par région pandoc.header(paste("Gain par", region), level = 3) pandoc.header("Hypothèse de réduction des *outliers* supérieurs au CVS de référence ($CVS_{réf})$", level = 4) tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) %>% select(region, obsj, starts_with("gsup_cvs")) %>% as.data.table() tab_ <- melt(tab_, id.vars = c("region", "obsj")) setorder(tab_, region) tab_ <- tab_[, flag := FALSE][tab_[, .I[any(value < -0.5)], .(region)]$V1, flag := TRUE] tab_ <- tab_[flag == T][, flag:=NULL] if(nrow(tab_) > 0){ # s'il y a des gains tab_ <- dcast(tab_, region + obsj ~ variable) for(cvsi in cvs){ temp <- copy(tab_) %>% select(region, obsj, one_of(paste0("gsup_cvs",cvsi))) setnames(temp, paste0("gsup_cvs",cvsi), "gain") temp <- temp[, gain := round(gain)][gain != 0] temp[, p100 := round(gain / obsj * 100, 1)] temp[, cvsref := cvsi] if(cvsi == cvs[[1]]){ tempfinal <- temp } else { tempfinal <- rbind(tempfinal, temp) } } setorder(tempfinal, region, -cvsref) tempfinal[, p100 := format(p100, decimal.mark = ",", nsmall = 1)] tempfinal[, gain_pourcent := paste0(gain," (",p100,")")] tempfinal <- dcast(tempfinal, region + obsj ~ cvsref, value.var = "gain_pourcent", fill = "---") setcolorder(tempfinal, c("region", "obsj", paste(cvs[cvs %in% names(tempfinal)]))) tab_ <- copy(tempfinal) %>% select(-obsj) %>% as.data.table(); rm(tempfinal) tabtaux_ <- copy(tabtaux[an == yr]) %>% select(region, Tj.region, starts_with("Tj_sup_cvsref")) %>% as.data.table() tabtaux_ <- tabtaux_[, c(.SD[,1], lapply(.SD[,2:ncol(tabtaux_)], function(x) sapply(x * nbr.pers, nsignif, 3, decimal.mark = ",")))] tab_ <- merge(tab_, tabtaux_, by = "region") tabfinal <- tab_[, .(region, Tj.region)] for(cvsi in cvs){ tabfinal <- merge(tabfinal, tabtaux_[, .(region, get(paste0("Tj_sup_cvsref",cvsi)))], by = "region") setnames(tabfinal, "V2", paste0("Tj_sup_cvsref",cvsi)) if(exists(paste0(cvsi), tab_)){ tabfinal <- merge(tabfinal, tab_[, .(region, get(paste(cvsi)))]) setnames(tabfinal, "V2", paste0("gain",cvsi)) } else { temp <- tab_[, .(region)][, paste(cvsi) := "---"] tabfinal <- merge(tabfinal, temp) setnames(tabfinal, paste0(cvsi), paste0("gain",cvsi)) } } tab_ <- copy(tabfinal); rm(tabfinal) tab_[, region := as.character(region)] for(j in cvs){ set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_sup_cvsref",j)]]), paste0("Tj_sup_cvsref",j), "---") } setnames(tab_, c("region", "Tj.region", paste0("Tj_sup_cvsref",cvs), paste0("gain",cvs)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$T_{j}$ si\n$CVS_{réf}$ = ",cvs,"\n(/",nbr.pers,")"), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))"))) pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ print_gainzones(tab_) } else { pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\begin{center} \\textbf{Cette hypothèse n'offre aucun gain pour cette période financière.} \\end{center}") } cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) pandoc.header("Hypothèse d'accroissement des *outliers* inférieurs au CVS de référence ($CVS_{réf})$", level = 4) tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) %>% select(region, obsj, starts_with("ginf_cvs")) %>% as.data.table() tab_ <- melt(tab_, id.vars = c("region", "obsj")) setorder(tab_, region) tab_ <- tab_[, flag := FALSE][tab_[, .I[any(value > 0.5)], .(region)]$V1, flag := TRUE] tab_ <- tab_[flag == T][, flag:=NULL] if(nrow(tab_) > 0){ tab_ <- dcast(tab_, region + obsj ~ variable) for(cvsi in cvs){ temp <- copy(tab_) %>% select(region, obsj, one_of(paste0("ginf_cvs",cvsi))) setnames(temp, paste0("ginf_cvs",cvsi), "gain") temp <- temp[, gain := round(gain)][gain != 0] temp[, p100 := round(gain / obsj * 100, 1)] temp[, cvsref := cvsi] if(cvsi == cvs[[1]]){ tempfinal <- temp } else { tempfinal <- rbind(tempfinal, temp) } } setorder(tempfinal, region, -cvsref) tempfinal[, p100 := format(p100, decimal.mark = ",", nsmall = 1)] tempfinal[, gain_pourcent := paste0(gain," (",p100,")")] cvsref <- sort(unique(tempfinal$cvsref), decreasing = T) tempfinal <- dcast(tempfinal, region + obsj ~ cvsref, value.var = "gain_pourcent", fill = "---") setcolorder(tempfinal, c("region", "obsj", paste(cvsref))) tab_ <- copy(tempfinal) %>% select(-obsj) %>% as.data.table(); rm(tempfinal) tabtaux_ <- copy(tabtaux[an == yr]) %>% select(region, Tj.region, starts_with("Tj_inf_cvsref")) %>% as.data.table() tabtaux_ <- tabtaux_[, c(.SD[,1], lapply(.SD[,2:ncol(tabtaux_)], function(x) sapply(x * nbr.pers, nsignif, 3, decimal.mark = ",")))] tab_ <- merge(tab_, tabtaux_, by = "region") tabfinal <- tab_[, .(region, Tj.region)] for(cvsi in cvs){ tabfinal <- merge(tabfinal, tabtaux_[, .(region, get(paste0("Tj_inf_cvsref",cvsi)))], by = "region") setnames(tabfinal, "V2", paste0("Tj_inf_cvsref",cvsi)) if(exists(paste0(cvsi), tab_)){ tabfinal <- merge(tabfinal, tab_[, .(region, get(paste(cvsi)))]) setnames(tabfinal, "V2", paste0("gain",cvsi)) } else { temp <- tab_[, .(region)][, paste(cvsi) := "---"] tabfinal <- merge(tabfinal, temp) setnames(tabfinal, paste0(cvsi), paste0("gain",cvsi)) } } tab_ <- copy(tabfinal); rm(tabfinal) tab_[, region := as.character(region)] for(j in cvs){ set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_inf_cvsref",j)]]), paste0("Tj_inf_cvsref",j), "---") } setnames(tab_, c("region", "Tj.region", paste0("Tj_inf_cvsref",cvs), paste0("gain",cvs)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$T_{j}$ si\n$CVS_{réf}$ = ",cvs,"\n(/",nbr.pers,")"), paste0("Gain si\n$CVS_{réf}$ = ",cvs,"\n(nbre (\\%))"))) pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ print_gainzones(tab_) } else { pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\begin{center} \\textbf{Cette hypothèse n'offre aucun gain pour cette période financière.} \\end{center}") } cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) #-----------------------------------------------------------------------------------------------# # Réduction/Accroissement du taux moyen normalisé selon CVS.norm #### # Réduction pandoc.header("Hypothèse de réduction du taux moyen avec normalisation selon un $CVS_{réf}$", level = 4) tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) %>% select(-an, -code) %>% as.data.table() Tbrute <- copy(nsignif(unique(tab_$Tbrute) * nbr.pers, 3, decimal.mark = ",", big.mark = " ")) cols <- c("region", "obsj", "pop.totale", "Tj.region") for(p100i in p100*100) cols <- c(cols, paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm), paste0("gsup_p",p100i,"_cvs",cvs.norm)) tab_ <- tab_[, ..cols] pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\textbf{Cibles}\\newline\n") cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ",Tbrute,"\\newline\n", sep = "") for(p100i in p100*100) { Tbrute <- nsignif(sum(tab_[["obsj"]] + round(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]])) / unique(tab_[["pop.totale"]]) * nbr.pers / length(an.analyse), 3, decimal.mark = ",", big.mark = " ") cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") - ",p100i,"% = ", Tbrute,"\\newline\n", sep = "") } cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n", sep = "") tab_ <- tab_ %>% select(-pop.totale) %>% as.data.table() tab_[, `:=` (Tj.region = sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = "."), region = as.character(region))] for(p100i in p100*100){ tab_[[paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm)]] <- sapply(tab_[[paste0("Tj_sup_region_p",p100i,"_cvs",cvs.norm)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ") tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]] <- paste0( formatC(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]], format = "f", digits = 0, decimal.mark = ",", big.mark = " "), " (", formatC(round(tab_[[paste0("gsup_p",p100i,"_cvs",cvs.norm)]]) / tab_[["obsj"]] * 100, format = "f", digits = 1, decimal.mark = ",", big.mark = " "), ")" ) } tab_ <- tab_ %>% select(-obsj) %>% as.data.table() for(j in p100*100){ set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_sup_region_p",j,"_cvs",cvs.norm)]]), paste0("Tj_sup_region_p",j,"_cvs",cvs.norm), "---") } setnames(tab_, c("region", "Tj.region", paste0("Tj_sup_region_p",p100*100,"_cvs",cvs.norm), paste0("gsup_p",p100*100,"_cvs",cvs.norm)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$T_{j}$ $-",p100*100,"$\\%\n(/",nbr.pers,")"), paste0("Gain\n$T_{j}$ $-",p100*100,"$\\%\n(nbre (\\%))"))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } print_gainzones_p100(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) # Accroissement pandoc.header("Hypothèse d'accroissement du taux moyen avec normalisation selon un $CVS_{réf}$", level = 4) tab <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) tab <- merge(tab, Taux[, .(an, code, region, Tstd.dir, Tstd.region)], by = c("an", "code", "region")) for(yr in unique(tab$an)){ tab_ <- copy(tab[an == yr]) %>% select(-an, -code) %>% as.data.table() Tbrute <- copy(nsignif(unique(tab_$Tbrute) * nbr.pers, 3, decimal.mark = ",", big.mark = " ")) cols <- c("region", "obsj", "pop.totale", "Tj.region") for(p100i in p100*100) cols <- c(cols, paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm), paste0("ginf_p",p100i,"_cvs",cvs.norm)) tab_ <- tab_[, ..cols] pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\textbf{Cibles}\\newline\n") cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") = ",Tbrute,"\\newline\n", sep = "") for(p100i in p100*100) { Tbrute <- nsignif(sum(tab_[["obsj"]] + round(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]])) / unique(tab_[["pop.totale"]]) * nbr.pers / length(an.analyse), 3, decimal.mark = ",", big.mark = " ") cat("\\null\\quad\\quad\\quad\\quad $\\bar{T}$ (/",nbr.pers,") + ",p100i,"% = ", Tbrute,"\\newline\n", sep = "") } cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n", sep = "") tab_ <- tab_ %>% select(-pop.totale) %>% as.data.table() tab_[, `:=` (Tj.region = sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = "."), region = as.character(region))] for(p100i in p100*100){ tab_[[paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm)]] <- sapply(tab_[[paste0("Tj_inf_region_p",p100i,"_cvs",cvs.norm)]] * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ") tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]] <- paste0( formatC(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]], format = "f", digits = 0, decimal.mark = ",", big.mark = " "), " (", formatC(round(tab_[[paste0("ginf_p",p100i,"_cvs",cvs.norm)]]) / tab_[["obsj"]] * 100, format = "f", digits = 1, decimal.mark = ",", big.mark = " "), ")" ) } tab_ <- tab_ %>% select(-obsj) %>% as.data.table() for(j in p100*100){ set(tab_, which(tab_[["Tj.region"]] == tab_[[paste0("Tj_inf_region_p",j,"_cvs",cvs.norm)]]), paste0("Tj_inf_region_p",j,"_cvs",cvs.norm), "---") } setnames(tab_, c("region", "Tj.region", paste0("Tj_inf_region_p",p100*100,"_cvs",cvs.norm), paste0("ginf_p",p100*100,"_cvs",cvs.norm)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$T_{j}$ $+",p100*100,"$\\%\n(/",nbr.pers,")"), paste0("Gain\n$T_{j}$ $+",p100*100,"$\\%\n(nbre (\\%))"))) for(j in names(tab_)[startsWith(names(tab_), "Gain")]){ set(tab_, which(substr(tab_[[j]],1,1) == "0" | substr(tab_[[j]],1,2) == "-0"), j, "---") } print_gainzones_p100(tab_) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") } rm(tab); rm(tab_) #---------------------------------------------------------------------------------------------# # Taux au percentile cible #### # Inférieur à la médiane pandoc.header("Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ observés (inférieur à la médiane) avec normalisation selon un $CVS_{réf}$", level = 4) gains_pctl <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) cols <- c("region", "Tbrute", "Tj.region", "Tstd.ind", "obsj", paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm), paste0("gpctl",pctl*100,"_cvs",cvs.norm), paste0("tcible_pctl",pctl*100,"_cvs",cvs.norm), paste0("pctl_en_pourcent",pctl*100,"_cvs",cvs.norm)) gains_pctl <- gains_pctl[, ..cols] Tbrute <- unique(gains_pctl$Tbrute) * nbr.pers pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\textbf{Cibles}\\newline\n") for(pctli in pctl){ tj.cible <- unique(gains_pctl[[paste0("tcible_pctl",pctli*100,"_cvs",cvs.norm)]]) * nbr.pers tj_pourcent <- unique(gains_pctl[[paste0("pctl_en_pourcent",pctli*100,"_cvs",cvs.norm)]]) * 100 cat("\\null\\quad\\quad\\quad\\quad ", "Déplacement du $\\bar{T}$ (",nsignif(Tbrute, 3, decimal.mark = ",", big.mark = " "),"/",nbr.pers,") ", "au $",pctli*100,"^{e}$ percentile des $T_{j}$ (/",nbr.pers," (\\%)) = ", nsignif(tj.cible, 3, decimal.mark = ",", big.mark = " "), " (",format(round(tj_pourcent,1), decimal.mark = ",", big.mark = " ", nsmall = 1),")", "\\newline\n", sep = "") } cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n\n", sep = "") for(j in pctl*100){ # arrondir les gains set(gains_pctl, NULL, paste0("gpctl",j,"_cvs",cvs.norm), round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]])) # pourcentage de gains set(gains_pctl, NULL, paste0("gpctl",j,"_cvs",cvs.norm), paste0(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]," (", format(round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]] / gains_pctl[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ","),")")) # format tj.region set(gains_pctl, NULL, paste0("Tj.region.pctl",j,"_cvs",cvs.norm), sapply(gains_pctl[[paste0("Tj.region.pctl",j,"_cvs",cvs.norm)]]*nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")) } gains_pctl[, Tj.region := sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")] cols <- c("region", "Tj.region", as.vector(sapply(pctl*100, function(x) c(paste0("Tj.region.pctl",x,"_cvs",cvs.norm), paste0("gpctl",x,"_cvs",cvs.norm))))) gains_pctl <- gains_pctl[, ..cols] setnames(gains_pctl, c("region", "Tj.region", paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm), paste0("gpctl",pctl*100,"_cvs",cvs.norm)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$\\bar{T}_{",pctl*100,"^{e} perc}$\n(/",nbr.pers,")"), paste0("Gain$_{",pctl*100,"^{e} perc}$\n(nbre (\\%))"))) for(j in names(gains_pctl)[startsWith(names(gains_pctl), "Gain")]) set(gains_pctl, which(substr(gains_pctl[[j]],1,1) == "0" | substr(gains_pctl[[j]],1,2) == "-0"), j, "---") for(j in names(gains_pctl)[startsWith(names(gains_pctl), "$\\bar{T}_{")]) set(gains_pctl, which(gains_pctl[[j]] == "0,000"), j, "---") print_gainzones_pctl(gains_pctl) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") rm(gains_pctl) # Spérieur à la médiane pandoc.header("Hypothèse d'un taux moyen cible au x$^{ième}$ percentile des $T_{Std~ind_{j}}$ observés (supérieur à la médiane) avec normalisation selon un $CVS_{réf}$", level = 4) pctl <- 1 - pctl gains_pctl <- copy(CVStab$result[code == unique(CVStab$result$code)[[i]]]) cols <- c("region", "Tbrute", "Tj.region", "Tstd.ind", "obsj", paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm), paste0("gpctl",pctl*100,"_cvs",cvs.norm), paste0("tcible_pctl",pctl*100,"_cvs",cvs.norm), paste0("pctl_en_pourcent",pctl*100,"_cvs",cvs.norm)) gains_pctl <- gains_pctl[, ..cols] Tbrute <- unique(gains_pctl$Tbrute) * nbr.pers pandoc.header(paste0("Période financière ",min(an.analyse),"-",max(an.analyse)+1), level = 5) cat("\\textcolor{white}{NA}","\\newline\n\n") #hack pour les headers lvl 4+ cat("\\textbf{Cibles}\\newline\n") for(pctli in pctl){ tj.cible <- unique(gains_pctl[[paste0("tcible_pctl",pctli*100,"_cvs",cvs.norm)]]) * nbr.pers tj_pourcent <- unique(gains_pctl[[paste0("pctl_en_pourcent",pctli*100,"_cvs",cvs.norm)]]) * 100 cat("\\null\\quad\\quad\\quad\\quad ", "Déplacement du $\\bar{T}$ (",nsignif(Tbrute, 3, decimal.mark = ",", big.mark = " "),"/",nbr.pers,") ", "au $",pctli*100,"^{e}$ percentile des $T_{j}$ (/",nbr.pers," (\\%)) = ", nsignif(tj.cible, 3, decimal.mark = ",", big.mark = " "), " (",format(round(tj_pourcent,1), decimal.mark = ",", big.mark = " ", nsmall = 1),")", "\\newline\n", sep = "") } cat("\\textbf{Et normalisé selon $CVS_{réf}$ = ",cvs.norm,"}\\newline\n\n", sep = "") for(j in pctl*100){ # arrondir les gains set(gains_pctl, NULL, paste0("gpctl",j,"_cvs",cvs.norm), round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]])) # pourcentage de gains set(gains_pctl, NULL, paste0("gpctl",j,"_cvs",cvs.norm), paste0(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]]," (", format(round(gains_pctl[[paste0("gpctl",j,"_cvs",cvs.norm)]] / gains_pctl[["obsj"]] * 100, 1), nsmall = 1, decimal.mark = ","),")")) # format tj.region set(gains_pctl, NULL, paste0("Tj.region.pctl",j,"_cvs",cvs.norm), sapply(gains_pctl[[paste0("Tj.region.pctl",j,"_cvs",cvs.norm)]]*nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")) } gains_pctl[, Tj.region := sapply(Tj.region * nbr.pers, nsignif, 3, decimal.mark = ",", big.mark = " ")] cols <- c("region", "Tj.region", as.vector(sapply(pctl*100, function(x) c(paste0("Tj.region.pctl",x,"_cvs",cvs.norm), paste0("gpctl",x,"_cvs",cvs.norm))))) gains_pctl <- gains_pctl[, ..cols] setnames(gains_pctl, c("region", "Tj.region", paste0("Tj.region.pctl",pctl*100,"_cvs",cvs.norm), paste0("gpctl",pctl*100,"_cvs",cvs.norm)), c(region, paste0("$T_{j}$\n(/",nbr.pers,")"), paste0("$\\bar{T}_{",pctl*100,"^{e} perc}$\n(/",nbr.pers,")"), paste0("Gain$_{",pctl*100,"^{e} perc}$\n(nbre (\\%))"))) for(j in names(gains_pctl)[startsWith(names(gains_pctl), "Gain")]) set(gains_pctl, which(substr(gains_pctl[[j]],1,1) == "0" | substr(gains_pctl[[j]],1,2) == "-0"), j, "---") for(j in names(gains_pctl)[startsWith(names(gains_pctl), "$\\bar{T}_{")]) set(gains_pctl, which(gains_pctl[[j]] == "0,000"), j, "---") print_gainzones_pctl(gains_pctl) cat("\\begin{center}\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_Fin de la section\\_\\_\\_\\_\\_\\_\\_\\_\\_\\_\\end{center}") cat("\n\\pagebreak\n\n") rm(gains_pctl) pctl <- pctl_initial }
library(writexl) if(save.result) write_xlsx(CVStab$result, "AnalyseCVS.xlsx")
\vfill
\begin{center} \Large{Fin du rapport (dernière page)} \end{center}
\sectionfont{\color{white}}
Fin du rapport (dernière page)
library(inesss) send_email("guillaume.boucher@inesss.qc.ca", start_time = NULL)
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.