R/Rcase.R

In danielmedbar/KWSTCReclassifRef: Reclassificar referencias de individuos que no existen en ISEC

#' Identificar filas que cumplen una norma
#' 
#' Esta función indica devolviendo un vector de TRUE/FALSE si las filas de dos columnas cumplen las normas especificadas.
#' Para entender mejor la finalidad de esta función, el nombre Rcase está inspirado en la función case de sql, con la cual se puede indicar
#' si se cumple una norma 1, si no 0.
#' @param data 
#' @param condition_level un vector de caracteres que indica las categorias a revisar de una columna. Mirar ejemplos.
#' @param col_level la columna donde se encuentran las categorias de condition_level
#' @param condition_possib una lista con vectores que indican los valores que puede tomar la segunda columna para seguir las norma. Mirar ejemplos.
#' @param col_possib la columna donde se encuentran las categorias de condition_possib
#' @export
#' @examples
#' condition_level_peso <- c('246','188','012','088','125','061','008','046','109','086','117','113')
#' condition_possib_peso <- list(
#' c('246','188','012'),
#' c('246','188','012','088'),
#' c('246','188','012','088','125'),
#' c('188','012','088','125','061'),
#' c('012','088','125','061','008'),
#' c('088','125','061','008','046'),
#' c('125','061','008','046','109'),
#' c('061','008','046','109','086'),
#' c('008','046','109','086','117'),
#' c('046','109','086','117','113'),
#' c('109','086','117','113'),
#' c('086','117','113')
#' )
#' 
#' Rcase(data=choice_complete, condition_level=condition_level_peso, col_level=3,
#'                             condition_possib=condition_possib_peso, col_possib=6)
#'# Internamente, la función genera un código como el de a continuación:
#'# (choice_complete[,c(\"e2_cati_substr\")] %in% c(\"246\") & 
#'# choice_complete[,c(\"e2_isec_substr\")] %in% c(\"246\", \"188\", \"012\")) | 
#'# (choice_complete[,c(\"e2_cati_substr\")] %in% c(\"188\") & 
#'# choice_complete[,c(\"e2_isec_substr\")] %in% c(\"246\", \"188\", \"012\", \"088\")) | 
#'# (choice_complete[,c(\"e2_cati_substr\")] %in% c(\"012\") & 
#'# choice_complete[,c(\"e2_isec_substr\")] %in% c(\"246\", \"188\", \"012\", \"088\", \"125\")) | ...
#'
#'# El cual sería un equivalente de especificar en sql:
#'# CASE  
#'# WHEN e2_cati = '246' AND e2_isec in ('246','188','012') THEN 1 
#'# WHEN e2_cati = '188' AND e2_isec in ('246','188','012','088') THEN 1
#'# WHEN e2_cati = '012' AND e2_isec in ('246','188','012','088','125') THEN 1
#'# WHEN e2_cati = '088' AND e2_isec in ('188','012','088','125','061') THEN 1
#'# WHEN e2_cati = '125' AND e2_isec in ('012','088','125','061','008') THEN 1
#'# WHEN e2_cati = '061' AND e2_isec in ('088','125','061','008','046') THEN 1
#'# WHEN e2_cati = '008' AND e2_isec in ('125','061','008','046','109') THEN 1
#'# WHEN e2_cati = '046' AND e2_isec in ('061','008','046','109','086') THEN 1
#'# WHEN e2_cati = '109' AND e2_isec in ('008','046','109','086','117') THEN 1
#'# WHEN e2_cati = '086' AND e2_isec in ('046','109','086','117','113') THEN 1
#'# WHEN e2_cati = '117' AND e2_isec in ('109','086','117','113') THEN 1
#'# WHEN e2_cati = '113' AND e2_isec in ('086','117','113') THEN 1
#'# ELSE 0 END as 'restric_peso'

Rcase <- function(data = choice_complete, condition_level, col_level=3, condition_possib, col_possib=6){
  
  text <- paste0(paste0('(data[,c(col_level)] %in% c("', condition_level,
                        '") & data[,c(col_possib)] %in% ', condition_possib, 
                        collapse = ') | '),')')
  res <- eval(parse(text=text))
  return(res)
}