upax_library: Librería de análisis

#' función para generar tablas
#'
#' Función para generar tablas de frecuencias y porcentajes con o sin ponderación
#'
#' @param variable cadena con el nombre de la variable de la que se quiere el resultado
#' @param nombre nombre final que tiene la variable
#' @param tipo cadena con los tipos de tablas que se calcularán separados por espacios "p pp fp f"
#' @param ponderador cadena con el nombre del ponderador que se utilizará, default NA
#' @param datos dataframe con los datos
#' @param filtro cadena con la condición de filtrado que se desea aplicar "%>% filter(!is.na("variable"))"
#'
#'
#' @return un tibble con las tablas requeridas


# función para transformar matriz de marcas a matriz de menciones y su inversa
r_tablas <- function (variable, nombre = NA, tipo = "p", ponderador = NA, 
                      datos, filtro = NA, extra = NA, extra2 = NA, extra4 = NA) 
{
  require(upax)
  require(dplyr)
  require(survey)
  
  
  if (is.na(nombre)) {
    nombre = variable
  }
  require(spatstat)
  require(purrr)
  f_filtro <- function(datos, filtro) {
    if (!is.na(filtro)) {
      datos_filtrados <- eval(parse(text = paste0("datos", 
                                                  filtro)))
    }
    else {
      datos_filtrados <- datos
    }
    return(datos_filtrados)
  }
  f_tabla <- function(tipo, ponderador, variable, datos_sub) {
    if (tipo == "f") {
      diseno <- tryCatch(eval(parse(text = paste0("svydesign(data = datos_sub,id=~1,weights=~", 
                                                  ponderador, ")"))), error = function(e) {
                                                    "error"
                                                  })
      if (diseno == "error") {
        datos_sub <- rbind(datos_sub, datos_sub)
        eval(parse(text = paste0("datos$", ponderador, 
                                 "<- datos$", ponderador, "/2")))
        diseno <- eval(parse(text = paste0("svydesign(data = datos_sub,id=~1,weights=~", 
                                           ponderador, ")")))
      }
      resultado <- tryCatch(eval(parse(text = paste0("svytotal(~", 
                                                     variable, ",diseno,na.rm=T)"))) %>% data.frame %>% 
                              dplyr::select(total) %>% setNames("frec_p"), 
                            error = function(e) {
                              "error"
                            })
      if (resultado == "error") {
        resultado <- data.frame(frec_p = eval(parse(text = paste0("as.numeric(!is.na(datos_sub$", 
                                                                  variable, ")) %*% datos_sub$", ponderador))))
        eval(parse(text = paste0("rownames(resultado) <- paste0(variable,levels(datos_sub$", 
                                 variable, "))")))
      }
      resultado$frec_p = round(resultado$frec_p, 2)
      if (ponderador == "ponderador_default") 
        names(resultado) <- "frec_n"
    }
    else if (tipo == "p") {
      diseno <- tryCatch(eval(parse(text = paste0("svydesign(data = datos_sub,id=~1,weights=~", 
                                                  ponderador, ")"))), error = function(e) {
                                                    "error"
                                                  })
      if (diseno == "error") {
        datos_sub <- rbind(datos_sub, datos_sub)
        eval(parse(text = paste0("datos$", ponderador, 
                                 "<- datos$", ponderador, "/2")))
        diseno <- eval(parse(text = paste0("svydesign(data = datos_sub,id=~1,weights=~", 
                                           ponderador, ")")))
      }
      resultado <- tryCatch(eval(parse(text = paste0("svymean(~", 
                                                     variable, ",diseno,na.rm=T)"))) %>% data.frame %>% 
                              dplyr::select(mean) %>% setNames("prop_p"), error = function(e) {
                                "error"
                              })
      if (resultado == "error") {
        resultado <- data.frame(prop_p = eval(parse(text = paste0("(as.numeric(!is.na(datos_sub$", 
                                                                  variable, ")) %*% datos_sub$", ponderador, 
                                                                  ")/sum(datos_sub$", ponderador, ",na.rm = T)"))))
        eval(parse(text = paste0("rownames(resultado) <- paste0(variable,levels(datos_sub$", 
                                 variable, "))")))
      }
      resultado$prop_p = round(resultado$prop_p * 100, 
                               2)
      if (ponderador == "ponderador_default") 
        names(resultado) <- "prop_n"
    }
    return(resultado)
  }
  f_numerica <- function(tipo, ponderador, variable, datos_sub, 
                         nombre) {
    
    datos_sub <- data.frame(datos_sub)
    
    n_promedio <- eval(parse(text = paste0("weighted.mean(datos_sub$", 
                                           variable, ",datos_sub$", ponderador, ",na.rm=T)")))
    n_mediana <- eval(parse(text = paste0("weighted.median(datos_sub$", 
                                          variable, ",datos_sub$", ponderador, ",na.rm=T)")))
    n_varianza <- eval(parse(text = paste0("weighted.var(datos_sub$", 
                                           variable, ",datos_sub$", ponderador, ",na.rm=T)")))
    n_desvest <- n_varianza^0.5
    n_maximo <- eval(parse(text = paste0("max(datos_sub$", 
                                         variable, ",na.rm=T)")))
    n_minimo <- eval(parse(text = paste0("min(datos_sub$", 
                                         variable, ",na.rm=T)")))
    
    
    # cat('\n')
    # cat(paste0(" datos_sub %>% filter(!is.na(",variable,"))"))
    # cat('\n')
    # cat(variable)
    # 
    # cat('\n')
    # cat(head(names(datos_sub)))
    # cat('\n')
    # cat(head(str(datos_sub)))
    
    datos_x <- eval(parse(text = paste0(" datos_sub %>% filter(!is.na('",variable,"'))")))
    
    # datos_x <- eval(parse(text = paste0(" datos_sub %>% filter(!is.na('",variable,"')) %>% data.frame")))
    # 
    # datos_x <- datos_x %>% setNames(names(datos_sub))
    # 
    # cat('\n')
    # cat(head(names(datos_x)))
    # cat('\n')
    # cat(head(str(datos_x)))
    
    n_total <- eval(parse(text = paste0("\n      sum(datos_x$",ponderador,",na.rm=T)")))
    
    resultado <- eval(parse(text = paste0("data.frame(", 
                                          variable, "= c(\"promedio\",\"mediana\",\"varianza\",\"desvest\",\"maximo\",\"minimo\",\"TOTAL\"),\n      est = c(round(n_promedio,2),round(n_mediana,2),round(n_varianza,2),round(n_desvest,2),round(n_maximo,2),round(n_minimo,2),round(n_total,2)))")))
    return(resultado)
  }
  f_arregla_nombres_renglones <- function(tabla, variable) {
    cuantos <- str_length(variable)
    rownames(tabla) <- str_sub(rownames(tabla), cuantos + 
                                 1, 1e+05)
    return(tabla)
  }
  f_multiple <- function(tipo, ponderador, variable, datos_sub, 
                         extra2, extra4) {
    w_columnas_no_vacias <- function(df) {
      as.vector(which(colSums(is.na(df)) != nrow(df)))
    }
    w_reduce_tablas_sumando <- function(df1, df2) {
      preresultado <- merge(df1, df2, by = "row.names", 
                            all = T)
      preresultado[is.na(preresultado)] <- 0
      preresultado$suma <- preresultado[, 2] + preresultado[, 
                                                            3]
      resultado <- preresultado %>% dplyr::select(suma)
      rownames(resultado) <- preresultado[, 1]
      return(resultado)
    }
    f_nombre <- function(tabla, ponderador, tipo) {
      if (ponderador == "ponderador_default") {
        if (tipo == "f") {
          names(tabla) <- "frec_n"
        }
        else if (tipo == "p") {
          names(tabla) <- "prop_n"
        }
      }
      else if (ponderador == "ponderador") {
        if (tipo == "f") {
          names(tabla) <- "frec_p"
        }
        else if (tipo == "p") {
          names(tabla) <- "prop_p"
        }
      }
      return(tabla)
    }
    f_excluye_nivel_de_todos_menos_primero <- function(lista, 
                                                       nivel) {
      if (!is.na(nivel)) {
        if (length(lista) > 1) {
          for (i in 2:length(lista)) {
            coincidencia <- match(nivel, rownames(lista[[i]]))
            if (!is.na(coincidencia)) {
              lista[[i]][coincidencia, 1] <- 0
            }
          }
        }
      }
      return(lista)
    }
    if (str_detect(variable, " ")) {
      variable <- str_split(variable, " ") %>% unlist
    }
    if (str_detect(extra2, " ")) {
      extra2 <- str_split(extra2, " ") %>% unlist
    }
    contiene <- paste0("contains(\"", variable, "\")", collapse = ",")
    filtro <- paste0("%>% dplyr::select(", contiene, ")")
    if (is.na(filtro)) {
      filtroneg <- NA
    }
    else {
      filtroneg <- paste0("%>% dplyr::select(!contains(\"", 
                          extra2, "\"))", collapse = " ")
    }
    bateria <- eval(parse(text = paste0("datos", filtro, 
                                        filtroneg)))
    bateria <- bateria[, w_columnas_no_vacias(bateria)]
    eval(parse(text = paste0("bateria$", ponderador, " <- datos$", 
                             ponderador)))
    lista_resultados <- map(names(bateria)[1:(length(names(bateria)) - 
                                                1)], f_tabla, tipo = "f", ponderador = ponderador, 
                            datos_sub = bateria) %>% map2(., names(bateria)[1:(length(names(bateria)) - 
                                                                                 1)], f_arregla_nombres_renglones) %>% f_excluye_nivel_de_todos_menos_primero(., 
                                                                                                                                                              extra4) %>% reduce(., w_reduce_tablas_sumando) %>% 
      f_nombre(., ponderador = ponderador, tipo = tipo)
    if (tipo == "p") {
      nombres <- names(lista_resultados)[1]
      nombres_row <- rownames(lista_resultados)
      eval(parse(text = paste0("lista_resultados <- lista_resultados %>%\n        mutate(\n          k = round(", 
                               names(lista_resultados)[1], "/sum(bateria$", 
                               ponderador, ")*100,2)\n        )")))
      lista_resultados <- lista_resultados %>% dplyr::select(2)
      names(lista_resultados) <- str_replace(nombres, "frec", 
                                             "prop")
      rownames(lista_resultados) <- nombres_row
    }
    return(lista_resultados)
  }
  f_totales_multiple <- function(datos, ponderador) {
    resultado <- eval(parse(text = paste0("sum(datos$", ponderador, 
                                          ")")))
    return(resultado)
  }
  resultado <- NA
  if (is.na(tipo)) {
    return(resultado)
  }
  ponderador[is.na(ponderador)] <- "ponderador_default"
  if ("ponderador_default" %in% ponderador) 
    datos$ponderador_default <- 1
  tipo <- str_split(tipo, pattern = "") %>% unlist
  estructura <- tryCatch(eval(parse(text = paste0("is.numeric(datos$", 
                                                  variable, ")"))), error = function(e) {
                                                    FALSE
                                                  })
  datos_sub <- f_filtro(datos = datos, filtro = filtro)
  if (is.na(extra)) {
    if (estructura) {
      tf <- f_numerica(tipo = tipo, ponderador = ponderador[1], 
                       variable = variable, datos_sub = datos_sub, nombre = nombre)
    }
    else {
      tf <- map2(tipo, ponderador, f_tabla, variable = variable, 
                 datos_sub = datos_sub) %>% reduce(cbind) %>% 
        tibble::rownames_to_column(., nombre) %>% adorn_totals("row")
    }
  }
  else if (extra == "multiple") {
    tf <- map2(tipo, ponderador, f_multiple, variable, datos_sub, 
               extra2, extra4 = extra4) %>% reduce(cbind) %>% tibble::rownames_to_column(., 
                                                                                         nombre) %>% adorn_totals("row")
  }
  return(tf)
}