R/estimar_razon.R

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

#### Estimar razones ####


estimar_razon = function(encuesta, input) {

  if (substr(encuesta, 1, nchar("ENGHo Gastos")) == "ENGHo Gastos" ||   encuesta == "ENGHo Otros Gastos") {
    return(estim_gastos_ENGHo())
  } else {
    if (length(input$VarNum) > 1 || length(input$VarDen) > 1) {
      app_error(
        paste0(
          "Error:\n",
          "La encuesta seleccionada solo puede manejar una variable en el ",
          "numerador y denominador por estimacion. ",
          "Revise las opciones"
        )
      )
    } else {

      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" ) {

        if (any(c(input$VarNum, input$VarDen) %in% VARIABLES_ENFR_PASO1)) {
          disenio.general = disenio()
        }
        if (any(c(input$VarNum, input$VarDen) %in% VARIABLES_ENFR_PASO2)) {
          disenio.general = disenio.paso2()
        }
        if (any(c(input$VarNum, input$VarDen) %in% VARIABLES_ENFR_PASO3)) {
          disenio.general = disenio.paso3()
        }

      } else {
        disenio.general = disenio()
      }

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

        if (length(input$VarCorte) == 1) {

          t = table(
            disenio.general$variables[[input$VarNum]],
            disenio.general$variables[[input$VarCorte]]
          )

          disenio.general = subset(
            disenio.general,
            !get(input$VarCorte)%in% names(which(colSums(t)==0))
          )

          t2 = table(
            disenio.general$variables[[input$VarDen]],
            disenio.general$variables[[input$VarCorte]]
          )

          disenio.general = subset(
            disenio.general, !get(input$VarCorte)%in% names(which(colSums(t2)==0))
          )

        } else {

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

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

          # Nota: Estos subsets deben llamar a un subset dentro de survey.
          # No estoy seguro todavia como se deben importar esas funciones
          # que no son exportadas por survey
          # https://stackoverflow.com/questions/49319132/r-s3-method-not-exported-from-namespace
          disenio.general = subset(
            disenio.general,
            !cortes_subset %in% names(which(colSums(tt)==0))
          )

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

          tt2 = table(
            disenio.general$variables[[input$VarDen]],
            disenio.general$variables$cortes_subset
          )

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

      cuadro.razon =survey::svyby(
          formula = stats::as.formula(paste0("~", input$VarNum)),
          by = formula_by,
          design = disenio.general,
          denominator = stats::as.formula(paste0("~", input$VarDen)),
          FUN = mi_svyratio,
          vartype = c("cvpct", "ci"),
          na.rm = TRUE,
          deff = FALSE
      )

      disenio_subseteado =  subset(
        disenio.general,
        subset = !is.na(disenio.general$variables[[input$VarNum]]) & !is.na(disenio.general$variables[[input$VarDen]])
      )


      cv.den.razon = 100 * survey::cv(
        survey::svyby(
          formula = stats::as.formula(paste0("~",input$VarDen)),
          by = formula_by,
          design = disenio_subseteado,
          FUN = survey::svymean,
          na.rm = TRUE
        )
      )

      # Tirar niveles que no existen
      cv.den.razon = cv.den.razon[!is.nan(cv.den.razon)]

      ene  = survey::svyby(
        formula = stats::as.formula(paste0("~", input$VarNum)),
        by = formula_by,
        design = disenio_subseteado,
        FUN = unwtd.count,
        na.rm = TRUE
      )

      #Hacer lindos los cuadros

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

      cuadro.razon = cbind.data.frame(
        cuadro.razon[1:L],
        ene$counts,
        cuadro.razon[(L + 1):ncol(cuadro.razon)],
        cv.den.razon
      )

      # Hacer lindos los cuadros
      nomb_razon = paste0(input$VarNum, "/", input$VarDen)

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

      colnames(cuadro.razon) = nomb_final

      # 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.razon[[paste0("CV%_",nomb_razon)]] > 33.3
      CVDenalto = cuadro.razon[[paste0("CVden%_",nomb_razon)]] > data_Advertencias[nomb_enc, "CVden"]
      nmin = cuadro.razon[["n"]] < data_Advertencias[nomb_enc, "n"]
      RazonBaja = cuadro.razon[[nomb_razon]] < data_Advertencias[nomb_enc, "prop"]

      CVmedio = cuadro.razon[[paste0("CV%_",nomb_razon)]] > 16.6
      CVmedio[is.na(CVmedio)] = TRUE

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

      cuadro.razon = round(cuadro.razon, 3)
      cuadro.razon[["n"]] = round(cuadro.razon[["n"]])
      if (is.null(input$VarCorte)) cuadro.razon["Total_Pais"] = "Total pais"

      if (sum(CVmedio) > 0) {
        cuadro.razon$Advertencia = ""
        cuadro.razon$Advertencia[CVmedio] = "*"
      }


      if (sum(AdvLog) > 0) {
        if (sum(CVmedio) == 0){
          cuadro.razon$Advertencia = ""
        }
        cuadro.razon$Advertencia[AdvLog] = "**"
      }

      lista_cuadro_razon = vector("list", 1)
      lista_cuadro_razon[[1]] = cuadro.razon
      return(lista_cuadro_razon)
    }
  }

}



# OBS4 <- observeEvent(input$Estimar,{

  #
  #      if(substr(input$EncuestaSelect,1,nchar("ENGHo Gastos")) == "ENGHo Gastos"){
  #          tmp <- estim_gastos_ENGHo()
  #      } else {
  #          tmp <- estim_razon()
  #      }
  #
  #
  #      output$Est_Razon1 <- renderDataTable(DT::datatable(tmp, class = 'cell-border stripe', rownames = F,
  #                                                           options = list(dom = 't', scrollX = T,scrollY = TRUE, ordering = F,paging = FALSE)) )
#   salida_r = estim_razon()
#
#   lapply(seq_len(length(salida_r)), function(m){
#     output[[ paste0("Est_Razon",m) ]] <- renderDataTable({
#       DT::datatable(salida_r[[m]], class = 'cell-border stripe', rownames = F,
#                     options = list(dom = 't', scrollX = T,scrollY = TRUE, ordering = F,paging = FALSE))
#     })
#   }
#   )
# })