INESSS: Useful functions

#' Données à inclure
#'
#' Sélectionne les observations qui respectent les critères.
#'
#' La base de données \code{x} doit contenir \strong{uniquement} les colonnes nécessaires à l'inclusion.
#'
#' @param x Base de données d'analyse.
#' @param ... Critères d'inclusion à inscrire sous la forme : \code{nomColonne = nombre}. Les critères peuvent être inséré dans une liste.
#' @param cols Facultatif. Nom des colonnes nécessaires à l'inclusion. S'il n'est pas défini, \code{cols} aura pour valeur les colonnes existantes dans \code{x}.
#' @param filter Détermine l'opérateur logique des critères : "<=", "<", ">" ou ">=".
#' @param table TRUE si on veut le tableau résultat, FALSE renvoie les combinaisons uniques des colonnes qui ne sont pas dans les critères
#'
#' @return data.table ou vecteur indiquant les codes exclus.
#' 
#' @import data.table
#' @import dplyr
#' @export
#' @examples
#' DT <- data.frame(Annee = rep(c(2014, 2015), each = 15),
#'                  Code = rep(rep(1:3, each = 5), 2),
#'                  Region = rep(1:5, 6),
#'                  obs = c(10,20,30,40,50,20,30,40,50,60,
#'                          40,50,60,70,80, 0, 5,10,15,20,
#'                           5,10,15,20,25,10,15,20,25,30))
#' inclus(DT, obs = 20)  # 1 critère
#' inclus(DT, obs = 20, Region = 3)  # 2 critères
#' inclus(DT, obs = 20, Region = 3, Code = 3)  # 3 critères
#'
#' # Sélection des colonnes avec 'cols'
#' inclus(DT, obs = 30, cols = c("Annee", "Code", "obs"))
#'
#' # Choix d'inclusion, ">=" vs "<"
#' inclus(DT, obs = 20, Region = 3, filter = ">=")
#' inclus(DT, obs = 20, filter = "<")
#'
#' # table = FALSE vs TRUE
#' inclus(DT, obs = 20, Region = 3, table = TRUE)
#' inclus(DT, obs = 20, Region = 3, table = FALSE)
inclus <- function(x, ..., filter = ">=", cols = NULL, table = TRUE){

  #### Verification
  ArgCheck()
  if(!is.data.frame(x)) addError("'x' n'est pas de type DATA.FRAME.", argcheck)
  finishArgCheck(argcheck)
  if(!is.null(cols)){
    if(any(!cols %in% names(x))) addError("Une valeur de 'cols' n'est pas un nom de colonne de 'x'.", argcheck)
  }
  if(!filter %in% c("<=", "<", ">", ">=")) addError(paste0("La valeur de filter (",filter,") n'est pas une valeur permise.", argcheck))
  if(!is.logical(table)) addError("'table' doit être de type LOGICAL.", argcheck)
  
  
  #### Code ####
  
  dt <- as.data.table(x)
  crits <- c(...)
  if(!is.list(crits)) crits <- as.list(crits)  # critères sous forme de list
  if(is.null(cols)) cols <- names(dt) else dt <- dt[, ..cols]

  # Changer nom de colonne 'N' (si existe) temporairement
  if("N" %in% names(dt)){
    Ncol <- paste(sample(LETTERS, 10, T), collapse = "")
    while(Ncol %in% names(dt)) Ncol <- paste(sample(LETTERS, 10, T), collapse = "")
    setnames(dt, "N", Ncol)
    cols[match("N", cols)] <- Ncol
  }

  if(filter == "<"){  # opérateur à appliquer pour critères

    if(length(crits) == 1){  # si 1 critère
      dt <- dt[get(names(crits)) < crits[[1]] ]  # filtrer
    } else {
      by_crit <- cols[-1 * (length(cols)-1):length(cols)]  # colonnes de regroupement, sauf 2 plus petits critères
      for (i in 2:length(crits)){
        if(i == 2){  # pour 2e critère
          dt <- dt[get(names(crits)[[1]]) < crits[[1]], .N, keyby = by_crit]  # tableau selon 2 premiers critères
          dt <- dt[N < crits[[i]] ]  # trier selon 2e critère
          by_crit <- by_crit[-length(by_crit)]  # supprimer nom colonne venant d'être triée
        } else {  # pour 3e critère et plus
          dt <- dt[, .N, keyby = by_crit]  # tableau pour 3e crit ou plus
          dt <- dt[N < crits[[i]] ]  # trier selon 3e crit ou plus
          by_crit <- by_crit[-length(by_crit)]  # supprimer nom colonne venant d'être triée
        }
      }
    }

  } else if(filter == "<="){

    if(length(crits) == 1){
      dt <- dt[get(names(crits)) <= crits[[1]] ]
    } else {
      by_crit <- cols[-1 * (length(cols)-1):length(cols)]
      for (i in 2:length(crits)){
        if(i == 2){
          dt <- dt[get(names(crits)[[1]]) <= crits[[1]], .N, keyby = by_crit]
          dt <- dt[N <= crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        } else {
          dt <- dt[, .N, keyby = by_crit]
          dt <- dt[N <= crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        }
      }
    }

  } else if(filter == ">"){

    if(length(crits) == 1){
      dt <- dt[get(names(crits)) > crits[[1]] ]
    } else {
      by_crit <- cols[-1 * (length(cols)-1):length(cols)]
      for (i in 2:length(crits)){
        if(i == 2){
          dt <- dt[get(names(crits)[[1]]) > crits[[1]], .N, keyby = by_crit]
          dt <- dt[N > crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        } else {
          dt <- dt[, .N, keyby = by_crit]
          dt <- dt[N > crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        }
      }
    }

  } else if(filter == ">="){

    if(length(crits) == 1){
      dt <- dt[get(names(crits)) >= crits[[1]] ]
    } else {
      by_crit <- cols[-1 * (length(cols)-1):length(cols)]
      for (i in 2:length(crits)){
        if(i == 2){
          dt <- dt[get(names(crits)[[1]]) >= crits[[1]], .N, keyby = by_crit]
          dt <- dt[N >= crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        } else {
          dt <- dt[, .N, keyby = by_crit]
          dt <- dt[N >= crits[[i]] ]
          by_crit <- by_crit[-length(by_crit)]
        }
      }
    }

  } else {  # si filter = valeur impossible

    stop("'filter' peut prendre les valeurs suivantes : '<', '<=', '>', '>='.")  # message d'erreur

  }

  if(exists("Ncol")){
    if(Ncol %in% names(dt)) setnames(dt, Ncol, "N")  # s'il y a encore la colonne dont le nom a été modifié
  }
  if(table){
    dt
  } else {
    dt <- dt %>% select(-N) %>% as.data.table()  # supprimer la colonne 'N'
    dt <- unique(dt)  # valeur unique
    dt
  }

}