R/estimar_total.R

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

#### Estimar totales ####


estimar_total = function(encuesta, input) {

  if (substr(encuesta, 1, nchar("ENGHo Gastos")) != "ENGHo Gastos" && encuesta != "ENGHo Otros Gastos") {

    if (!is.null(input$VarCorte)) {
      formula_by = stats::as.formula(paste0("~", input$VarCorte, collapse = "+"))
    } else {
      formula_by = stats::as.formula("~Sin_Estratos")
    }

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


    cuadro.cont.total = list(length = length(input$VarCont))

    for (i in seq(input$VarCont)) {

      if (input$EncuestaSelect == "ENFR"){
        if (input$VarCont[i] %in% VARIABLES_ENFR_PASO1) disenio.general = disenio1
        if (input$VarCont[i] %in% VARIABLES_ENFR_PASO2) disenio.general = disenio2
        if (input$VarCont[i] %in% VARIABLES_ENFR_PASO3) disenio.general = disenio3
      } else {
        disenio.general = disenio.respaldo
      }

      if (input$Marca_total_cat) {
        niveles = names(table(disenio.general$variables[[input$VarCont[i]]]))
        formula_est = stats::as.formula(
          paste0("~ factor(", input$VarCont[i], ", levels = niveles)")
        )
      } else {
        formula_est = stats::as.formula(paste0("~", input$VarCont[i]))
      }

      cuadro.cont.total[[i]] = survey::svyby(
        formula = formula_est,
        by = formula_by,
        design  = disenio.general,
        FUN = survey::svytotal,
        vartype = c("cvpct", "ci"),
        na.rm = TRUE,
        deff = FALSE
      )

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

      # Hacer lindos los cuadros

      if(input$Marca_total_cat) {
        nomb_cont_total = paste0(
          "Total_", input$VarCont[i], "_",
           names(table(disenio.general$variables[[input$VarCont[i]]]))
        )
      } else {
        nomb_cont_total = paste0("Total_", input$VarCont[i])
      }

      L = length(input$VarCorte)
      if (L == 0) L = 1

      cuadro.cont.total[[i]] = cbind.data.frame(
        cuadro.cont.total[[i]][1:L],
        ene$counts,
        cuadro.cont.total[[i]][(L + 1):ncol(cuadro.cont.total[[i]])]
      )


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

      colnames(cuadro.cont.total[[i]]) = nomb_final

      # Alternar intervalos de confianza

      LI = cuadro.cont.total[[i]][paste0("Li_", nomb_cont_total)]
      LS = cuadro.cont.total[[i]][paste0("Ls_", nomb_cont_total)]

      cols = which(
        colnames(cuadro.cont.total[[i]]) %in% paste0(c("Li_", "Ls_"), nomb_cont_total)
      )

      for (j in seq(length(LI))) {
        cuadro.cont.total[[i]][[cols[[2 * (j - 1) + 1]]]] = LI[, j]
        cuadro.cont.total[[i]][[cols[[2 * j]]]] = LS[, j]

        colnames(cuadro.cont.total[[i]])[[cols[[2 * (j - 1) + 1]]]] = colnames(LI)[[j]]
        colnames(cuadro.cont.total[[i]])[[cols[[2 * j]]]] = colnames(LS)[[j]]
      }

      # 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 = cuadro.cont.total[[i]][[paste0("CV%_",nomb_cont_total)]] > 33.3
      nmin = cuadro.cont.total[[i]][["n"]] < data_Advertencias[nomb_enc, "n"]

      CVmedio = cuadro.cont.total[[i]][[paste0("CV%_",nomb_cont_total)]] > 16.6
      CVmedio[is.na(CVmedio)] = TRUE

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

      cuadro.cont.total[[i]] = round(cuadro.cont.total[[i]], 3)
      cuadro.cont.total[[i]][["n"]] = round(cuadro.cont.total[[i]][["n"]])

      if (is.null(input$VarCorte)) {
        cuadro.cont.total[[i]]["Total_Pais"] = "Total pais"
      }

      # NOTA: No hay un problema aca de que se sobrescriben las advertencias?
      if (sum(CVmedio) > 0) {
        if (input$Marca_total_cat) {
          Advertencias = matrix("", nrow(cuadro.cont.total[[i]]), length(nomb_cont_total))
        } else {
          Advertencias = character(nrow(cuadro.cont.total[[i]]))
        }
        Advertencias[CVmedio] = "*"
      }

      if (sum(AdvLog) > 0) {
        if (sum(CVmedio) == 0) {
          if (input$Marca_total_cat) {
            Advertencias = matrix("", nrow(cuadro.cont.total[[i]]), length(nomb_cont_total))
          } else {
            Advertencias = character(nrow( cuadro.cont.total[[i]]))
          }
        }
        Advertencias[AdvLog] = "**"
      }

      if (sum(AdvLog) > 0 | sum(CVmedio) > 0) {
        colnames(Advertencias) = paste0("Adv_", nomb_cont_total)
        cuadro.cont.total[[i]] = cbind(cuadro.cont.total[[i]],Advertencias)
      }
    }

    return(cuadro.cont.total)
  } else {
    return(estim_gastos_ENGHo_total())
  }

}

# Llenar la pestania nueva con el cuadro resultante
# OBS2 <- observeEvent(input$Estimar,{
#   salida_p <- estim_total()
#
#   lapply(seq_len(length(salida_p)), function(m){
#     output[[ paste0("Est_cont_tot",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))
#     })
#   }
#   )
#
# })