variation: Analyse Coefficient Variation Systématique

#' Structure la BD
#'
#' Structure la base de données contenant les codes de regroupement afin de permettre les calculs des CVS
#'
#' @param x DATA. BD contenant les codes de regroupement.
#' @param x.an CHR. Nom de la colonne indiquant l'année ou la période.
#' @param x.id CHR. Nom de la colonne indiquant l'usager.
#' @param x.region CHR. Nom de la colonne indiquant le code de la région géographique.
#' @param x.code CHR. Nom de la colonne indiquant le code de regroupement.
#' @param x.descriptif CHR. Facultatif. Nom de la colonne indiquant la description du code de regroupement.
#' @param x.age CHR. Facultatif. Nom de la colonne indiquant l'âge de l'usager.
#' @param x.sexe CHR. Facultatif. Nom de la colonne indiquant le sexe de l'usager.
#' @param x.indic CHR. Facultatif. Nom de la colonne indiquant l'indice social (défavorisation ou autre).
#' @param y DATA. BD contenant la population par zone géographique et par strate.
#' @param y.geo CHR. Nom de la colonne indiquant le type de zone géographique.
#' @param y.geocode CHR. Nom de la colonne indiquant le code de la zone géographique.
#' @param y.an CHR. Nom de la colonne indiquant l'année ou la période (\code{y}).
#' @param y.pop CHR. Nom de la colonne indiquant la population totale (\code{y}).
#' @param y.age CHR. Facultatif. Nom de la colonne indiquant les âges (\code{y}).
#' @param y.sexe CHR. Facultatif. Nom de la colonne indiquant les sexes (\code{y}).
#' @param y.indic CHR. Facultatif. Nom de la colonne indiquant l'indice social (défavorisation ou autre) (\code{y}).
#' @param y.geo_select CHR. Zone géographique à utiliser lors de l'analyse.
#' @param catage INT. Bornes inférieures (incluse) des âges.
#' @param catage.max LOGICAL. 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.
#' @param sex.select CHR. Sélection des sexes : "M" pour Masculin, "F" pour Féminin et c("M", "F") pour les deux.
#' @param an.analyse INT. Années (périodes) à analyser.
#' @param code.analyse INT ou CHR. Codes de regroupement à analyser.
#'
#' @import plyr
#' @import data.table
#'
#' @export
BD_CVS <- function(x,
                   x.an,
                   x.id,
                   x.region,
                   x.code,
                   x.descriptif = NULL,
                   x.age = NULL,
                   x.sexe = NULL,
                   x.indic = NULL,
                   y,
                   y.geo,
                   y.geocode,
                   y.an,
                   y.pop,
                   y.age = NULL,
                   y.sexe = NULL,
                   y.indic = NULL,
                   y.geo_select,
                   catage = c(20,40,60,80),
                   catage.max = TRUE,
                   sex.select = c("M", "F"),
                   an.analyse,
                   code.analyse) {

  #### Code de regroupement ####
  dt <- as.data.table(x)
  setorderv(dt, c(x.an, x.id, x.code, x.age))
  dtnames <- c(x.an, x.id, x.region, x.code)
  if(!is.null(x.age)) dtnames <- c(dtnames, x.age)
  if(!is.null(x.sexe)) dtnames <- c(dtnames, x.sexe)
  if(!is.null(x.indic)) dtnames <- c(dtnames, x.indic)
  dt <- dt[, ..dtnames]
  setnames(dt,
           c(x.an, x.id, x.region, x.code),
           c("an", "id", "region", "code"))
  if(!is.null(an.analyse)) dt <- dt[an %in% an.analyse]
  
  if(!is.null(x.age)){
    i <- 1L
    for(yr in an.analyse[-1]){
      dt <- dt[an == yr, paste(x.age) := get(x.age) - i]
      i <- i + 1L
    }
  }
  
  dt[, an := min(an)]
  dt <- unique(dt, by = c("id", "code"))
  
  
  if(!is.null(code.analyse)) dt <- dt[code %in% code.analyse]
  by_obs <- c("an", "code", "region")
  by_x <- c("an", "region")
  if(!is.null(x.age)) {
    setnames(dt, x.age, "age")
    if(catage.max & max(catage) <= max(dt$age)) catage <- c(catage, max(dt$age)+1)
    dt <- dt[, catage := cut(age, catage, right = F)][!is.na(catage)]
    by_obs <- c(by_obs, "catage")
    by_x <- c(by_x, "catage")
    }
  if(!is.null(x.sexe)) {
    setnames(dt, x.sexe, "sexe")
    by_obs <- c(by_obs, "sexe")
    by_x <- c(by_x, "sexe")
    }
  if(!is.null(x.indic)) {
    setnames(dt, x.indic, "indic")
    by_obs <- c(by_obs, "indic")
    by_x <- c(by_x, "indic")
    }

  dt <- dt[, .(obs = .N), by = by_obs]


  #### Population ####
  pop <- as.data.table(y)
  popnames <- c(y.geo, y.geocode, y.an, y.pop)
  if(!is.null(y.age)) popnames <- c(popnames, y.age)
  if(!is.null(y.sexe)) popnames <- c(popnames, y.sexe)
  if(!is.null(y.indic)) popnames <- c(popnames, y.indic)
  pop <- pop[, ..popnames]
  setnames(pop, c(y.geo, y.geocode, y.an, y.pop),
           c("geo", "geocode", "an", "pop"))
  pop <- pop[geo == y.geo_select]
  
  
  # pop.region
  if(catage.max){
    pop.region <- pop[an %in% an.analyse & Age >= catage[[1]]]
  } else {
    pop.region <- pop[an %in% an.analyse & Age >= catage[[1]] & Age <= catage[[length(catage)]]]
  }
  pop.region <- pop.region[, .(pop = sum(pop)), .(an, geocode)]
  pop.region[, pop.totale := sum(pop), .(an)]
  setorder(pop.region, an, geocode)

  popnames <- names(pop)[names(pop) != "geo"]
  pop <- pop[, ..popnames]
  by_pop <- c("an", "geocode")
  if(!is.null(y.age)) {
    setnames(pop, y.age, "age")
    pop <- pop[, catage := cut(age, catage, right = F)][!is.na(catage)]
    by_pop <- c(by_pop, "catage")
  }
  if(!is.null(y.sexe)) {
    setnames(pop, y.sexe, "sexe")
    by_pop <- c(by_pop, "sexe")
    pop <- pop[sexe %in% sex.select]
  }
  if(!is.null(y.indic)) {
    setnames(pop, y.indic, "indic")
    by_pop <- c(by_pop, "indic")
  }
  
  # pop.strates
  by.strates <- by_pop[-2]
  pop.strates <- pop[, .(pop = sum(pop)), by.strates]
  pop.strates <- pop.strates[an %in% an.analyse]
  # pop.region.strates
  pop <- pop[, .(pop = sum(pop)), by = by_pop]


  #### Merge des résultats ####
  dt <- merge(dt, pop,
              by.x = by_x, by.y = by_pop, all.x = TRUE)
  setorder(dt, code, an, region, sexe, catage)


  #### Ajout du descriptif ####

  if(!is.null(x.descriptif)) {
    desc <- as.data.table(x)
    cols <- c(x.code, x.descriptif)
    desc <- unique(desc[, ..cols])
    setnames(desc, cols,
             c("code", "descriptif"))
    setorder(desc, code)
    list(
      BD.analyse = dt,
      code.descriptif = desc,
      pop.region = pop.region,
      pop.region.strates = pop,
      pop.strates = pop.strates,
      catage = catage
    )
  } else {
    list(
      BD.analyse = dt,
      code.descriptif = NA,
      pop.region = pop.region,
      pop.region.strates = pop,
      pop.strates = pop.strates,
      catage = catage
    )
  }

}