# #' 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, ...) {
# # Evalúa todos los argumentos que vienen como formulas
# formula <- eval(formula)
# subpop <- eval(subpop)
# by <- eval(by)
#
# # Convierte subpop en una expresión
# subpop <- deparse(subpop)
# subpop <- gsub("~", "", subpop)
# subpop <- parse(text = subpop)
#
# # Llama al comando survey::svyby
# x <- survey::svyby(
# # Argumentos principales de svyby
# formula = formula,
# by = by,
# design = subset_ee(design, substitute(subpop)),
# FUN = FUN[[1]],
# # 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") <- paste0("~", subpop)
# attr(x, "FUN") <- names(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)
# }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.