R/estimar_media.R

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

# encuesta = input$EncuestaSelect
# verif_corte = VerifCorte
# var_cont2 = input$VarCont2
# var_corte = input$VarCorte
# estim_media_old


# NOTA: ESTO ES UNA TRADUCCION MUY SENCILLA DEL CODIGO ORIGINAL
#       NO ESTA LISTO

estimar_media = function(encuesta) {

  if (!is.null(var_corte)) {
    formula_by = as.formula(paste0("~", var_corte, collapse = "+"))
  } else {
    formula_by = as.formula("~Sin_Estratos")
  }

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

  for(i in seq(var_cont2)) {
    if (encuesta == "ENFR") {
      if (var_cont2[i] %in% VARIABLES_ENFR_PASO1) disenio.general = disenio1
      if (var_cont2[i] %in% VARIABLES_ENFR_PASO2) disenio.general = disenio2
      if (var_cont2[i] %in% VARIABLES_ENFR_PASO3) disenio.general = disenio3
    } else {
      disenio.general = disenio.respaldo
    }

    if (!is.null(var_corte)) {
      if (length(var_corte) == 1) {
        t = table(disenio.general$variables[ ,var_cont2[i]], disenio.general$variables[, var_corte])
        disenio.general = subset(disenio.general, !(get(var_corte) %in% names(which(colSums(t)==0))))

      } else {
        disenio.general$variables$cortes_subset = interaction(disenio.general$variables[, var_corte], sep ="-")
        tt = table(disenio.general$variables[, var_cont2[i]], disenio.general$variables$cortes_subset)
        disenio.general = subset(disenio.general, !(cortes_subset %in% names(which(colSums(tt)==0)) ) )
      }
    }

    cuadro.cont.media[[i]] = survey::svyby(
      formula = as.formula(paste0("~", var_cont2[i])),
      by = formula_by,
      design = disenio.general,
      FUN = survey::svymean,
      vartype = c("cvpct", "ci"),
      drop.empty.groups = TRUE,
      na.rm = TRUE,
      deff = FALSE
    )

    ene = survey::svyby(
      formula = as.formula(paste0("~", var_cont2[i])),
      by = formula_by,
      design = disenio.general,
      FUN = survey::unwtd.count,
      na.rm = TRUE
    )

    # Hacer lindos los cuadros
    nomb_cont_media = paste0("Media_", var_cont2[i])

    L = length(var_corte)
    if (L == 0) L = 1
    cuadro.cont.media[[i]] = cbind.data.frame(
      cuadro.cont.media[[i]][1:L],
      ene$counts,
      cuadro.cont.media[[i]][(L+1):ncol(cuadro.cont.media[[i]])]
    )


    if(!is.null(var_corte)) {
      nomb_final= c(
        var_corte,
        "n",
        nomb_cont_media,
        paste0(c("Li_", "Ls_", "CV%_"), nomb_cont_media)
      )
    } else{
      nomb_final = c(
        "Total_Pais",
        "n",
        nomb_cont_media,
        paste0(c("Li_", "Ls_", "CV%_"), nomb_cont_media)
      )
    }

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

    # Crear advertencias
    nomb_enc = substr(encuesta, 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.media[[i]][, paste0("CV%_", nomb_cont_media)] > 33.3
    nmin = cuadro.cont.media[[i]][,"n"] < data_Advertencias[nomb_enc, "n"]

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

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

    cuadro.cont.media[[i]] = round(cuadro.cont.media[[i]],3)
    cuadro.cont.media[[i]][,"n"] = round(cuadro.cont.media[[i]][,"n"])
    if (is.null(var_corte)) cuadro.cont.media[[i]][,"Total_Pais"] = "Total pais"

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

    if (sum(AdvLog) > 0) {
      if (sum(CVmedio) == 0) {
        cuadro.cont.media[[i]]$Advertencia = ""
      }
      cuadro.cont.media[[i]]$Advertencia[AdvLog] = "**"
    }
  }
  return(cuadro.cont.media)
}


#Llenar las pestanias vacias con cuadros
# OBS3 <- observeEvent(input$Estimar,{
#   salida_p = estim_media()
#
#   lapply(seq_len(length(input$VarCont2)), function(m){
#     output[[ paste0("Est_cont_med",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))
#     })
#   }
#   )
#
# })