R/r_cruces.R

#' genera cruces
#'
#' Función para generar tablas de frecuencias y porcentajes con o sin ponderación
#'
#' @param v1 caracter con el nombre de la variable x
#' @param v2 caracter con el nombre de la variable y
#' @param nombre1 caracter con el nombre que será impreso x
#' @param nombre2 caracter con el nombre que será impreso x
#' @param tipo caracter con los tipos de tablas que se calcularán separados por espacios "p pp fp f"
#' @param ponderador caracter con el nombre del ponderador que se utilizará, default NA
#' @param datos dataframe con los datos
#'
#'
#' @return un tibble con las tablas requeridas




r_cruces <- function (v1, v2, nombre1, nombre2, tipo, ponderador = NA, datos) 
{
  
  require(upax)
  require(dplyr)
  require(survey)
  
  resultado <- NA
  if (is.na(tipo)) {
    return(resultado)
  }
  if (is.na(ponderador)) {
    tipo <- str_replace(tipo, "fp ", "")
    tipo <- str_replace(tipo, " fp", "")
    tipo <- str_replace(tipo, "pp ", "")
    tipo <- str_replace(tipo, " pp", "")
  }
  p <- paste0("%>% dplyr::select(", v1, ",", v2, ")")
  if (!is.na(ponderador)) {
    p <- paste0("%>% dplyr::select(", v1, ",", v2, ",", ponderador, 
                ")")
  }
  tipos <- strsplit(tipo, "") %>% unlist
  lista <- list()
  eval(parse(text = paste0("datos_sub <- datos", p)))
  f_cruce <- function(tipo_solo, v1, v2, ponderador, datos_sub) {
    if (tipo_solo == "f") {
      eval(parse(text = paste0("diseno <- svydesign(data = datos_sub,id=~1)")))
      resultado <- eval(parse(text = paste0("svytable(~", 
                                            v1, " + ", v2, ",diseno)"))) %>% data.frame %>% 
                                            {
                                              eval(parse(text = paste0("pivot_wider(.,names_from = '", 
                                                                       v2, "',values_from = 'Freq')")))
                                            }
    }
    else if (tipo_solo == "p") {
      eval(parse(text = paste0("diseno <- svydesign(data = datos_sub,id=~1)")))
      resultado <- eval(parse(text = paste0("svytable(~", 
                                            v1, " + ", v2, ",diseno)"))) %>% data.frame %>% 
                                            {
                                              eval(parse(text = paste0("pivot_wider(.,names_from = '", 
                                                                       v2, "',values_from = 'Freq')")))
                                            } %>% {
                                              eval(parse(text = paste0("mutate_if(.,.predicate = is.numeric,.funs = function(x){x/sum(x)})")))
                                            }
    }
    else if (tipo_solo == "fp") {
      eval(parse(text = paste0("diseno <- svydesign(data = datos_sub,id=~1,weights=~", 
                               ponderador, ")")))
      resultado <- eval(parse(text = paste0("svytable(~", 
                                            v1, " + ", v2, ",diseno)"))) %>% data.frame %>% 
                                            {
                                              eval(parse(text = paste0("pivot_wider(.,names_from = '", 
                                                                       v2, "',values_from = 'Freq')")))
                                            }
    }
    else if (tipo_solo == "pp") {
      eval(parse(text = paste0("diseno <- svydesign(data = datos_sub,id=~1,weights=~", 
                               ponderador, ")")))
      resultado <- eval(parse(text = paste0("svytable(~", 
                                            v1, " + ", v2, ",diseno)"))) %>% data.frame %>% 
                                            {
                                              eval(parse(text = paste0("pivot_wider(.,names_from = '", 
                                                                       v2, "',values_from = 'Freq')")))
                                            } %>% {
                                              eval(parse(text = paste0("mutate_if(.,.predicate = is.numeric,.funs = function(x){x/sum(x)})")))
                                            }
    }
    return(resultado)
  }
  lista <- map(tipos, f_cruce, v1, v2, ponderador, datos_sub) 
  
  for(i in 1:length(lista)){
    n1 <- paste0(nombre1,'::',names(lista[[i]])[1])
    
    n2 <- paste0(nombre2,'::',names(lista[[i]])[-1],'::',tipos[i])
    
    names(lista[[i]]) <- c(n1,n2)
  }
  
  if(length(lista)>1){
    for(i in 2:length(lista)){
      
      lista[[i]] <- lista[[i]] <- lista[[i]][,-1]
      
    }
  }
  
  
  lista <- lista %>% 
    reduce(cbind)
  
  
  lista <- lista %>% adorn_totals()
  
  
  
  # %>% setNames(paste0(map(tipos, rep, length(lista)/length(tipos)) %>% 
  #                                       reduce(c), "::", names(.)))
  # tabla_resultado <- map(tipos, rep, length(lista)/length(tipos)) %>% 
  #   reduce(c) %>% setNames(paste0(map(tipos, rep, length(.)) %>% 
  #                                   reduce(c), "::", names(.)))
  # return(tabla_resultado)
  return(lista)
}
pelishk/upax_library documentation built on Nov. 28, 2022, 10:45 a.m.