#' gain_percentile_norm
#'
#' Indique les gains selon l'hypothèse des percentiles.
#'
#' @param x data.
#' @param cvs CVS de référence.
#' @param pctl Percentiles d'hypothèse.
#' @param method 1 ou 0. 1 = Gains normalisation seulement dans la direction relié au pourcentage (réduction ou accroissement). 0 = Gains normalisation dans les deux sens (réduction et accroissement).
#' @param nyear Nombre d'annnées analysées.
#'
#' @keywords internal
#' @import data.table
#' @import plyr
#' @export
gain_percentile_norm <- function(x, cvs, pctl, method = 1, nyear = length(an.analyse)){
dt <- as.data.table(x)
dt <- as.data.table(rbind.fill(lapply(split(dt, by = c("an", "code")), function(z) {
if(nrow(z)){
pctl <- sort(c(pctl, sapply(pctl, function(x) 1 - x))) # complement du percentile : 1 - pctl
#### Percentile + CVS ####
z <- cbind(z, Reduce(function(a,b) cbind(a,b), mapply(function(pctlx, cvsx) {
# Convertir pctlx en équivalent pourcentage
tstd_cible <- quantile(z$Tstd.ind, pctlx)
pctl_F <- (tstd_cible / unique(z$Tbrute)) - 1
# Appliquer même méthode que pourcentage à partir du pctlx converti (pctl_F)
gainpctl <- gain_pourcent_norm(z, cvsx, pctl_F, method, nyear)
gainpctl[, tcible := tstd_cible]
gainpctl[, pctl_en_pourcent := pctl_F]
setnames(gainpctl, c("g100", "gain100", "tj.region", "tcible", "pctl_en_pourcent"),
c(
paste0("gpctl",pctlx*100,"_cvs",cvsx),
paste0("gainpctl",pctlx*100,"_cvs",cvsx),
paste0("Tj.region.pctl",pctlx*100,"_cvs",cvsx),
paste0("tcible_pctl",pctlx*100,"_cvs",cvsx),
paste0("pctl_en_pourcent",pctlx*100,"_cvs",cvsx)
))
return(gainpctl)
},
# Arguments
pctl,
rep(cvs, each = length(pctl)),
SIMPLIFY = FALSE)))
} else {
NULL
}
})))
return(dt)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.