R/calcular_gastos_engho.R

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

# Funciones auxiliares
# Q: Que hacen estas dos funciones?
numeros_dummy = function(lista_var){
  options(warn = -1) # Apagar advertencia de nombres
  pos = regexpr("\\d", lista_var)
  res = as.numeric(substring(lista_var,first = pos))
  options(warn = 0) # Apagar advertencia de nombres
  return(res)
}

nombres_dummy = function(lista_var) {
  options(warn = -1) # Apagar advertencia de nombres
  pos = regexpr("\\d", lista_var)-1
  pos[pos < 0] = 1000000L  # Valor por defecto de last de substring
  res = unique(substring(lista_var, first = 1, last = pos))
  options(warn = 0)
  return(res)
}


# NOTA: Esto no esta modificado todavia

# observeEvent(input$Estimar, {
#
#   #Si tengo alguna de las ENGHO gastos
#
#   if(substr(input$EncuestaSelect,1,nchar("ENGHo Gastos")) == "ENGHo Gastos" ||
#      input$EncuestaSelect == "ENGHo Otros Gastos"){
#     #Cargar variables
#     tmp <- datos()
#     varcol = input$VarCorte
#     Sin_Estratos <- rep(1,nrow(tmp)) # Generar columna de unos
#     tmp <- cbind(Sin_Estratos,tmp) # Pegar a la base
#
#     if( is.null(input$VarCorte) ) {varcol = "Sin_Estratos"} # Si no se selecciono varible, usar los unos
#     cant_cuadros = length(unique(tmp[,varcol])) # Contar la cantidad de cuadros
#     rm(tmp)
#
#     #Borrar cuadros anteriores
#     for (i in 2:50) {
#       removeTab(inputId = "Panel_Razon",
#                 target = paste0("Raz?n", i))
#
#     }
#
#     # Si hay mas de un cuadro a crear, insertar las pesta?as correspondientes
#     if(cant_cuadros > 1){
#       for (i in 2:cant_cuadros) {
#         insertTab(inputId = "Panel_Razon",
#                   tabPanel(paste0("Raz?n", i), dataTableOutput(paste0("Est_Razon",i))),
#                   target = if(i==2){"Raz?n"}else{paste0("Raz?n", i - 1)},
#                   position = "after")
#
#       }
#     }
#   }
# })

estimar_gastos_engho = function(input, datos) {

  # Guardar las variables de entrada en variables genericas
  varfilas = nombres_dummy(input$VarNum)
  varanalisis = input$VarCateg
  varcol = input$VarCorte

  # Verificaciones de variables
  if (length(varfilas) > 1 || length(varanalisis) > 1) {
    app_error(
      paste(
        "Error en variables de analisis:",
        "Por favor seleccione una unica variable de analisis para ENGHo Gastos.",
        sep = "\n"
      )
    )
  }

  if (length(varcol) > 1) {
    app_error(
      paste(
        "Error en variables de subpoblacion:",
        "Por favor seleccione una unica variable de subpoblacion para ENGHo Gastos.",
        sep = "\n"
      )
    )
  }

  # Si no se seleccionan variables, usar la columna de unos
  if (is.null(input$VarCorte)) varcol = "Sin_Estratos"

  # Lo siguiente deberia ir al contexto que realiza la llamada
  # if (!is.null(input$VarNum) && !is.null(varanalisis))

  # Leer los datos
  tmp = datos
  Sin_Estratos = rep(1, nrow(tmp))
  tmp = cbind(Sin_Estratos, tmp)

  # Porque se llama 'varfilas' y va en las columnas??
  tmp[, varfilas] = as.character(tmp[, varfilas])


  # Quedarme solo con los niveles seleccionados de las variables
  niv_deseados = numeros_dummy(input$VarNum)
  if (!anyNA(niv_deseados)) { # Si son solo dummies
    niveles = sort(unique(tmp[, varfilas]))[niv_deseados]
    tmp = subset(tmp, subset = get(varfilas) %in% niveles)
  }

  # Separar los datos de acuerdo a la subpoblaciones
  lista.datos = split(tmp, tmp[, varcol])

  # Darle nombre a los datos si no los tiene, por alguna razon
  if (is.null(names(lista.datos)) && length(lista.datos) == 1) {
    names(lista.datos) = "NOTNULL"
  }

  # Tirar los datos orignales, ya se usaron
  rm(tmp)
  i = 1
  cuadros = vector("list", length(lista.datos))

  for (datos.sub in lista.datos) {
    # Crear base de datos con el numero minimo de variables para hacer los calculos
    datos.sub = datos.sub[, c("id", varfilas, varanalisis, "pondera", paste0("whog_rep", 1:200))]

    # Crear las dummies y pegarlas a la base
    if (length(unique(datos.sub[, varfilas])) > 1) {

      tmp = cbind(
        datos.sub[!is.na(datos.sub[, varfilas]), ],
        data.frame(
          stats::model.matrix(
            survey::make.formula(paste0(varfilas, "-1")),
            data = datos.sub
          )
        )
      )

    } else {
      tmp = cbind(
        datos.sub[!is.na(datos.sub[,varfilas]), ],
        data.frame(wea = rep(1, nrow(datos.sub[!is.na(datos.sub[, varfilas]), ])))
      )
    }

    # Guardar nombre de las variables indicadoras
    indvar = colnames(tmp)[(ncol(datos.sub) + 1):ncol(tmp)]

    # Remover la base, ya se uso
    rm(datos.sub)

    # Crear variable de analisis para cada categoria. y_d =  I * y
    tmp[, indvar] = tmp[, indvar] * tmp[, varanalisis]

    # Crear objeto de disenio, con la base explicitamente sin replicas,
    # ya se las doy en el parametro repweights
    disenio = survey::svrepdesign(
      data = tmp[, c("id", varfilas, varanalisis, "pondera", indvar)],
      repweights = tmp[, paste0("whog_rep", 1:200)],
      type = "bootstrap",
      weights = ~pondera,
      mse = TRUE
    )

    # Remover temporal ya usado para liberar espacio
    rm(tmp)

    # Eliminar los perdidos de la variable de analisis
    disenio = subset(disenio, subset = !(is.na(get(varanalisis))))

    # Realizar estimaciones
    est = survey::svyratio(
      numerator = survey::make.formula(indvar),
      denominator = survey::make.formula(varanalisis),
      design = disenio
    )

    estden = survey::svytotal(
      x = survey::make.formula(varanalisis),
      design = disenio
    )

    # Calcular cantidad de casos en los cortes
    # ID para calcular la cantidad de hogares en la base
    id_para_n  = disenio$variables[, "id"]

    # ID para calcular la cantidad de hogares que aportan por lo menos un articulo
    # la categoria correspondiente de varfilas
    id_para_nd = paste(id_para_n, disenio$variables[,varfilas], sep = "-")

    # Calculo del n per se
    tablaene  = as.data.frame(table(disenio$variables[!duplicated(id_para_nd), varfilas]))
    tablaene2 = as.data.frame(table(disenio$variables[!duplicated(id_para_n), varfilas]))

    # Apagar advertencias, solo tira una de nombres pero asusta
    options(warn = -1)

    # Crear cuadro
    cuadros[[i]] = data.frame(
      CORTE = names(lista.datos)[[i]],
      VAR = tablaene$Var1,
      EST = round(stats::coef(est) * 100, 1),
      CV = round(100 * survey::SE(est) / stats::coef(est), 1),
      CVTOT = round(100 * survey::SE(estden) / stats::coef(estden), 1),
      # SE    = 100*signif(SE(est),2),
      n_d = tablaene$Freq,
      n = sum(tablaene2$Freq),
      ADV = "",
      stringsAsFactors = FALSE
    )

    # Prendo advertencias
    options(warn = 0)

    # Advertencias
    cond = cuadros[[i]][, "CV"] > 16.6
    # Si hay perdidos en el CV por estimaciones == 0, no marcarlos como poco confiables
    cond[is.na(cond) | is.nan(cond)] = FALSE
    cuadros[[i]][cond,"ADV"]  = "*"

    cond = cuadros[[i]][,"EST"] < 3
    cuadros[[i]][cond,"ADV"]  = "**"

    cond = cuadros[[i]][,"CV"] > 33.3
    # Si hay perdidos en el CV por estimaciones == 0, marcarlos como no confiables
    cond[is.na(cond) | is.nan(cond)] = TRUE
    cuadros[[i]][cond ,"ADV"] = "**"

    cond = cuadros[[i]][,"CVTOT"] > 10
    cuadros[[i]][cond,"ADV"]  = "**"

    cond = cuadros[[i]][,"n_d"] < 100
    cuadros[[i]][cond,"ADV"]  = "**"

    rownames(cuadros[[i]]) = NULL
    colnames(cuadros[[i]]) = c(
      varcol,
      varfilas,
      "Estim%",
      "CV_%",
      "CVden%",
      #"DE_%",
      "n_art",
      "n",
      "Advertencia"
    )

    # Incrementar indice
    i = i + 1
  }

  # Nombrar los cuadros para que se guarde lindo al descargar
  names(cuadros) = paste0(varcol, "_", names(lista.datos))
  if (varcol == "Sin_Estratos" ) {
    # input$EncuestaSelect no es ENGHO por defecto?
    # o es alguna de las posibles engho?
    names(cuadros) = paste0("Region_", substring(input$EncuestaSelect, 14))
  }

  return(cuadros)
}

estimar_gastos_engho_total = function(input, datos) {
  # Guardar las variables de entrada en variables genericas
  varfilas = nombres_dummy(input$VarCont)
  varanalisis = input$VarCateg
  varcol  = input$VarCorte

  # Verificaciones de variables
  if (length(varfilas) > 1 || length(varanalisis) > 1) {
    app_error(
      paste(
        "Error en variables de analisis:",
        "Por favor seleccione una unica variable de analisis para ENGHo Gastos.",
        sep = "\n"
      )
    )
  }

  if (length(varcol) > 1) {
    app_error(
      paste(
        "Error en variables de subpoblacion:",
        "Por favor seleccione una unica variable de subpoblacion para ENGHo Gastos.",
        sep = "\n"
      )
    )
  }

  # Si no se seleccionan variables, usar la columna de unos
  if (is.null(input$VarCorte)) varcol = "Sin_Estratos"

  # NOTA: Esto se va a chequear desde donde se llama a la funcion
  # if(!is.null(input$VarCont) && !is.null(input$VarCateg)) {

  tmp = cbind(data.frame("Sin_Estratos" = rep(1, nrow(datos)) , datos))

  # Convertir todo a caracter para que no explote
  tmp[, varfilas] = as.character(tmp[, varfilas])

  # Quedarme solo con los niveles seleccionados de las variables
  niv_deseados = numeros_dummy(input$VarCont)

  if(!anyNA(niv_deseados)) { # Si son solo dummies
    niveles = sort(unique(tmp[, varfilas]))[niv_deseados]
    tmp = subset(tmp, subset = get(varfilas) %in% niveles)
  }

  # Separar los datos de acuerdo a la subpoblaciones
  lista.datos = split(tmp, tmp[, varcol])

  # Darle nombre a los datos si no los tiene, por alguna razon
  if (is.null(names(lista.datos)) && length(lista.datos) == 1) {
    names(lista.datos) = "NOTNULL"
  }

  # Tirar los datos orignales, ya se usaron
  rm(tmp)

  i = 1
  cuadros = vector("list", length(lista.datos))

  for (datos.sub in lista.datos) {
    # Crear base de datos con el numero minimo de variables para hacer los calculos
    datos.sub = datos.sub[, c("id", varfilas, varanalisis, "pondera", paste0("whog_rep", 1:200))]

    # Crear las dummies y pegarlas a la base
    if (length(unique(datos.sub[, varfilas])) > 1) {
      tmp = cbind(
        datos.sub[!is.na(datos.sub[,varfilas]), ],
        data.frame(
          stats::model.matrix(
            survey::make.formula(paste0(varfilas, "-1")),
            data = datos.sub
          )
        )
      )
    } else {
      tmp = cbind(
        datos.sub[!is.na(datos.sub[, varfilas]), ],
        data.frame(wea = rep(1, nrow(datos.sub[!is.na(datos.sub[, varfilas]), ])))
      )
    }

    # Guardar nombre de las variables indicadoras
    indvar = colnames(tmp)[(ncol(datos.sub) + 1):ncol(tmp)]

    # Remover la base, ya se uso
    rm(datos.sub)

    # Crear variable de analisis para cada categoria. y_d =  I * y
    tmp[, indvar] = tmp[, indvar] * tmp[,varanalisis]

    # Crear objeto de disenio, con la base explicitamente sin replicas,
    # ya se las doy en el parametro repweights
    disenio = survey::svrepdesign(
      data = tmp[, c("id", varfilas, varanalisis, "pondera", indvar)],
      repweights = tmp[, paste0("whog_rep", 1:200)],
      type = "bootstrap",
      weights = ~pondera,
      mse = TRUE
    )

    # Remover temporal ya usado para liberar espacio
    rm(tmp)

    #Eliminar los perdidos de la variable de analisis
    disenio = subset(disenio, subset = !(is.na(get(varanalisis))))

    #Realizar estimaciones
    est = survey::svytotal(
      x = survey::make.formula(indvar),
      design = disenio
    )

    # Calcular cantidad de casos en los cortes
    # ID para calcular la cantidad de hogares en la base
    id_para_n = disenio$variables[,"id"]
    # ID para calcular la cantidad de hogares que aportan por lo menos un articulo
    # la categoria correspondiente de varfilas
    id_para_nd = paste(id_para_n, disenio$variables[, varfilas], sep = "-")

    #Calculo del n per se
    tablaene  = as.data.frame(table(disenio$variables[!duplicated(id_para_nd), varfilas]))
    tablaene2 = as.data.frame(table(disenio$variables[!duplicated(id_para_n), varfilas]))

    #Apagar advertencias, solo tira una de nombres pero asusta
    options(warn = -1)

    #Crear cuadro
    cuadros[[i]] = data.frame(
      CORTE = names(lista.datos)[[i]],
      VAR = tablaene$Var1,
      # CVTOT = round(100 * survey::SE(estden) / stats::coef(estden),1),
      EST = round(coef(est),1),
      CV = round(100 * survey::SE(est) / stats::coef(est), 1),
      # SE = 100*signif(SE(est),2),
      n_d = tablaene$Freq,
      n = sum(tablaene2$Freq),
      ADV = "",
      stringsAsFactors = FALSE
    )

    # Prendo advertencias
    options(warn = 0)

    # Advertencias
    cond = cuadros[[i]][,"CV"] > 16.6
    # Si hay perdidos en el CV por estimaciones == 0, no marcarlos como poco confiables
    cond[is.na(cond) | is.nan(cond)] = FALSE
    cuadros[[i]][cond,"ADV"]  = "*"

    # cond = cuadros[[i]][,"EST"] < 5
    #cuadros[[i]][cond,"ADV"]  = "**"

    cond = cuadros[[i]][,"CV"] > 33.3
    # Si hay perdidos en el CV por estimaciones == 0, marcarlos como no confiables
    cond[is.na(cond) | is.nan(cond)] = TRUE
    cuadros[[i]][cond ,"ADV"] = "**"

    cond = cuadros[[i]][,"n_d"] < 100
    cuadros[[i]][cond,"ADV"]  = "**"


    rownames(cuadros[[i]]) = NULL
    colnames(cuadros[[i]]) = c(
      varcol,
      varfilas,
      # "CVden%",
      "Estim",
      "CV_%",
      # "DE_%",
      "n_art",
      "n",
      "Advertencia"
    )

    # Incrementar indice
    i = i + 1
  }

  # Nombrar los cuadros para que se guarde lindo al descargar
  names(cuadros) = paste0(varcol, "_", names(lista.datos))
  if (varcol == "Sin_Estratos" ) {
    names(cuadros) = paste0("Region_", substring(input$EncuestaSelect, 14))
  }
  return(cuadros)

}

# NOTA: Las dos funciones, `estimar_gastos_engho` y `estimar_gastos_engho_total`
# tienen muchisimo codigo redundante. Aplicar DRY.