R/gain_percentile_norm.R

#' 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)

}
INESSSQC/variation documentation built on July 3, 2019, 11:33 a.m.