olndictr: Diccionario de variables del OLN

# #' Elabora tablas de estadísticas de encuestas
# #'
# #' @param df      El resultado de funciones tales surveyy::svyby
# #' @param varlist (string vector) Los nombres de las variables por agregar.
# #' @param src     (string scalar) El nombre de la encuesta.
# #' @param year    (double scalar) El año de la encuesta.
# #' @param month   (double scalar) El mes de la encuesta.
# #'
# #' @return Un tibble expandido con las columnas indicadas en \code{varlist}.
# #'
# #' @export
# #' @importFrom magrittr %>%
# #' @encoding   UTF-8
# #'
# #' @examples
# #' add_varlist(casen_2015, "educ_", src = "casen", year = 2015)
# ftable <- function(x) UseMethod("ftable")
#
# ftable.svyby <- function(args) {
#   # Prólogo ====================================================================
#
#   # Inicializaciones
#   chart  <- list()  # resultados
#   bylist <- list()  # desagregaciones
#
#   # Deduce el número de especificaciones
#   n <- length(args) - 4
#
#   # Completa y corrige los argumentos variables
#   for (i in 1:n) {
#     # Inicializa el resultado para la i-ésima especificación
#     chart[[i]] <- data.frame()
#
#     # Convierte la subpoblación en una expresión
#     args[[i]]$subpop <-
#       args[[i]]$subpop %>%
#       (function(x) parse(text = as.character(x)[2]))
#
#     # Identifica todas las agregaciones posibles (como character-vectors)
#     bylist[[i]] <-
#       args[[i]]$by       %>%
#       all.vars()         %>%
#       sets::as.set()     %>%
#       sets::set_power()  %>%
#       as.list()          %>%
#       lapply(function(x) as.character(x) %>% paste(collapse = '+'))
#     # ¿Por qué no puedo usar as.character en lapply? Preguntar a Camila.
#
#     # Corrige la agregación vacía
#     bylist[[i]][[1]] <- "n_"
#
#     # Identifica todas las agregaciones posibles (como fórmulas)
#     bylist[[i]] <-
#       bylist[[i]] %>%
#       lapply(function(x) paste0(x, collapse = '+')) %>%
#       lapply(function(x) paste0("~", x)) %>%
#       lapply(as.formula)
#   }
#
#   # Cuerpo =====================================================================
#
#   # Notar la jerarquía del loop: año => mes => especificación => agregación
#   for (year in args$years) {
#     for (month in args$months) {
#       # Identifica la BBDD
#       if (args$src == "casen") pattern <- "%s/feather/CASEN %d.feather"
#       if (args$src == "ene")   pattern <- "%s/feather/ENE %d %02d.feather"
#       if (args$src == "esi")   pattern <- "%s/feather/ESI %d.feather"
#       path <- sprintf(pattern, args$data, year, month)
#       if (!file.exists(path)) next
#
#       # Identifica los outputs
#       outputs <- c("psu_", "strata_", "pw_")
#       for (i in 1:n) {
#         outputs <-
#           args[[i]]                 %>%
#           lapply(all.vars)          %>%
#           unlist(use.names = FALSE) %>%
#           c(outputs)                %>%
#           unique()
#       }
#
#       # Identifica y carga los inputs
#       inputs <- mypkgr::oln_find_inputs(outputs, args$src, year, month)
#       df <- feather::read_feather(path, columns = inputs)
#
#       # Genera los outputs
#       df <- df %>%
#         mypkgr::oln_generate(outputs, args$src, year, month) %>%
#         dplyr::select(dplyr::one_of(outputs)) %>%
#         dplyr::mutate(n_ = 1)
#
#       # Declara el diseño muestral
#       df <- survey::svydesign(~psu_,
#                               strata  = ~strata_,
#                               weights = ~pw_,
#                               data    = df)
#
#       # Realiza la estimación, según especificación y desagregación
#       for (i in 1:n) {
#         for (by in bylist[[i]]) {
#           chart0 <-
#             svyby(args[[i]]$formula,
#                   by,
#                   args[[i]]$FUN,
#                   design = subset(df, eval(args[[i]]$subpop, df$variables)),
#                   na.rm             = TRUE,
#                   drop.empty.groups = FALSE,
#                   quantiles         = args$quantiles)
#
#           # Ordena el resultado
#           chart0 <- mypkgr::oln_table_reshape(chart0, args[[i]])
#
#           # Añade los índices temporales
#           chart0 <- dplyr::mutate(chart0, year = year, month = month)
#
#           # Anexa el resultado
#           chart[[i]] <-
#             list(chart0, chart[[i]]) %>%
#             data.table::rbindlist(fill = TRUE)
#         }
#       }
#     }
#   }
#
#   # Epílogo ====================================================================
#
#   # Ajustes cosméticos
#   for (i in 1:n) {
#     # Reetiqueta los NA de los dominios como totales
#     for (by in all.vars(args[[i]][["by"]])) {
#       # Captura las etiquetas de la variable
#       labs <- levels(chart[[i]][[by]])
#
#       # Refactoriza la variable
#       chart[[i]][[by]] <-
#         chart[[i]][[by]] %>%
#         factor(levels  = c(labs, NA),
#                labels  = c(labs, "Total"),
#                exclude = NULL)
#     }
#
#     # Elimina las variables temporales
#     chart[[i]] <- chart[[i]] %>%
#       tibble::as.tibble() %>%
#       dplyr::select(-n_)
#   }
#
#
#   # Reporta el resultado
#   return(chart)
# }
#
# # Ordena los resultados de oln_table_create
# oln_table_reshape <- function(df, args) {
#   # Convierte args$formula en character
#   fm <- as.character(args$formula)[2]
#
#   # Deduce las variables asociadas al bh
#   nm_bh <- attr(df, "svyby")$variables
#   n <- length(nm_bh)
#
#   # Deduce las variables asociadas al se y a los dominios
#   if (n == 1) nm_se <- "se"
#   if (n >= 2) nm_se <- sprintf("se.%s", nm_bh)
#   nm_over <- names(df) %>% setdiff(nm_bh) %>% setdiff(nm_se)
#
#   # Divide df en dos bloques
#   df_bh <- dplyr::select(df, dplyr::one_of(c(nm_over, nm_bh)))
#   df_se <- dplyr::select(df, dplyr::one_of(c(nm_over, nm_se)))
#
#   # Lo que sigue solo tiene sentido si n > 1
#   if (n > 1) {
#     # Ordena los resultados de cada bloque
#     df_bh <- tidyr::gather_(df_bh, fm, "bh", nm_bh, factor_key = TRUE)
#     df_se <- tidyr::gather_(df_se, fm, "se", nm_se, factor_key = TRUE)
#
#     # Ajusta las etiquetas de key
#     labs_bh <- df_bh[[fm]] %>% levels() %>% substring(nchar(fm) + 1)
#     labs_se <- df_se[[fm]] %>% levels() %>% substring(nchar(fm) + 4)
#     df_bh[[fm]] <- factor(df_bh[[fm]], labels = labs_bh)
#     df_se[[fm]] <- factor(df_se[[fm]], labels = labs_se)
#   }
#
#   # Combina las BBDD
#   df <- suppressMessages(dplyr::inner_join(df_bh, df_se))
#
#   # Agrega el cv
#   df[["cv"]] <- 100 * df[["se"]] / abs(df[["bh"]])
#
#   # Presenta los resultados
#   return(df)
# }