olndictr: Diccionario de variables del OLN

#' Un wrapper a la función \code{survey::svyby}
#'
#' @param formula Una fórmula que especifica las variables a pasar a \code{FUN}.
#' @param by      Una fórmula de factores que definen los dominios.
#' @param design  Un objeto svydesign o svrepdesign.
#' @param subpop  UNa expresión lógica que indica las filas a conservar,
#'                los valores perdidos se toman como falsos.
#' @param FUN     Una función que toma una fórmula y Un objeto
#'                svydesign o svrepdesign como sus dos primeros argumentos.
#' @param ...     Otros argumentos de \code{survey::svyby} \code{FUN}.
#'
#' @return Un objeto de clase svyby.
#'
#' @export
#' @encoding   UTF-8
svyby2 <- function(formula, by, design, subpop, FUN, ...) {
  # Llama al comando survey::svyby
  x <- survey::svyby(
    # Argumentos principales de svyby
    formula = formula,
    by      = by,
    design  = subset_ee(design, substitute(subpop)),
    FUN     = FUN,
    # Argumentos secundarios (pre-asignados) de svy
    drop.empty.groups = FALSE,
    # Argumentos secundarios (pre-asignados) de FUN
    na.rm = TRUE,
    ci    = TRUE,
    # Otros argumentos
    ...
  )

  # Guarda (como atributos) los parámetros principales de svyby
  attr(x, "formula") <- deparse(substitute(formula))
  attr(x, "subpop")  <- deparse(substitute(subpop))
  attr(x, "FUN")     <- deparse(substitute(FUN))
  attr(x, "by")      <- deparse(substitute(by))
  dots <- list(...)
  for (arg in names(dots)) {
    attr(x, arg) <- dots[[arg]]
  }

  # Modifica la clase de x (heredando la original)
  class(x) <- c("svyby2", class(x))

  # Reporta el resultado
  return(x)
}

# Una escotilla de escape para subset.survey.design y subset.svyrep.design
subset_ee <- function(x, subset, ...) UseMethod("subset_ee")
subset_ee.default <- function(x, subset, ...) {
  r <- eval(subset, x$variables, parent.frame()) # Evalúa subset en x$variables
  r <- r & !is.na(r)                             # Reemplaza NA por FALSE
  x <- x[r, ]                                    # Filtra x
  x$call <- sys.call(-1)                         # Actualiza x$call
  return(x)                                      # Reporta el resultado
}

# Ordena y explicita los resultados de svyby2
tidy <- function(x) UseMethod("tidy")
tidy.svyby <- function(x) {
  # Captura información útil de los attributes(x)
  attrs   <- attributes(x)
  vars    <- attrs$svyby$variables
  nstats  <- attrs$svyby$nstats
  formula <- attrs$formula

  # Ajusta los nombres de las variables
  if (nstats == 1) {
    names(x)[ncol(x) - 1] <- "bh"
  } else {
    for (var0 in vars) {
      var1 <- paste("bh", var0, sep = ".")
      x[[var1]] <- x[[var0]]
      x[[var0]] <- NULL
    }
  }

  # Reordena x
  if (nstats > 1) {
    # Reúne las columnas en pares clave-valor
    x <- tidyr::gather(x, key, value, matches("^(bh|se)+"))

    # Corrige la clave (facilitará su separación)
    x$key <- gsub("bh.", "bh~", x$key, fixed = TRUE)
    x$key <- gsub("se.", "se~", x$key, fixed = TRUE)
    x$key <- gsub(formula, "~", x$key, fixed = TRUE)

    # Separa la clave
    x <- tidyr::separate(x, key, c("stat", gsub("~", "", formula)), "~")

    # Distribuye el par stat-value en dos columnas
    x <- tidyr::spread(x, stat, value)
  }

  # Convierte los atributos claves de x en variables
  for (attrib in c("formula", "subpop", "FUN", "by")) {
    x[[attrib]] <- attrs[[attrib]]
  }

  # Rerdena las columnas
  x <- dplyr::select(x, FUN, formula, by, subpop, everything())

  # Presenta los resultados
  return(x)
}