R/creacion_insumos.R

Defines functions create_prop create_prop_internal create_ratio_internal create_median create_tot create_tot_con create_mean calcular_medianas_internal calcular_ic calcular_gl_total calcular_estrato calcular_upm chequear_var_disenio calcular_n_total calcular_n calcular_tabla_ratio calcular_tabla unificar_variables_factExp unificar_variables_estrato unificar_variables_upm

Documented in calcular_estrato calcular_gl_total calcular_ic calcular_medianas_internal calcular_n calcular_n_total calcular_tabla calcular_tabla_ratio calcular_upm chequear_var_disenio create_mean create_median create_prop create_prop_internal create_ratio_internal create_tot create_tot_con unificar_variables_estrato unificar_variables_factExp unificar_variables_upm

#-----------------------------------------------------------------------

#' Homologa nombre de variable que hace referencia a los conglomerados, con el objetivo de evitar posible errores.
#'
#' Identifica el nombre de la variable asignada para los conglomerados en el disenio complejo, lo que permite reasignar variable con nombre estandar utilizado por las 4 funciones de creacion de insumos.
#'
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#'
#' @return \code{vector} que contiene la variable con los conglomerados.
#' @import survey


unificar_variables_upm = function(disenio){
  as.character(disenio$call[[names(disenio$call)[grepl("^i",names(disenio$call))]]])[2]

}



#-----------------------------------------------------------------------

#' Homologa nombre de variable que hace referencia a los estratos de conglomerados, con el objetivo de evitar posible errores.
#'
#' Identifica el nombre de la variable asignada para los estratos de conglomerados en el disenio complejo, lo que permite reasignar variable con nombre estandar utilizado por las 4 funciones de creacion de insumos.
#'
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#'
#' @return \code{vector} que contiene la variable con los estratos de conglomerados.
#' @import survey

### funcion par homologar variables estratos ####
unificar_variables_estrato = function(disenio){
  as.character(disenio$call[[names(disenio$call)[grepl("^s",names(disenio$call))]]])[2]
}

#-----------------------------------------------------------------------

#' Homologa nombre de variable que hace referencia al factor de expansion utilizado por el usuario, con el objetivo de evitar posible errores.
#'
#' Identifica el nombre de la variable asignada para el factor de expansion en el disenio complejo, lo que permite reasignar variable con nombre estandar utilizado por las 4 funciones de creacion de insumos.
#'
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#'
#' @return \code{vector} que contiene la variable con los datos del factor de expansion.
#' @import survey

### funcion par homologar variables factor expansion ####
unificar_variables_factExp = function(disenio){
  as.character(disenio$call[[names(disenio$call)[grepl("^w",names(disenio$call))]]])[2]
}

#-----------------------------------------------------------------------

#' Calcula medias a partir de cierta agregacion
#'
#' Genera una tabla con estimaciones para una agregacion determinada
#'
#' @param var variable objetivo dentro de un \code{dataframe}. Debe anteponerse ~
#' @param dominios dominios de estimacion separados por signo +. Debe anteponerse ~
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#' @param media \code{boolean} indicating if the mean must be calculated
#' @return \code{dataframe} que contiene variables de agregacion, variable objetivo y error estandar
#' @import survey

calcular_tabla <-  function(var, dominios, disenio, media = T) {

  # El primer if es para dominios
  if (!is.null(dominios)) {
    if (media == T) { # para calcular la media
      estimacion <- survey::svyby(var ,
                                  design = disenio,
                                  by = dominios,
                                  FUN = svymean)
    } else { # para calcular la mediana

      estimacion <- survey::svyby(var,
                                  by = dominios,
                                  FUN = survey::svyquantile,
                                  design = disenio,
                                  quantile = 0.5,
                                  method="constant",
                                  interval.type = "quantile",
                                  ties="discrete")
    }
  # Esto corresponde al caso sin desagregacion
  } else {
    if (media == T) { # para calcular la media
      estimacion <- survey::svymean(var, disenio)
    } else { # para calcular la mediana

      estimacion <-  svyquantile(var,
                                  design = disenio,
                                  quantile = 0.5,
                                  method="constant",
                                  interval.type = "quantile",
                                  ties="discrete")
    }

  }

  return(estimacion)
}

#-----------------------------------------------------------------------

#' Calcula ratio a partir de cierta agregacion
#'
#' Genera una tabla con estimaciones para una agregacion determinada
#'
#' @param var variable objetivo o numerador del ratio a calcular, dentro de un \code{dataframe}. Debe anteponerse ~
#' @param denominador variable denominador del ratio a calcular, dentro de un \code{dataframe}. Debe anteponerse ~
#' @param dominios dominios de estimacion separados por signo +. Debe anteponerse ~
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#'
#' @return \code{dataframe} que contiene variables de agregacion, variable objetivo y error estandar
#' @import survey

calcular_tabla_ratio <-  function(var,denominador, dominios = NULL, disenio) {
  if (!is.null(dominios)) {
    estimacion <- survey::svyby(var, denominator = denominador,design =  disenio, by = dominios , FUN = svyratio)
  } else {
    estimacion <- survey::svyratio(var, denominator = denominador, design = disenio)
  }
  return(estimacion)
}

#-----------------------------------------------------------------------

#' Calcula tamanio muestral para las medias
#'
#' Genera una tabla con el conteo de cada cada una de los dominios del tabulado.
#' La funcion contempla un caso para proporcion y un caso para promedio
#'
#' @param data \code{dataframe} que contiene los datos que se estan evaluando
#' @param dominios vector de caracteres que contiene los dominios a evaluar
#' @param var string que contiene el nombre de la variable de proporcion que se evalua.
#' @return \code{dataframe} que contiene la frecuencia de todos los dominios a evaluar
#'

calcular_n <- function(data, dominios, var = NULL) {

  # Esto es para el caso de proporcion
  if (is.null(var)) {
    data %>%
      dplyr::group_by(.dots = as.list(dominios)  ) %>%
      dplyr::summarise(n = dplyr::n())
  # Este es el caso de nivel
  } else {
    symbol_var <- rlang::parse_expr(var)
    data %>%
      dplyr::mutate(!!symbol_var := as.numeric(!!symbol_var)) %>% # para prevenir problemas
      dplyr::group_by(.dots = as.list(dominios)) %>%
      dplyr::summarise(n = sum(!!symbol_var))
  }
}

#-----------------------------------------------------------------------
#' Calcula tamanio muestral para la funcion de totales poblacionales
#'
#' Genera una tabla con el conteo de cada cada una de los dominios de las categorias ingresadas.
#'
#' @param x  vector de strings que contiene las variables para las cuales se calcula el tamanio muestra
#' @param datos \code{dataframe} que se esta utilizando. Se extrae del disenio muestral
#' @return \code{dataframe} que contiene la frecuencia de todos los dominios a evaluar
#'

calcular_n_total <- function(x, datos) {
  datos %>%
    dplyr::group_by(.dots = as.list(x)) %>%
    dplyr::count() %>%
    dplyr::rename(variable := x) %>%
    dplyr::mutate(variable = paste0(x, variable))
}

#----------------------------------------------------------------------
#' Chequea que las variables de disenio tengan el nombre correcto
#'
#' Comprueba que las variables de disenio se llamen varstrat y varunit. En caso de que no se cumpla, la ejecucion se detiene y se genera un error
#'
#' @param data \code{dataframe} que contiene la tabla con la cual se esta trabajando
#' @return un mensaje de error
#'


chequear_var_disenio <- function(data) {

  if (sum(grepl(pattern = "varunit" , x = names(data))) == 0) {
    stop("¡La columna que contiene informacion de las UPMs debe llamarse varunit!")
  }

  if (sum(grepl(pattern = "varstrat" , x = names(data))) == 0) {
    stop("¡La columna que contiene informacion de los estratos debe llamarse varstrat!")
  }

}


#-----------------------------------------------------------------------

#' Calcula el numero de UPM
#'
#' Genera una tabla con el conteo de UPM para cada uno de los dominios del tabulado.
#' La columna que contiene la informacion de las UPMs debe llamarse varunit
#' La funcion contempla un caso para proporcion y un caso para promedio
#'
#' @param data \code{dataframe} que contiene los datos que se estan evaluando
#' @param dominios vector de caracteres que contiene los dominios a evaluar
#' @param var string que contiene el nombre de la variable de proporcion que se evalua.
#' @return \code{dataframe} que contiene la frecuencia de todos los dominios a evaluar
#'

calcular_upm <- function(data, dominios, var = NULL ) {

  #Chequear que existe variable varunit en el dataset
  if (sum(grepl(pattern = "varunit" , x = names(data))) == 0) {
    stop("¡La columna que contiene informacion de las UPMs debe llamarse varunit!")
  }


  listado <- c("varunit", as.list(dominios))
  if (is.null(var)) {
    data %>%
      dplyr::group_by(.dots = listado) %>%
      dplyr::summarise(conteo = dplyr::n()) %>%
      dplyr::mutate(tiene_info = dplyr::if_else(conteo > 0, 1, 0))  %>%
      dplyr::group_by(.dots = as.list(dominios)) %>%
      dplyr::summarise(upm = sum(tiene_info))
  } else {
    symbol_var <- rlang::parse_expr(var)
     data %>%
      dplyr::mutate(!!symbol_var := as.numeric(!!symbol_var)) %>%
      dplyr::group_by(.dots = listado) %>%
      dplyr::summarise(conteo = sum(!!symbol_var)) %>%
      dplyr::mutate(tiene_info = dplyr::if_else(conteo > 0, 1, 0))  %>%
      dplyr::group_by(.dots = as.list(dominios)) %>%
      dplyr::summarise(upm = sum(tiene_info))
  }
}
#-----------------------------------------------------------------------

#' Calcula el numero de estratos
#'
#' Genera una tabla con el conteo de estratos para cada uno de los dominios del tabulado.
#' La columna que contiene la informacion de los estratos debe llamarse varstrat
#' La funcion contempla un caso para proporcion y un caso para promedio
#'
#' @param data \code{dataframe} que contiene los datos que se estan evaluando
#' @param var variable objetivo. Debe ser un integer que toma los valores 1 o 0
#' @param dominios vector de caracteres que contiene los dominios a evaluar
#' @return \code{dataframe} que contiene la frecuencia de todos los dominios a evaluar

calcular_estrato <- function(data, dominios, var = NULL ) {

  #Chequear que existe variable varstrat en el dataset
  if (sum(grepl(pattern = "varstrat" , x = names(data))) == 0) {
    stop("¡La columna que contiene informacion de los estratos debe llamarse varstrat!")
  }

  listado <- c("varstrat", as.list(dominios))
  if (is.null(var)) {
    data %>%
      dplyr::group_by( .dots = listado) %>%
      dplyr::summarise(conteo = dplyr::n()) %>%
      dplyr::mutate(tiene_info = dplyr::if_else(conteo > 0, 1, 0)) %>%
      dplyr::group_by(.dots = as.list(dominios)) %>%
      dplyr::summarise(varstrat = sum(tiene_info))
  } else {
    symbol_var <- rlang::parse_expr(var)
     data %>%
      dplyr::mutate(!!symbol_var := as.numeric(!!symbol_var)) %>%
      dplyr::group_by(.dots = listado) %>%
      dplyr::summarise(conteo = sum(!!symbol_var)) %>%
      dplyr::mutate(tiene_info = dplyr::if_else(conteo > 0, 1, 0)) %>%
      dplyr::group_by(.dots = as.list(dominios)) %>%
      dplyr::summarise(varstrat = sum(tiene_info))
  }
}

#----------------------------------------------------------------------------

#' Calcula los grados de libertad para un estimaciones de total
#'
#' Genera una tabla con el conteo de grados de libertad para cada uno de los dominios del tabulado. Es un wrapper que reune a las funciones calcular_upm y calcular_estrato
#'
#' @param datos \code{dataframe} que contiene los datos que se estan evaluando. Se obtiene a partir del disenio muestral
#' @param variables variables objetivo. vector de strings que contiene los nombres de las variables
#' @return \code{dataframe} que contiene la frecuencia de todos los dominios a evaluar

calcular_gl_total <- function(variables, datos) {
  upm <- purrr::map(variables, ~calcular_upm(datos, .x) %>%
               dplyr::rename(variable := dplyr::all_of(.x) ) %>%
               dplyr::mutate(variable = paste0(.x, variable))) %>%
    purrr::reduce(dplyr::bind_rows)

  estratos <- purrr::map(variables, ~calcular_estrato(datos, .x) %>%
                    dplyr::rename(variable := dplyr::all_of(.x) ) %>%
                    dplyr::mutate(variable = paste0(.x, variable))) %>%
    purrr::reduce(dplyr::bind_rows)

  gl <- upm %>%
    dplyr::left_join(estratos, by = "variable") %>%
    dplyr::mutate(gl = upm - varstrat)
  return(gl)

}



#------------------------------

#' Genera intervalos de confianza para todos los dominios estimados
#'
#' Usa la tabla creada para calcular el estandar y le agrega dos columnas con el limite inferior y superior del intervalo de confianza
#'
#' @param data \code{dataframe} con todos los datos necesarios para calcular el estandar
#' @param env \code{environment} toma el ambiente de la funcion contenedora, para usar los elementos requeridos
#' @param tipo \code{string} que indica cual es el tipo de estimacion que se realiza.
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @return \code{dataframe} que contiene todos los elementos del estandar, junto a tres columnas nuevas que contienen el limite inferior, el limite superior y el valor t
#'


calcular_ic <-  function(data, env = parent.frame(), tipo = "resto", ajuste_ene) {

    est <- switch(tipo, "resto" =  get("var", env),
                  "media_agregado" = "mean",
                  "prop_agregado" = "objetivo",
                  "total_agregado" = "total",
                  "mediana_agregado" = "median")

    # Se calculan los intervalos de la manera tradicional en la generalidad de los casos
    if (ajuste_ene == F) {

      final <- data %>%
        dplyr::mutate(t = qt(c(.975), df = gl),
                      li = !!rlang::parse_expr(est) - se*t,
                      ls = !!rlang::parse_expr(est) + se*t)
  # Estos corresponde al ajuste de la ENE: el t se fija en 2
  } else if (ajuste_ene == T) {

    final <- data %>%
      dplyr::mutate(t = 2,
                    li = !!rlang::parse_expr(est) - se*t,
                    ls = !!rlang::parse_expr(est) + se*t)
  }

  return(final)
}


#---------------------------------------------------------------------

#' Calcula medianas con método replicado
#'
#' Se usa para acortar un poco el código de la función mediana
#'
#' @param disenio disenio complejo creado mediante el paquete \code{survey}
#' @param var variable a estimar
#' @param dominios dominios para desagregar
#' @param sub se usa para filtrar cuando el usuario lo requiere
#' @param env ambiente en el cual se crean algunas variable relevantes
#' @return \code{vector} que contiene la variable con los conglomerados.
#' @import iterators



calcular_medianas_internal <- function(var, dominios, disenio, sub = F, env = parent.frame()) {

  #Si el usuario pone una subpoblacion, se hace un filtro en el disenio para agilizar el calculo
  if (sub == T) {
    filtro <-  rlang::parse_expr(get("subpop", env))
    disenio <- subset(disenio,   rlang::eval_tidy(filtro) == 1)

  }

  # Generar un vector con la desagregacion necesaria
  doms <- as.character(dominios)
  doms <- stringr::str_split(doms[[2]], "\\+")
  doms <- stringr::str_remove_all(doms[[1]], " ")

  # Identificar cuales son las categorias de cada una de las variables de desagregacion
  categorias <- purrr::map(doms, ~sort(unique(as.character(disenio$variables[[.x]]) )))

  # Generar el iterador, segun el numero de desagregaciones pedidas por el usuario. Ademas, se calcula el numero de combinaciones de celdas.
  if (length(categorias) == 1) {
    it <- itertools::ihasNext(itertools::product(categorias[[1]]))
    combinaciones <- length(categorias[[1]])

  } else if (length(categorias) == 2) {
    it <- itertools::ihasNext(itertools::product(categorias[[1]], categorias[[2]]))
    combinaciones <- length(categorias[[1]]) * length(categorias[[2]])

  } else if (length(categorias) == 3) {
    it <- itertools::ihasNext(itertools::product(categorias[[1]], categorias[[2]], categorias[[3]] ))
    combinaciones <- length(categorias[[1]]) * length(categorias[[2]]) * length(categorias[[3]])


  } else if (length(categorias) == 4) {
    it <- itertools::ihasNext(itertools::product(categorias[[1]], categorias[[2]], categorias[[3]], categorias[[4]]))
    combinaciones <- length(categorias[[1]]) * length(categorias[[2]]) * length(categorias[[3]], length(categorias[[4]]))


  } else if (length(categorias) == 5) {
    it <- itertools::ihasNext(itertools::product(categorias[[1]], categorias[[2]], categorias[[3]], categorias[[4]], categorias[[5]] ))
    combinaciones <- length(categorias[[1]]) * length(categorias[[2]]) * length(categorias[[3]], length(categorias[[4]], length(categorias[[5]])))

  }

  # Crear una matriz para guardar resultados
  acumulado <- data.frame(matrix(9999, ncol = 3, nrow = combinaciones))

  i <- 1
  while (itertools::hasNext(it)) {
    x <- iterators::nextElem(it)


    exp <- rlang::parse_expr(paste(doms, "==",  x , collapse = " & "))
    output <- tryCatch(
      {
        median <- svyquantile(var,
                              design = subset(disenio, rlang::eval_tidy(exp) ),
                              quantile = 0.5,
                              method="constant",
                              interval.type = "quantile",
                              ties="discrete")
      },
      error=function(cond) {
        return(data.frame(X1 = NA, X2 = NA))
      }

    )

    acumulado[i, ] <- output %>%
      as.data.frame() %>%
      dplyr::mutate(v = paste(x, collapse = "-"))

    i <- i + 1


  }
  final <- acumulado  %>%
    tidyr::separate(into = doms, col = X3 , sep = "-") %>%
    dplyr::rename(se = X2,
                  V1 = X1) %>%
    dplyr::relocate(V1, se, .after = dplyr::last_col())

  return(final)
}

#--------------------------------------------------------------------

#' Create the inputs to make quality evaluation of mean estimations
#'
#' \code{create_mean} generates a \code{dataframe} with the following elements: mean,
#' degrees of freedom, sample size and coefficient of variation. The function allows
#' grouping in several domains.
#'
#' @param var numeric variable within the  \code{dataframe}.
#' @param dominios domains to be estimated separated by the + character.
#' @param subpop integer dummy variable to filter the dataframe
#' @param disenio complex design created by \code{survey} package
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} Indicating if the function is wrapped inside a function, if \code{TRUE} avoid lazy eval errors
#' @import survey
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#'
#' @examples
#' dc <- survey::svydesign(ids = ~varunit, strata = ~varstrat, data = epf_personas, weights = ~fe)
#' create_mean(gastot_hd, zona+sexo,  disenio = dc)
#' @export

create_mean = function(var, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F, standard_eval = F) {

  disenio$variables$varunit = disenio$variables[[unificar_variables_upm(disenio)]]
  disenio$variables$varstrat = disenio$variables[[unificar_variables_estrato(disenio)]]
  disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]


  if(standard_eval == F){

    var <- rlang::enexpr(var)
    var <- rlang::expr_name(var)

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <- rlang::expr_name(dominios)
    }

    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <- rlang::expr_name(subpop)
    }

  }

  # Chequear que la variable no sea character
  if (is.character(disenio$variables[[var]]) == T) stop("¡Estas usando una variable character!")

  #Chequear que la variable sea continua. Si no lo es, aparece un warning
  es_prop <- disenio$variables %>%
    dplyr::mutate(es_prop = dplyr::if_else(!!rlang::parse_expr(var) == 1 | !!rlang::parse_expr(var) == 0, 1, 0))

  if (sum(es_prop$es_prop) == nrow(disenio$variables)) warning("¡Parece que tu variable es de proporcion!")


  #Convertir los inputs en formulas para adecuarlos a survey
  var_form <- paste0("~",var) %>%
    as.formula()

  # ESTO CORRESPONDE AL CASO CON DESAGREGACIoN
  if (!is.null(dominios[[1]])) {

    # Esto corre para el caso en el que NO hay subpop
    if (is.null(subpop)) {

      dominios_form <- paste0("~", dominios) %>%
        as.formula()

      #Generar la tabla con los calculos
      tabla <- calcular_tabla(var_form, dominios_form, disenio)

      # Esto corre para subpop
    } else if (!is.null(subpop)) { # caso que tiene subpop

      # Chequear que la variable de subpop es una dummy. Si no se cumple, se interrumpe la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop) == 1 | !!rlang::parse_expr(subpop) == 0 |
                                                        is.na(!!rlang::parse_expr(subpop)), 1, 0))
      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      dominios_form <-   paste(dominios, subpop, sep = "+")
      dominios_form <- paste0("~", dominios_form) %>%
        as.formula()

      #Generar la tabla con los calculos
      tabla <- calcular_tabla(var_form, dominios_form, disenio) %>%
        dplyr::filter(!!rlang::parse_expr(subpop) == 1)
    }

    #Extraer nombres
    nombres <- names(tabla)
    agrupacion <-  nombres[c(-(length(nombres) - 1), -length(nombres)) ]

    #Calcular el tamanio muestral de cada grupo
    n <- calcular_n(disenio$variables, agrupacion) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    #Calcular los grados de libertad de todos los cruces
    gl <- calcular_upm(disenio$variables, agrupacion) %>%
      dplyr::left_join(calcular_estrato(disenio$variables, agrupacion), by = agrupacion) %>%
      dplyr::mutate(gl = upm - varstrat) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)


    #Extrear el coeficiente de variacion
    cv <- cv(tabla, design = disenio)

    cv <- tabla %>%
      dplyr::select(agrupacion) %>%
      dplyr::bind_cols(coef_var = cv) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    #Unir toda la informacion. Se hace con join para asegurar que no existan problemas en la union
    final <- tabla %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl")),
                       by = agrupacion) %>%
      dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n")),
                       by = agrupacion) %>%
      dplyr::left_join(cv %>% dplyr::select(c(agrupacion, "coef_var")),
                       by = agrupacion)


    # Se calculan los intervalos de confianza solo si el usuario lo requiere

    names(final)[grep(var,names(final))] = "mean"

    if (ci == T) {
      #var_string = var
      final <- calcular_ic(final, tipo = "media_agregado", ajuste_ene = ajuste_ene)
    }



    # ESTO CORRESPONDE AL CASO SIN DESAGREGACIoN
  } else {


    # Si el usuario ingresa subpoblacion, se filtra la base de datos para la subpoblacion de referencia
    if (!is.null(subpop)) {

      # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop) == 1 | !!rlang::parse_expr(subpop) == 0 |
                                                        is.na(!!rlang::parse_expr(subpop)), 1, 0))

      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      # Aqui se filtra el disenio
      # subpop <- rlang::expr_text(rlang::enexpr(subpop))
      # filtro <-  paste(subpop, "== 1")
      # disenio <- subset(disenio, !!rlang::parse_expr(filtro))

      disenio <- disenio[disenio$variables[[subpop]] == 1]
    }

    dominios_form = dominios
    #Generar la tabla con los calculos
    tabla <- calcular_tabla(var_form, dominios_form, disenio)

    # Tamanio muestral
    n <- nrow(disenio$variables)

    # Calcular grados de libertad
    varstrat <- length(unique(disenio$variables$varstrat))
    varunit <- length(unique(disenio$variables$varunit))
    gl <- varunit - varstrat

    # Calcular coeficiente de variacion
    cv <- cv(tabla, design = disenio)

    # Armar tabla final
    final <- data.frame(tabla)

    # Armar tabla completa con todos los insumos
    final <- dplyr::bind_cols(final, "gl" = gl , "n" = n, "coef_var" = cv[1])
    names(final)[2] <- "se"

    # Se calcular el intervalo de confianza solo si el usuario lo pide
    if (ci == T) {
      ##   var_string = var
      final <- calcular_ic(data = final, tipo = "media_agregado",  ajuste_ene = ajuste_ene)
    }


  }

  if(!is.null(dominios) && !is.null(subpop)){
    final = final %>% dplyr::filter(!!rlang::parse_expr(subpop)  == 1) %>% dplyr::select(-!!rlang::parse_expr(subpop))
  }
  return(final)
}


#--------------------------------------------------------------------


#' Create the inputs to make quality evaluation for total estimations of continuous variables
#'
#' \code{create_tot_con} generates a \code{dataframe} with the following elements: sum,
#' degrees of freedom, sample size and coefficient of variation. The function allows
#' grouping in several domains.
#'
#' @param var numeric variable within the  \code{dataframe}.
#' @param dominios domains to be estimated separated by the + character.
#' @param subpop integer dummy variable to filter the dataframe
#' @param disenio complex design created by \code{survey} package
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} Indicating if the function is wrapped inside a function, if \code{TRUE} avoid lazy eval errors
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#'
#' @examples
#' dc <- survey::svydesign(ids = ~varunit, strata = ~varstrat, data = epf_personas, weights = ~fe)
#' create_tot_con(gastot_hd, zona+sexo, subpop = ocupado, disenio = dc)
#' @export

create_tot_con <- function(var, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F, standard_eval = F) {

  # chequear_var_disenio(disenio$variables)

  disenio$variables$varunit = disenio$variables[[unificar_variables_upm(disenio)]]
  disenio$variables$varstrat = disenio$variables[[unificar_variables_estrato(disenio)]]
  disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]


  if(standard_eval == F){

    var <- rlang::enexpr(var)
    var <- rlang::expr_name(var)

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <- rlang::expr_name(dominios)
    }

    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <- rlang::expr_name(subpop)
    }

  }

  # Verificar que la variable de estimacion sea numerica. Se interrumpe si no es numerica
  if (!is.numeric(disenio$variables[[var]]) ) stop("Debes usar una variable numerica")

  # Pasar la variable objetivo al formato de survey
  var_form <- paste0("~", var) %>%
    as.formula()

  # ESTO CORRESPONDE AL CASO EN EL QUE HAY DESAGREGACIoN
  if (!is.null(dominios)) {

    # Esto corre para el caso en el que NO hay subpop
    if (is.null(subpop)) {

      #Identificar las variables ingresadas para la desagregacion
      agrupacion <- dominios %>%
        stringr::str_split(pattern = "\\+")

      agrupacion <- stringr::str_remove_all(string =  agrupacion[[1]], pattern = " ")
      agrup1 <- c(agrupacion, var)

      # Agregar ~ para adecuar a formato de survey
      dominios_form <- paste0("~", dominios) %>%
        as.formula()

      # Esto corre para subpop
    } else if (!is.null(subpop)) { # caso que tiene subpop

      # Chequear que la variable de subpop es una dummy. Si no se cumple, se interrumpe la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))

      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      #Identificar las variables ingresadas para la desagregacion
      agrupacion <- dominios %>%
        stringr::str_split(pattern = "\\+")
      agrupacion <- stringr::str_remove_all(string =  agrupacion[[1]], pattern = " ")
      agrupacion <- c(subpop, agrupacion)
      agrup1 <- c(agrupacion, var)


      dominios_form <- paste(subpop, dominios, sep =  "+")
      dominios_form <- paste0("~", dominios_form) %>%
        as.formula()
    }

    tabla <- survey::svyby(formula = var_form, by = dominios_form, design = disenio, FUN = survey::svytotal)

    gl <- calcular_upm(disenio$variables, agrupacion) %>%
      dplyr::left_join(calcular_estrato(disenio$variables, agrupacion), by = agrupacion) %>%
      dplyr::mutate(gl = upm - varstrat)  %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    cv <- survey::cv(tabla, design = disenio) %>%
      as.data.frame() %>%
      tibble::rownames_to_column(var = "variable") %>%
      tidyr::separate(variable, agrupacion) %>%
      dplyr::rename(coef_var = ".") %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::mutate(coef_var = coef_var)

    n <- calcular_n(disenio$variables, dominios = agrupacion) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    # Unir todo y generar la tabla final
    final <- tabla %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n")),
                       by = agrupacion) %>%
      dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl")),
                       by = agrupacion) %>%
      dplyr::left_join(cv, by = agrupacion)


    names(final)[grep(var,names(final))] = "total"

    #Se calculan los intervalos de confianza solo si el usuario lo requiere
    if (ci == T) {
      final <- calcular_ic(final, tipo = "total_agregado",ajuste_ene = ajuste_ene)
    }


    # ESTE ES EL CASO NO AGREGADO
  } else {

    tabla <- survey::svytotal(x = var_form, design = disenio )

    # Tabla con los totales
    totales <- as.data.frame(tabla) %>%
      tibble::rownames_to_column(var = "variable") %>%
      dplyr::rename(se = var)


    # Tamanio muestral
    n <- nrow(disenio$variables) %>%
      as.data.frame() %>%
      dplyr::mutate(variable = var) %>%
      dplyr::rename(n = ".")

    # Grados de libertad
    upm <- length(unique(disenio$variables$varunit))
    varstrat <- length(unique(disenio$variables$varstrat))
    gl <- cbind(upm, varstrat)
    gl <- gl %>%
      as.data.frame() %>%
      dplyr::mutate(variable = var,
                    gl =  upm - varstrat)

    # Coeficiente de variacion
    cv <- cv(tabla, design = disenio)
    cv <- as.data.frame(cv) %>%
      tibble::rownames_to_column(var = "variable") %>%
      dplyr::rename(coef_var = var)

    # COnstruir tabla final
    final <- totales %>%
      dplyr::left_join(n, by = "variable") %>%
      dplyr::left_join(gl %>% dplyr::select(-upm, -varstrat), by = "variable") %>%
      dplyr::left_join(cv, by = "variable")


    # Se calcula el intervalo de confianza solo si el usuario lo pide
    if (ci == T) {
      final <- calcular_ic(data = final, tipo = "total_agregado",  ajuste_ene = ajuste_ene)
    }

  }
  if(!is.null(dominios) && !is.null(subpop)){
    final = final %>% dplyr::filter(!!rlang::parse_expr(subpop) == 1) %>% dplyr::select(-!!rlang::parse_expr(subpop))
  }

  return(final)
}


#--------------------------------------------------------------------


#' Create the inputs to make quality evaluation for total estimations
#'
#' \code{create_tot} generates a \code{dataframe} with the following elements: sum,
#' degrees of freedom, sample size and coefficient of variation. The function allows
#' grouping in several domains.
#' @param var numeric variable within the  \code{dataframe}. When the domain parameter is not used,
#' it is possible to include more than one variable using the + separator. When a value is introduced
#' in the domain parameter, the estimation variable must be a dummy variable.
#' @param dominios domains to be estimated separated by the + character.
#' @param subpop integer dummy variable to filter the dataframe
#' @param disenio complex design created by \code{survey} package
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} Indicating if the function is wrapped inside a function, if \code{TRUE} avoid lazy eval errors
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#' @import tidyr
#' @examples
#' dc <- survey::svydesign(ids = ~varunit, strata = ~varstrat, data = epf_personas, weights = ~fe)
#' create_tot(ocupado, zona+sexo, disenio = dc)
#' @export

create_tot <- function(var, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F, standard_eval = F) {

  disenio$variables$varunit = disenio$variables[[unificar_variables_upm(disenio)]]
  disenio$variables$varstrat = disenio$variables[[unificar_variables_estrato(disenio)]]
  disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]

  if(standard_eval == F){

    var <- rlang::enexpr(var)
    var <- rlang::expr_name(var)

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <- rlang::expr_name(dominios)
    }

    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <- rlang::expr_name(subpop)
    }

  }


  # ESTO CORRESPONDE AL CASO CON DESAGREGACIoN
  if (!is.null(dominios)) {

    # Verificar que la variabe de entrada es correcta
    if (!is.numeric(disenio$variables[[var]])) stop("¡La variable debe ser numerica!")

    # Verificar que la variable es dummy
    test <- disenio$variable %>%
      dplyr::mutate(test = dplyr::if_else(!!rlang::parse_expr(var) == 1 | !!rlang::parse_expr(var) == 0, 1, 0)) %>%
      dplyr::summarise(pasa = sum(test))

    n_filas <- nrow(disenio$variable)
    if (n_filas != test$pasa) stop("¡Debes usar una variable dummy cuando desagregas!")

    # Esto corre para el caso en el que NO hay subpop
    if (is.null(subpop)) {

      #Identificar las variables ingresadas para la desagregacion
      agrupacion <- dominios %>%
        stringr::str_split(pattern = "\\+")
      agrupacion <- stringr::str_remove_all(string =  agrupacion[[1]], pattern = " ")
      agrup1 <- c(agrupacion, var)

      # Agregar ~ para adecuar a formato de survey
      dominios_form <- paste0("~", dominios) %>%
        as.formula()

      # Esto corre para subpop
    } else if (!is.null(rlang::enexpr(subpop))) { # caso que tiene subpop

      # Chequear que la variable de subpop es una dummy. Si no se cumple, se interrumpe la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))
      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      #Identificar las variables ingresadas para la desagregacion
      agrupacion <- dominios %>%
        stringr::str_split(pattern = "\\+")
      agrupacion <- stringr::str_remove_all(string =  agrupacion[[1]], pattern = " ")
      agrupacion <- c(subpop, agrupacion  )
      agrup1 <- c(agrupacion, var)

      #dominios_form <- paste(agrupacion, "+")
      dominios_form <- paste(subpop, dominios, sep =  "+")
      dominios_form <- paste0("~", dominios_form) %>%
        as.formula()

    }
    # Pasar a la variable objetivo al formato de survey
    var_form <- paste0("~",var) %>%
      as.formula()

    # Generar la tabla de estimaciones
    tabla <- survey::svyby(formula = var_form, by = dominios_form, design = disenio, FUN = survey::svytotal)

    gl <- calcular_upm(disenio$variables, agrup1) %>%
      dplyr::left_join(calcular_estrato(disenio$variables, agrup1), by = agrup1) %>%
      dplyr::mutate(gl = upm - varstrat)  %>%
      dplyr::filter(!!rlang::parse_expr(var) == 1)  %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)


    cv <- survey::cv(tabla, design = disenio) %>%
      as.data.frame() %>%
      tibble::rownames_to_column(var = "variable") %>%
      tidyr::separate(variable, agrupacion) %>%
      dplyr::rename(coef_var = ".") %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::mutate(coef_var = coef_var)


    n <- calcular_n(disenio$variables, dominios = agrup1) %>%
      dplyr::filter(!!rlang::parse_expr(var) == 1) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    # Unir todo y generar la tabla final
    final <- tabla %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n")),
                       by = agrupacion) %>%
      dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl")),
                       by = agrupacion) %>%
      dplyr::left_join(cv, by = agrupacion)

    names(final)[grep(var,names(final))] = "total"

    #Se calculan los intervalos de confianza solo si el usuario lo requiere
    if (ci == T) {
      final <- calcular_ic(final, tipo = "total_agregado",ajuste_ene = ajuste_ene)
    }

    # ESTO CORRESPONDE AL CASO SIN DESAGRAGACIoN
  } else {

    n_cat = length(unique(disenio$variable[[var]]))

    if (n_cat > 50 ) stop("¡La variable puede ser continua, posee mas de 50 categorias!")


    # Identificar las variables ingresadas por el usuario
    agrupacion <- var %>%
      stringr::str_split(pattern = "\\+")
    agrup1 <- stringr::str_remove_all(string =  agrupacion, pattern = " ")


    # Convertir variables a string. Esto se hace debido a que survey tiene distintos tratamientos para variables numericas o de string
    disenio <- survey::svydesign(ids = ~varunit, strata = ~varstrat,
                                 data = disenio$variables %>% dplyr::mutate_at(.vars = dplyr::vars(agrup1), list(as.character)),
                                 weights = ~fe)

    # Acomodar a formato de survey
    var_form <- paste0("~",var) %>%
      as.formula()

    # Si el usuario ingresa subpoblacion, se filtra la base de datos para la subpoblacion de referencia
    if (!is.null(subpop)) {

      # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))
      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      # Aqui se filtra el disenio
      disenio <- disenio[disenio$variables[[subpop]] == 1]

    }

    # Tabla que se usa luego para calcular cv
    tabla <- survey::svytotal(x = var_form, design = disenio )

    # Tabla con los totales
    totales <- as.data.frame(tabla) %>%
      tibble::rownames_to_column(var = "variable") %>%
      dplyr::rename(se = SE)

    # Tamanio muestral
    n <- purrr::map(agrup1, calcular_n_total, datos = disenio$variables) %>%
      purrr::reduce(dplyr::bind_rows)

    # Grados de libertad
    gl <- calcular_gl_total(agrup1, disenio$variables)

    #Extrear el coeficiente de variacion
    cv <- cv(tabla, design = disenio)
    cv <- as.data.frame(cv) %>%
      tibble::rownames_to_column(var = "variable") %>%
      dplyr::rename(coef_var = cv)

    # COnstruir tabla final
    final <- totales %>%
      dplyr::left_join(n, by = "variable") %>%
      dplyr::left_join(gl %>% dplyr::select(-upm, -varstrat), by = "variable") %>%
      dplyr::left_join(cv, by = "variable")


    # Se calcula el intervalo de confianza solo si el usuario lo pide
    if (ci == T) {
      final <- calcular_ic(data = final, tipo = "total_agregado",  ajuste_ene = ajuste_ene)

    }

  }

  # Las filas en las que no exsiten casos generan valores NA. Esos casos se eliminan
  names(final) <- tolower(names(final))
  final <- final %>%
    dplyr::filter(!is.nan(coef_var))


  if(!is.null(dominios) && !is.null(subpop)){
    final = final %>% dplyr::filter(!!rlang::parse_expr(subpop)  == 1) %>% dplyr::select(-!!rlang::parse_expr(subpop))
  }

  return(final)
}


#-----------------------------------------------------------------------


#' Create the inputs to make quality evaluation for median estimations
#'
#' \code{create_median} uses a non parametric method to generate a \code{dataframe}
#' with the following elements: sum, degrees of freedom, sample size and coefficient
#' of variation. The function allows grouping in several domains.
#'
#' @param var numeric variable within the  \code{dataframe}
#' @param dominios domains to be estimated separated by the + character.
#' @param subpop integer dummy variable to filter the dataframe
#' @param disenio complex design created by \code{survey} package
#' @param replicas \code{integer} indicating the number of replicates to be used
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} Indicating if the function is wrapped inside a function, if \code{TRUE} avoid lazy eval errors
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#' @import itertools
#' @examples
#' dc <- survey::svydesign(ids = ~varunit, strata = ~varstrat, data = epf_personas, weights = ~fe)
#' dc_rep <-  survey::as.svrepdesign(dc , type = "subbootstrap", replicates=10)
#' create_median(gastot_hd, zona+sexo, disenio = dc)
#' @export


create_median <- function(var, dominios = NULL, subpop = NULL, disenio, ci = F, replicas = 10,  ajuste_ene = F,standard_eval = F) {

  # Ajustar nombre de variables del disenio muestral
  disenio$variables$varunit = disenio$variables[[unificar_variables_upm(disenio)]]
  disenio$variables$varstrat = disenio$variables[[unificar_variables_estrato(disenio)]]
  disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]

  if(standard_eval == F){

    var <- rlang::enexpr(var)
    var <- rlang::expr_name(var)

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <- rlang::expr_name(dominios)
    }

    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <- rlang::expr_name(subpop)
    }

  }


  # Arreglar las variables de diseño para que tengan menos números.
  # Esto solo se hace si la variable de conglomerados es muy larga
  if (nchar(as.character(disenio$variables))[1] >= 5) {
    keys <- disenio$variables %>%
      dplyr::group_by(varunit) %>%
      dplyr::slice(1) %>%
      dplyr::ungroup() %>%
      dplyr::mutate(varunit2 = dplyr::row_number()) %>%
      dplyr::select(varunit2, varunit)

    disenio$variables <- disenio$variables %>%
      dplyr::left_join(keys, by = "varunit") %>%
      dplyr::select(-varunit) %>%
      dplyr::rename(varunit = varunit2)

    # Volver a declarar el diseño normal
    disenio <- survey::svydesign(ids = ~varunit, strata = ~varstrat, weights = ~fe, data = disenio$variables)

  }

  # Generar el disenio replicado
  set.seed(1234)
  disenio <-  survey::as.svrepdesign(disenio, type = "subbootstrap", replicates = replicas)

  # Chequear que la variable no sea character
  if (is.character(disenio$variables[[var]]) == T) stop("¡Estas usando una variable character!")

  #Chequear que la variable sea continua. Si no lo es, aparece un warning
  es_prop <- disenio$variables %>%
    dplyr::mutate(es_prop = dplyr::if_else(!!rlang::parse_expr(var) == 1 | !!rlang::parse_expr(var) == 0, 1, 0))

  if (sum(es_prop$es_prop) == nrow(disenio$variables)) warning("¡Parece que tu variable es de proporcion!")


  #Convertir los inputs en formulas para adecuarlos a survey
  var_form <- paste0("~", var) %>%
    as.formula()

  # ESTO CORRESPONDE AL CASO CON DESAGREGACIoN
  if (!is.null(dominios)) {

    # Esto corre para el caso en el que NO hay subpop
    if (is.null(subpop)) {

      dominios_form <- paste0("~",dominios) %>%
        as.formula()

      #Generar la tabla con los calculos

      tabla <- calcular_medianas_internal(var_form, dominios_form, disenio)

      # Esto corre para subpop
    } else if (!is.null(subpop)) { # caso que tiene subpop

      # Chequear que la variable de subpop es una dummy. Si no se cumple, se interrumpe la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop) == 1 | !!rlang::parse_expr(subpop) == 0 |
                                                        is.na(!!rlang::parse_expr(subpop)), 1, 0))

      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      # Agregar a los dominios, la variable subpop
      dominios_form <-   paste(dominios, subpop, sep = "+")
      dominios_form <- paste0("~", dominios_form) %>%
        as.formula()

      #Generar la tabla con los calculos

      tabla <- calcular_medianas_internal(var_form, dominios_form, disenio, sub = T)

    }

    #Extraer nombres
    nombres <- names(tabla)
    agrupacion <-  nombres[c(-(length(nombres) - 1), -length(nombres)) ]

    #Calcular el tamanio muestral de cada grupo
    n <- calcular_n(disenio$variables, agrupacion) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    #Calcular los grados de libertad de todos los cruces
    gl <- calcular_upm(disenio$variables, agrupacion) %>%
      dplyr::left_join(calcular_estrato(disenio$variables, agrupacion), by = agrupacion) %>%
      dplyr::mutate(gl = upm - varstrat) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)


    #Extrear el coeficiente de variacion
    #cv <- cv(tabla, design = disenio)
    cv <- tabla$se / tabla$V1

    cv <- tabla %>%
      dplyr::select(agrupacion) %>%
      dplyr::bind_cols(coef_var = cv) %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character)

    #Unir toda la informacion. Se hace con join para asegurar que no existan problemas en la union
    final <- tabla %>%
      dplyr::mutate_at(.vars = dplyr::vars(agrupacion), .funs = as.character) %>%
      dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl")),
                       by = agrupacion) %>%
      dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n")),
                       by = agrupacion) %>%
      dplyr::left_join(cv %>% dplyr::select(c(agrupacion, "coef_var")),
                       by = agrupacion) %>%
      dplyr::rename(!!rlang::parse_expr(var) := V1)

    names(final)[grep(var,names(final))] = "median"

    # Se calculan los intervalos de confianza solo si el usuario lo requiere
    if (ci == T) {
      final <- calcular_ic(final, tipo = "mediana_agregado",ajuste_ene = ajuste_ene)
    }

    # ESTO CORRESPONDE AL CASO SIN DESAGREGACIoN
  } else {


    # Si el usuario ingresa subpoblacion, se filtra la base de datos para la subpoblacion de referencia
    if (!is.null(subpop)) {

      # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop) == 1 | !!rlang::parse_expr(subpop) == 0 |
                                                        is.na(!!rlang::parse_expr(subpop)), 1, 0))

      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      disenio <- disenio[disenio$variables[[subpop]] == 1]
    }

    dominios_form = dominios
    #Generar la tabla con los calculos
    tabla <- calcular_tabla(var_form, dominios_form, disenio, media = F)

    # Tamanio muestral
    n <- nrow(disenio$variables)

    # Calcular grados de libertad
    varstrat <- length(unique(disenio$variables$varstrat))
    varunit <- length(unique(disenio$variables$varunit))
    gl <- varunit - varstrat

    # Calcular coeficiente de variacion
    cv <- cv(tabla, design = disenio)

    # Armar tabla final
    final <- data.frame(tabla )

    # Armar tabla completa con todos los insumos
    final <- dplyr::bind_cols(final, "gl" = gl , "n" = n, "coef_var" = cv[1])
    names(final)[2] <- "se"

    names(final)[grep("quantiles",names(final))] = "median"

    # Se calcular el intervalo de confianza solo si el usuario lo pide
    if (ci == T) {
      final <- calcular_ic(data = final, tipo = "mediana_agregado",  ajuste_ene = ajuste_ene)
    }

  }

  # Filtrar filas que no son utiles
  if(!is.null(dominios) && !is.null(subpop)){
    final <-  final %>%
      dplyr::filter(!!rlang::parse_expr(subpop)  == 1) %>%
      dplyr::select(-!!rlang::parse_expr(subpop))
  }

  return(final)

}


#-----------------------------------------------------------------------

#' internal function to calculate ratios estimations
#'
#' @param var numeric variable within the \code{dataframe}, is the numerator of the ratio to be calculated.
#' @param denominador numeric variable within the \code{dataframe}, is the denominator of the ratio to be calculated.
#' @param dominios domains to be estimated separated by the + character.
#' @param disenio complex design created by \code{survey} package
#' @param subpop integer dummy variable to filter the dataframe
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} indicating if the function is inside another function, by default it is TRUE, avoid problems with lazy eval.
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#'
create_ratio_internal <- function(var,denominador, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F) {
# Chequar que esten presentes las variables del disenio muestral. Si no se llaman varstrat y varunit, se
#  detiene la ejecucion
# chequear_var_disenio(disenio$variables)
disenio$variables$varunit <- disenio$variables[[unificar_variables_upm(disenio)]]
disenio$variables$varstrat <- disenio$variables[[unificar_variables_estrato(disenio)]]
disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]


### filtramos base de diseño por los casos que tengan datos tanto del denominador como del numerador. para
### calcular correctamente los GL y N
disenio <- disenio[disenio$variables[[var]] != 0 | disenio$variables[[denominador]] != 0]

# Chequear que la variable no sea character
if (is.character(disenio$variables[[var]]) == T) stop("¡Estas usando una variable character!")

# Chequear que la variable no sea character
if (is.character(disenio$variables[[denominador]]) == T) stop("¡Estas usando una variable para el denominador de character!")

#Convertir los inputs en formulas para adecuarlos a survey
var <- paste0("~", var) %>%
  as.formula()

#Convertir los inputs en formulas para adecuarlos a survey
denominador <- paste0("~", denominador) %>%
  as.formula()

# CON DESAGREGACIoN
if (!is.null(dominios[[1]])) {

  # Sin subpop #
  if (is.null(subpop)) {
    dominios <- paste0("~", dominios) %>%
      as.formula()

    # con subpop
  } else if (!is.null(subpop)) { # caso que tiene subpop

    dominios <- paste(dominios, subpop, sep = "+")
    dominios <- paste0("~", dominios) %>%
      as.formula()
  }

  #Generar la tabla con los calculos
  tabla <- calcular_tabla_ratio(var, denominador, dominios, disenio)

  #Extraer nombres
  nombres <- names(tabla)
  agrupacion <-  nombres[c(-(length(nombres) - 1), -length(nombres)) ]
  var_ratio <- nombres[length(nombres) - 1]

  #+ Calcular N
  n <- calcular_n(disenio$variables, agrupacion) %>%
    dplyr::mutate_at(dplyr::vars(agrupacion), as.character)

  #+ Calcular GL de todos los cruces
  gl <- calcular_upm(disenio$variables, agrupacion) %>%
    dplyr::left_join(calcular_estrato(disenio$variables, agrupacion), by = agrupacion) %>%
    dplyr::mutate(gl = upm - varstrat) %>%
    dplyr::mutate_at(dplyr::vars(agrupacion), as.character)

  #+ Calcurar CV
  tabla$cv = survey::cv(tabla)

  #* * Armar tabla final
  final <- tabla %>%
    dplyr::mutate_at(dplyr::vars(agrupacion), as.character) %>%
    dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl" )),
                     by = agrupacion) %>%
    dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n" )),
                     by = agrupacion)


  #Cambiar el nombre de la variable objetivo para que siempre sea igual.
  final <- final  %>%
    dplyr::rename(objetivo = var_ratio) %>%
    dplyr::filter(objetivo > 0) # se eliminan los ceros de la tabla

  names(final)[grep("objetivo",names(final)) +1] = "se"

  #¿ intervalos de confianza solo si el usuario lo requiere
  if (ci == T) {
    final <- calcular_ic(final,tipo = "prop_agregado",  ajuste_ene = ajuste_ene)
  }

  # SIN DESAGREGACIoN #
} else {

  # Con subpobp
  if (!is.null(subpop)) {

    # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
    es_prop <- disenio$variables %>%
      dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))
    if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

    # Aqui se filtra el disenio
    #  subpop_text <- rlang::expr_text(rlang::enexpr(subpop))
    disenio <- disenio[disenio$variables[[subpop]] == 1]

  }

  #Generar la tabla con los calculos
  tabla <- calcular_tabla_ratio(var, denominador, dominios, disenio)

  #+ Calcular N
  n <- nrow(disenio$variables)

  #+ Calcular GL
  varstrat <- length(unique(disenio$variables$varstrat))
  varunit <- length(unique(disenio$variables$varunit))
  gl <- varunit - varstrat

  #+ Calcular CV
  cv <- cv(tabla, design = disenio)

  #* * Armar tabla final
  final <- data.frame(tabla$ratio,survey::SE(tabla))
  final$cv = cv[1]
  names(final) = c("objetivo", "se","cv")

  # Armar tabla completa con todos los insumos
  final <- dplyr::bind_cols(final, "gl" = gl, "n" = n)
  #names(final)[2] <- "se"

  ##Cambiar el nombre de la variable objetivo para que siempre sea igual
  #final <- final %>%
  #  dplyr::rename(objetivo = mean)

  #¿  intervalo de confianza solo si el usuario lo pide
  if (ci == T) {
    final <- calcular_ic(data = final, tipo = "prop_agregado",  ajuste_ene = ajuste_ene)

  }

}

if(!is.null(dominios) && !is.null(subpop)){

  final = final %>% dplyr::filter(!!rlang::parse_expr(subpop)  == 1) %>% dplyr::select(-!!rlang::parse_expr(subpop))

}

return(final)

}

#-----------------------------------------------------------------------


#' internal function to calculate proportion estimations
#'
#' @param var integer dummy variable within the  \code{dataframe}
#' @param dominios domains to be estimated separated by the + character.
#' @param subpop integer dummy variable to filter the dataframe
#' @param disenio complex design created by \code{survey} package
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} indicating if the function is inside another function, by default it is TRUE, avoid problems with lazy eval.
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#'

create_prop_internal <- function(var, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F, standard_eval = T){

  # Chequar que esten presentes las variables del disenio muestral. Si no se llaman varstrat y varunit, se
  #  detiene la ejecucion
  # chequear_var_disenio(disenio$variables)
  disenio$variables$varunit = disenio$variables[[unificar_variables_upm(disenio)]]
  disenio$variables$varstrat = disenio$variables[[unificar_variables_estrato(disenio)]]
  disenio$variables$fe = disenio$variables[[unificar_variables_factExp(disenio)]]

  if (standard_eval == F){
    #  # Encapsular inputs para usarlos mas tarde
    var <- rlang::enexpr(var)
    var <-  rlang::expr_name(var)

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <-  rlang::expr_name(dominios)
    }

    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <-  rlang::expr_name(subpop)
    }

  }

  if (is.character(disenio$variables[[var]]) == T) stop("¡Estas usando una variable character!")

  #Chequear que la variable sea de proporcion. Si no lo es, se interrumpe la ejecucion
  es_prop <- disenio$variables %>%
    dplyr::mutate(es_prop_var = dplyr::if_else(!!rlang::parse_expr(var) == 1 | !!rlang::parse_expr(var)  == 0 | is.na(!!rlang::parse_expr(var)), 1, 0))

  if (sum(es_prop$es_prop_var) != nrow(es_prop)) stop("¡La variable no es de proporcion!")

  #COnvertir los inputs en formulas para adecuarlos a survey
  var <- paste0("~", var) %>%
    as.formula()

  # ESTO CORRESPONDE AL CASO CON DESAGREGACIoN
  if (!is.null(dominios[[1]])) {

    # Esto corre para el caso en el que NO hay subpop
    if (is.null(subpop)) {
      dominios <- paste0("~", dominios) %>%
        as.formula()

      # Esto corre para subpop
    } else if (!is.null(subpop)) { # caso que tiene subpop

      # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))

      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      dominios <- paste(dominios, subpop, sep = "+")
      dominios <- paste0("~", dominios) %>%
        as.formula()
    }

    #Generar la tabla con los calculos
    tabla <- calcular_tabla(var, dominios, disenio)

    #Extraer nombres
    nombres <- names(tabla)
    agrupacion <-  nombres[c(-(length(nombres) - 1), -length(nombres)) ]
    var_prop <- nombres[length(nombres) - 1]

    #Calcular el tamanio muestral de cada grupo
    n <- calcular_n(disenio$variables, agrupacion) %>%
      dplyr::mutate_at(dplyr::vars(agrupacion), as.character)

    #Calcular los grados de libertad de todos los cruces
    gl <- calcular_upm(disenio$variables, agrupacion) %>%
      dplyr::left_join(calcular_estrato(disenio$variables, agrupacion), by = agrupacion) %>%
      dplyr::mutate(gl = upm - varstrat) %>%
      dplyr::mutate_at(dplyr::vars(agrupacion), as.character)


    tabla$cv <- cv(tabla)

    #Unir toda la informacion. Se hace con join para asegurar que no existan problemas en la union
    final <- tabla %>%
      dplyr::mutate_at(dplyr::vars(agrupacion), as.character) %>%
      dplyr::left_join(gl %>% dplyr::select(c(agrupacion, "gl" )),
                       by = agrupacion) %>%
      dplyr::left_join(n %>% dplyr::select(c(agrupacion, "n" )),
                       by = agrupacion)
    var_string = var


    #Cambiar el nombre de la variable objetivo para que siempre sea igual.
    final <- final  %>%
      dplyr::rename(objetivo = var_prop) %>%
      dplyr::filter(objetivo > 0) # se eliminan los ceros de la tabla


    #Se calculan los intervalos de confianza solo si el usuario lo requiere
    if (ci == T) {
      final <- calcular_ic(final,tipo = "prop_agregado",  ajuste_ene = ajuste_ene)
    }


    # ESTO CORRESPONDE AL CASO SIN DESAGREGACIoN
  } else {

    # Si el usuario ingresa subpoblacion, se filtra la base de datos para la subpoblacion de referencia
    if (!is.null(subpop)) {

      # Chequear que subpop sea una variable dummy. Si no se cumple, se detiene la ejecucion
      es_prop <- disenio$variables %>%
        dplyr::mutate(es_prop_subpop = dplyr::if_else(!!rlang::parse_expr(subpop)  == 1 | !!rlang::parse_expr(subpop) == 0, 1, 0))
      if (sum(es_prop$es_prop_subpop) != nrow(es_prop)) stop("¡subpop debe ser dummy!")

      # Aqui se filtra el disenio
      #  subpop_text <- rlang::expr_text(rlang::enexpr(subpop))
      disenio <- disenio[disenio$variables[[subpop]] == 1]

    }

    #Generar la tabla con los calculos
    tabla <- calcular_tabla(var, dominios, disenio)

    # Tamanio muestral
    n <- nrow(disenio$variables)

    # Calcular grados de libertad
    varstrat <- length(unique(disenio$variables$varstrat))
    varunit <- length(unique(disenio$variables$varunit))
    gl <- varunit - varstrat

    # Calcular CV
    cv <- cv(tabla)

    # Armar tabla final
    final <- data.frame(tabla[1],survey::SE(tabla))
    final$cv = cv[1]
    names(final) = c("objetivo", "se","cv")

    # Armar tabla completa con todos los insumos
    final <- dplyr::bind_cols(final, "gl" = gl, "n" = n)
    names(final)[2] <- "se"

    #Cambiar el nombre de la variable objetivo para que siempre sea igual
    # final <- final %>%
    #  dplyr::rename(objetivo = mean)

    # Se calcula el intervalo de confianza solo si el usuario lo pide
    if (ci == T) {
      final <- calcular_ic(data = final, tipo = "prop_agregado",  ajuste_ene = ajuste_ene)

    }

  }

  if(!is.null(dominios) && !is.null(subpop)){
    final = final %>% dplyr::filter(!!rlang::parse_expr(subpop)  == 1) %>% dplyr::select(-!!rlang::parse_expr(subpop))
  }

  return(final)

}


#-----------------------------------------------------------------------


#' \code{create_prop} generates a \code{dataframe} with the following elements: sum,
#' degrees of freedom, sample size, standard error and coefficient of variation. The function allows
#' grouping in several domains.
#'
#' @param var numeric variable within the \code{dataframe}, is the numerator of the ratio to be calculated.
#' @param denominador numeric variable within the \code{dataframe}, is the denominator of the ratio to be calculated. If the \code{var} parameter is dummy, it can be NULL
#' @param dominios domains to be estimated separated by the + character.
#' @param disenio complex design created by \code{survey} package
#' @param subpop integer dummy variable to filter the dataframe
#' @param ci \code{boolean} indicating if the confidence intervals must be calculated
#' @param ajuste_ene \code{boolean} indicating if an adjustment for the sampling-frame transition period must be used
#' @param standard_eval \code{boolean} Indicating if the function is wrapped inside a function, if \code{TRUE} avoid lazy eval errors
#' @return \code{dataframe} that contains the inputs and all domains to be evaluated
#'
#' @examples
#' library(survey)
#' library(dplyr)
#' epf <- mutate(epf_personas, gasto_zona1 = if_else(zona == 1, gastot_hd, 0))
#' dc <- svydesign(ids = ~varunit, strata = ~varstrat, data = epf, weights = ~fe)
#' create_prop(var = gasto_zona1, denominador = gastot_hd, disenio =  dc)
#'
#' enusc <- filter(enusc, Kish == 1)
#' enusc <- mutate(enusc, muj_insg_taxi = if_else(P9_4_1 %in% c(1,2) & rph_sexo == 2,1 ,0),
#'                                        hom_insg_taxi = if_else(P9_4_1 %in% c(1,2) & rph_sexo == 1,1 ,0))
#' dc <- svydesign(ids = ~Conglomerado, strata = ~VarStrat, data = enusc, weights = ~Fact_Pers)
#' options(survey.lonely.psu = "certainty")
#' create_prop(var = muj_insg_taxi, denominador = hom_insg_taxi, disenio = dc)
#'
#'
#' @export
#'

create_prop = function(var, denominador = NULL, dominios = NULL, subpop = NULL, disenio, ci = F, ajuste_ene = F,standard_eval = F){

  #  # Encapsular inputs para usarlos mas tarde
  if(standard_eval == F){

    var <- rlang::enexpr(var)
    var <- rlang::expr_name(var)

    denominador <- rlang::enexpr(denominador)
    if(!is.null(denominador)){
      denominador <-  rlang::expr_name(denominador)
    }

    dominios <- rlang::enexpr(dominios)
    if(!is.null(dominios)){
      dominios <- rlang::expr_name(dominios)
    }
    subpop <- rlang::enexpr(subpop)
    if(!is.null(subpop)){
      subpop <- rlang::expr_name(subpop)
    }
  }

  if(!is.null(denominador)){
    final = create_ratio_internal(var,denominador, dominios, subpop, disenio, ci, ajuste_ene)
  }

  if(is.null(denominador)){
    final = create_prop_internal(var, dominios, subpop, disenio, ci, ajuste_ene)
  }
  return(final)
}
Klauslehmann/calidad documentation built on May 1, 2021, 6:35 a.m.