R/misc.R

In tomicapretto/cemrepboot: What the Package Does (One Line, Title Case)

#
# VARIABLES_ENFR_PASO2 = names(read.table("src/res/Var paso 2 ENFR.txt", sep = "|", header = TRUE))
# VARIABLES_ENFR_PASO3 = names(read.table("src/res/Var paso 3 ENFR.txt", sep = "|", header = TRUE))
# VARIABLES_ENFR_PASO1 = setdiff(names(read.table("src/res/tot var ENFR.txt", sep="|", header = TRUE)),
#                                c(VARIABLES_ENFR_PASO2,VARIABLES_ENFR_PASO3))
#
# VARIABLES_TOTAL = names(read.table("src/res/tot var ENFR.txt", sep = "|", header = TRUE))
#
# # Llamar a mi_svyratio
# #### Funcion global mi_svyratio, permite que svyratio estime deff ####
# mi_svyratio = function(numerator = formula, denominator, design, na.rm = FALSE,
#                        formula, covmat = FALSE, return.replicates = FALSE,
#                        deff = FALSE, ...) {
#
#   survey:::.svycheck(design)
#
#   if (!inherits(design, "svyrep.design")) {
#     stop("El diseño debe ser un objeto de calse svyrepdesign")
#     # ñ
#   }
#
#   if (inherits(numerator, "formula")) {
#     numerator = model.frame(numerator, design$variables, na.action = na.pass)
#   } else if (typeof(numerator) %in% c("expression", "symbol")) {
#     numerator = eval(numerator, design$variables)
#   }
#
#   if (inherits(denominator, "formula")) {
#     denominator = model.frame(denominator, design$variables, na.action = na.pass)
#   } else if (typeof(denominator) %in% c("expression", "symbol")) {
#     denominator <- eval(denominator, design$variables)
#   }
#
#   nn = NCOL(numerator)
#   nd = NCOL(denominator)
#   all = cbind(numerator, denominator)
#   nas = !complete.cases(all)
#
#   if (na.rm == TRUE) {
#     design = design[!nas, ]
#     all = all[!nas, , drop = FALSE]
#     numerator = numerator[!nas, , drop = FALSE]
#     denominator = denominator[!nas, , drop = FALSE]
#   }
#
#   allstats = survey::svymean(all, design, return.replicates = TRUE)
#   rval = list(
#     ratio = outer(allstats$mean[1:nn], allstats$mean[nn + 1:nd], "/")
#   )
#
#   if (is.null(allstats$replicates)) {
#     vars = matrix(0, nrow = nn, ncol = nd)
#   } else {
#     vars = matrix(nrow = nn, ncol = nd)
#     if (deff) deffs = matrix(nrow = nn, ncol = nd)
#
#     for (i in 1:nn) {
#       for (j in 1:nd) {
#         vars[i, j] = survey::svrVar(
#           allstats$replicates[, i] / allstats$replicates[, nn + j],
#           design$scale,
#           design$rscales,
#           mse = design$mse,
#           coef = rval$ratio[i, j]
#         )
#
#         if (deff == "replace" || deff) {
#           deffs[i, j] = survey::deff(
#             survey::svytotal(
#               numerator[, i] - rval$ratio[i, j] * denominator[, j],
#               design,
#               deff = deff
#             )
#           )
#         }
#       }
#     }
#   }
#
#   if (covmat) {
#     if (is.null(allstats$replicates)) {
#       vcovmat = matrix(0, nn * nd, nn * nd)
#     } else {
#       vcovmat = as.matrix(
#         survey::svrVar(
#           allstats$replicates[, rep(1:nn, nd)] / allstats$replicates[, nn + rep(1:nd, each = nn)],
#           design$scale,
#           design$rscales,
#           mse = design$mse,
#           coef = as.vector(rval$ratio)
#         )
#       )
#     }
#     rownames(vcovmat) = names(numerator)[rep(1:nn, nd)]
#     colnames(vcovmat) = names(denominator)[rep(1:nd, each = nn)]
#     rval$vcov = vcovmat
#   }
#
#   if (return.replicates) {
#     reps = allstats$replicates[, rep(1:nn, nd)] / allstats$replicates[, nn + rep(1:nd, each = nn)]
#     attr(reps, "scale") = design$scale
#     attr(reps, "rscales") = design$rscales
#     attr(reps, "mse") = design$mse
#     rval$replicates = reps
#   }
#
#   rval$var = vars
#   attr(rval, "call") <- sys.call()
#   if (deff == "replace" || deff) attr(rval, "deff") = deffs
#   class(rval) = "svyratio"
#   rval
# }