R/db_bajar_base.R

Defines functions db_bajar_base

Documented in db_bajar_base

#' Descarga la base de un proyecto registrado en la tabla de proyectos
#'
#' @param proyecto_id id del proyecto asignado en la tabla de proyectos. En caso de proporcionar este campo ya no es necesario indicar proyecto y ola
#' @param proyecto nombre del proyecto que se le asigno en la tabla de proyectos. En caso de proporcionar este campo y el de ola ya no es necesario indicar proyecto_id
#' @param ola numero de ola que se asigno en la tabla de proyectos. En caso de proporcionar este campo y proyecto ya no es necesario indicar proyecto_id
#' @param con_pass cadena de conexion a la BD
#' 
#' @examples
#' # datos<-db_bajar_base(1)
#' # datos<-db_bajar_base(proyecto = "Product Tracker Divisas", ola = 1)
#'

db_bajar_base<-function(proyecto_id = NA, proyecto = NA,ola = NA,con_pass = db_conexion()){
  require(tidyr)
  require(dplyr)
  
  if(!is.na(proyecto)&!is.na(ola)){
    proyecto_datos<-DBI::dbGetQuery(con_pass,paste0("SELECT * FROM proyectos WHERE proyecto = '",proyecto,"' AND ola = ", ola))
  }else if(!is.na(proyecto_id)){
    proyecto_datos<-DBI::dbGetQuery(con_pass,paste0("SELECT * FROM proyectos WHERE proyecto_id = ",proyecto_id))
  }
  
  #Preparamos la tabla con la información del proyecto
  proyecto_datos<-proyecto_datos %>% data.frame() %>%
    mutate(proyecto_id = as.numeric(proyecto_id),
           fecha = as.character(fecha)) %>% 
    slice(1) %>% 
    unlist()
  
  if(length(proyecto_datos)>0){
    proyecto_id<-proyecto_datos["proyecto_id" ]
  }else(
    stop("No se encuentra el proyecto en la tabla de proyectos")
  )
  
  tabla<-DBI::dbGetQuery(con_pass,paste0("SELECT * FROM ", proyecto_datos[c("tabla")]))
  tabla_preguntas<-DBI::dbGetQuery(con_pass,paste0("SELECT * FROM ", proyecto_datos[c("tabla_preguntas")]))
  tabla_respuestas<-DBI::dbGetQuery(con_pass,paste0("SELECT * FROM ", proyecto_datos[c("tabla_respuestas")]))
  
  tabla<-tabla %>% 
    left_join(.,tabla_preguntas %>% dplyr::select(pregunta_id,pregunta),by = "pregunta_id") %>%
    left_join(.,tabla_respuestas %>% dplyr::select(respuesta_id,respuesta),by = "respuesta_id") %>% 
    dplyr::select(encuestado_id,pregunta,respuesta) %>% 
    tidyr::pivot_wider(id_cols = encuestado_id,
                names_from = pregunta,
                values_from = respuesta) %>% 
    data.frame()
  
  tabla_preguntas<-tabla_preguntas %>% filter(pregunta %in% names(tabla))
  p_char<-tabla_preguntas %>% filter(pregunta %in% names(tabla) ,tipo %in% "character") %>% dplyr::select(pregunta_id,pregunta)
  P_num<-tabla_preguntas %>% filter(tipo %in% "numeric")%>% dplyr::select(pregunta_id,pregunta)
  p_int<-tabla_preguntas %>% filter(tipo %in% "integer")%>% dplyr::select(pregunta_id,pregunta)
  p_log<-tabla_preguntas %>% filter(tipo %in% "logical")%>% dplyr::select(pregunta_id,pregunta)
  p_fact<-tabla_preguntas %>% filter(tipo %in% "factor")%>% dplyr::select(pregunta_id,pregunta)
  p_ord<-tabla_preguntas %>% filter(tipo %in% "ordered")%>% dplyr::select(pregunta_id,pregunta)
  
  if(nrow(p_char)>0){
    variables<-p_char %>% dplyr::select(pregunta) %>% t() %>%as.vector
    tabla<-tabla %>% mutate_at(variables,as.character)
  }
  
  if(nrow(P_num)>0){
    variables<-P_num %>% dplyr::select(pregunta) %>% t() %>%as.vector
    tabla<-tabla %>% mutate_at(variables,as.character) %>% mutate_at(variables,as.numeric)
  }
  
  if(nrow(p_int)>0){
    variables<-p_int %>% dplyr::select(pregunta) %>% t() %>%as.vector
    tabla<-tabla %>% mutate_at(variables,as.character) %>% mutate_at(variables,as.integer)
  }
  
  if(nrow(p_log)>0){
    variables<-p_log %>% dplyr::select(pregunta) %>% t() %>%as.vector
    tabla<-tabla  %>% mutate_at(variables,as.character) %>% mutate_at(variables,as.numeric) %>% mutate_at(variables,as.logical)
  }
  
  if(nrow(p_fact)>0){
    variables<-p_fact %>% dplyr::select(pregunta) %>% t() %>%as.vector
    variables_id<-p_fact %>% dplyr::select(pregunta_id) %>% t() %>%as.vector
    for(i in 1:length(variables)){
      niveles<-tabla_respuestas %>% filter(pregunta_id == variables_id[i]) %>% dplyr::select(respuesta)%>% t() %>%as.vector
      tabla[,variables[i]]<-factor(tabla[,variables[i]],levels = niveles)
    }
  }
  
  
  if(nrow(p_ord)>0){
    variables<-p_ord %>% dplyr::select(pregunta) %>% t() %>%as.vector
    variables_id<-p_ord %>% dplyr::select(pregunta_id) %>% t() %>%as.vector
    for(i in 1:length(variables)){
      niveles<-tabla_respuestas %>% filter(pregunta_id == variables_id[i]) %>% dplyr::select(respuesta)%>% t() %>%as.vector
      tabla[,variables[i]]<-factor(tabla[,variables[i]],ordered = TRUE,levels = niveles)
    }
  }
  
  DBI::dbDisconnect(con_pass)
  return(tabla %>% select(-encuestado_id))
}
pelishk/upax_library documentation built on Nov. 28, 2022, 10:45 a.m.