R/estimar_proporcion.R

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

estimar_proporcion = function(encuesta, input) {

  if (encuesta == "ENFR") {
    disenio1 = disenio()
    disenio2 = disenio.paso2()
    disenio3 = disenio.paso3()
  } else {
    disenio.general = disenio()
    disenio.respaldo = disenio.general
  }


  if(!is.null(input$VarCorte)) {
    formula_by = as.formula(paste0("~", input$VarCorte, collapse = "+"))
    est_den = as.formula(
      paste0(
        " ~ interaction(",
        paste0("factor(", input$VarCorte, ")",collapse = ","),
        ", drop = TRUE)"
      )
    )

  } else {
    formula_by = as.formula("~Sin_Estratos")
    est_den    = as.formula("~Sin_Estratos")
  }

  cuadros.categ = list(length = length(input$VarCateg))

  for (VarC in seq_along(input$VarCateg)) {

    if (encuesta == "ENFR") {
      if (input$VarCateg[[VarC]] %in% VARIABLES_ENFR_PASO1) disenio.general = disenio
      if (input$VarCateg[[VarC]] %in% VARIABLES_ENFR_PASO2) disenio.general = disenio2
      if (input$VarCateg[[VarC]] %in% VARIABLES_ENFR_PASO3) disenio.general = disenio3
    } else {
      disenio.general = disenio.respaldo
    }

    if (!is.null(input$VarCorte)) {

      if (length(input$VarCorte) == 1) {
        t = table(
          disenio.general$variables[,input$VarCateg[[VarC]]],
          disenio.general$variables[,input$VarCorte]
        )
        disenio.general = subset(
          disenio.general,
          !get(input$VarCorte) %in% names(which(colSums(t) == 0))
        )
      } else {

        disenio.general$variables$cortes_subset = interaction(
          disenio.general$variables[[input$VarCorte]],
          sep = "-"
        )

        tt = table(
          disenio.general$variables[, input$VarCateg[[VarC]]],
          disenio.general$variables$cortes_subset
        )

        disenio.general = subset(
          disenio.general,
          !cortes_subset %in% names(which(colSums(tt)==0))
        )
      }
    }

    niveles = names(table(disenio.general$variables[[input$VarCateg[[VarC]]]]))

    disenio.general = stats::update(
      disenio.general,
      factor_var_est = factor(disenio.general$variables[[input$VarCateg[[VarC]]]],
                              levels = niveles)
    )

    cuadros.categ[[VarC]] = survey::svyby(
      formula = ~ factor_var_est ,
      by  = formula_by,
      design  = disenio.general,
      FUN = survey::svymean,
      vartype = c("cvpct", "ci"),
      na.rm = TRUE,
      deff = FALSE
    )

    ene = survey::svyby(
      formula = ~factor_var_est ,
      by = formula_by,
      design = disenio.general,
      FUN = survey::unwtd.count,
      na.rm = TRUE
    )

    CV_denominador = 100 * survey::cv(
      survey::svytotal(
        x = est_den,
        design = subset(disenio.general, subset = !is.na(factor_var_est)),
        na.rm = TRUE
      )
    )

    # Tirar niveles que no existen
    CV_denominador = CV_denominador[!is.nan(CV_denominador)]

    #isolate(View(ene))
    #isolate(View(cuadros.categ[[VarC]]))
    #isolate(View(CV_denominador))
    #isolate(print(nrow(disenio.general$variables)))

    # Hacer lindos los cuadros
    nomb_categ = names(table(disenio.general$variables[[input$VarCateg[[VarC]]]]))
    L = length(input$VarCorte)
    if (L == 0) L = 1

    # n + variables de corte + nombre var analisis
    var_pasar_a_porcentaje = 1:(length(nomb_categ) * 3) + 1 + L + 1

    cuadros.categ[[VarC]] = cbind.data.frame(
      cuadros.categ[[VarC]][1:L],
      input$VarCateg[[VarC]],
      ene$counts,
      cuadros.categ[[VarC]][(L + 1):ncol(cuadros.categ[[VarC]])],
      CV_denominador
    )

    if (!is.null(input$VarCorte)) {
      nomb_final = c(
        input$VarCorte,
        "Var_Analisis",
        "n",
        nomb_categ,
        paste0(c("Li_", "Ls_", "CV%_"), nomb_categ),
        "CV%_denominador"
      )
    } else {
      nomb_final = c(
        "Total_Pais",
        "Var_Analisis",
        "n",
        nomb_categ,
        paste0(c("Li_", "Ls_", "CV%_"), nomb_categ),
        "CV%_denominador"
      )
    }

    colnames(cuadros.categ[[VarC]]) = nomb_final
    if (is.null(input$VarCorte)) {
      cuadros.categ[[VarC]]["Total_Pais"] = "Total pais"
    }

    # Alternar intervalos de confianza

    LI = cuadros.categ[[VarC]][[paste0("Li_", nomb_categ)]]
    LS = cuadros.categ[[VarC]][[paste0("Ls_", nomb_categ)]]

    cols = which(
      colnames(cuadros.categ[[VarC]]) %in% paste0(c("Li_", "Ls_"), nomb_categ)
    )

    for (i in seq_len(LI)) {
      cuadros.categ[[VarC]][cols[[2 * (i - 1) + 1]]] = LI[, i]
      cuadros.categ[[VarC]][cols[[2 * i]]] = LS[, i]

      colnames(cuadros.categ[[VarC]])[[cols[[2 * (i - 1) + 1]]]] = colnames(LI)[i]
      colnames(cuadros.categ[[VarC]])[[cols[[2 * i]]]] = colnames(LS)[i]
    }

    # Crear advertencias
    nomb_enc = substr(input$EncuestaSelect, 1, 5)

    # Si no existe la encuesta, usar el criterio mas severo (ENGHO)
    if (!nomb_enc %in% c("EANNA", "ENFR", "DISCA", "ENGHo")) nomb_enc = "ENGHo"

    CValto = cuadros.categ[[VarC]][[paste0("CV%_", nomb_categ)]] > 33.3
    CVDenalto = cuadros.categ[[VarC]][[paste0("CV%_denominador")]] > data_Advertencias[nomb_enc, "CVden"]
    nmin = cuadros.categ[[VarC]][["n"]] < data_Advertencias[nomb_enc, "n"]
    PropBaja = cuadros.categ[[VarC]][[nomb_categ]] < data_Advertencias[nomb_enc, "prop"]

    CVmedio = cuadros.categ[[VarC]][[paste0("CV%_", nomb_categ)]] > 16.6
    CVmedio[is.na(CVmedio)] = TRUE

    AdvLog = CValto | CVDenalto | nmin | PropBaja
    AdvLog[is.na(AdvLog)] = TRUE

    cuadros.categ[[VarC]][[var_pasar_a_porcentaje]] = 100 * cuadros.categ[[VarC]][[var_pasar_a_porcentaje]]

    col_redondear = min(var_pasar_a_porcentaje):ncol(cuadros.categ[[VarC]])
    cuadros.categ[[VarC]][[col_redondear]] = round(cuadros.categ[[VarC]][[col_redondear]], 2)

    if (sum(CVmedio) > 0) {
      Advertencias = matrix("",  nrow(cuadros.categ[[VarC]]),length(nomb_categ))
      Advertencias[CVmedio] = "*"
    }

    if (sum(AdvLog) > 0) {
      if (sum(CVmedio) == 0) {
        Advertencias = matrix("", nrow(cuadros.categ[[VarC]]), length(nomb_categ))
      }
      Advertencias[AdvLog] = "**"
    }

    if (sum(AdvLog) > 0 | sum(CVmedio) > 0) {
      colnames(Advertencias) = paste0("Adv_", nomb_categ)
      cuadros.categ[[VarC]] = cbind(cuadros.categ[[VarC]], Advertencias)
    }
  }

  return(cuadros.categ)
}


# observeEvent(input$Estimar, {
#
#   if(length(input$VarCateg) > 1){
#
#     for (i in 2:length(input$VarCateg)) {
#
#
#       insertTab(inputId = "Panel_Prop",
#                 tabPanel(paste0("Proporci?n", i), dataTableOutput(paste0("Est_categ",i))),
#                 target = if(i==2){"Proporci?n"}else{paste0("Proporci?n", i - 1)},
#                 position = "after")
#
#     }
#   }
#
# })

# # Salida
# OBS1 <- observeEvent(input$Estimar, {
#   salida_p = estim_categ()
#   lapply(seq_len(length(input$VarCateg)), function(m){
#     output[[ paste0("Est_categ",m) ]] <- renderDataTable({
#       DT::datatable(salida_p[[m]], class = 'cell-border stripe', rownames = F,
#                     options = list(dom = 't', scrollX = T,scrollY = TRUE, ordering = F,paging = FALSE))
#     })
#   }
#   )
#
# })