R/gain_pourcent_norm.R

In INESSSQC/variation: Analyse Coefficient Variation Systématique

#' Gains pourcentage & normalisation
#'
#' Indique les gains associés à l'application d'un taux de pourcentage suivi d'une normalisation selon un CVS de référence.
#'
#' @param x data.
#' @param cvs CVS de référence.
#' @param p100 Pourcentage selon 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.
#'
#' @return 3 colonnes :\cr
#' 1) g100 : gains par région.\cr
#' 2) gain100 : gains totaux.\cr
#' 3) tj.region : taux de la région.
#' @keywords internal
#' @import data.table
#' @export
gain_pourcent_norm <- function(x, cvs, p100, method = 1, nyear = length(an.analyse)){

  dt <- as.data.table(x)
  # Gains pourcentage
  dt <- dt[, .(obsj, expj, RTj, thetaj, pop)]  # sélection des colonnes
  dt[, obs_F := obsj * (1 + p100)]  # observations modifiées selon pourcentage
  dt[, g100 := obs_F - obsj]  # gain selon modif %
  # Gains selon normalisation
  limits <- CVS_limits(dt, "obs_F", cvs)  # limites de référence inf et sup
  dt[, O_hat_j := expj * thetaj]
  dt[, O_ref_sup := expj * limits$limsup]
  dt[, O_ref_inf := expj * limits$liminf]
  dt[thetaj > limits$limsup, gnorm_sup := O_ref_sup - O_hat_j]  # gains si hors limite supérieure
  dt[is.na(gnorm_sup), gnorm_sup := 0]
  dt[thetaj < limits$liminf, gnorm_inf := O_ref_inf - O_hat_j]  # gains si hors limite inférieure
  dt[is.na(gnorm_inf), gnorm_inf := 0]
  # Calcul des gains selon method
  if(method){  # method=1 : gain norm seulement dans un sens, celui du pourcentage
    if(p100 < 0){  # si % negatif => reduction = sup
      dt[, g100 := g100 + gnorm_sup]
    } else {  # si % positif => accroissement = inf
      dt[, g100 := g100 + gnorm_inf]
    }
  } else {  # method=0 : gain norm dans tous les sens
    dt[, g100 := g100 + gnorm_sup + gnorm_inf]
  }

  dt[, g100 := g100]  # gains
  dt[, gain100 := sum(g100)]  # gains totaux
  dt[, tj.region := (obsj + g100) / pop / nyear]  # taux de la région

  return(dt[, .(g100, gain100, tj.region)])

}