R/db_subir_base.R

In pelishk/upax_library: Librería de análisis

#' Sube un data frame a la base de datos, requiere que se registre el proyecto en la tabla de proyectos
#'
#' @param datos data frame con los datos que se subiran a la base de datos
#' @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
#' # db_subir_base(datos,1)
#' # db_subir_base(datos,proyecto = "Product Tracker Divisas",ola = 1)
#'

db_subir_base<-function(datos,proyecto_id = NA, proyecto = NA,ola = NA,con_pass = db_conexion()){
  require(tidyr)
  require(dplyr)
  
  niveles_a_dataframe<-function(valor,pregunta){
    #### descripción
    # Convierte los niveles de una variable factor a un dataframe
    #### inputs
    #valor:           vector con los niveles
    #pregunta:        nombre de la pregunta
    #### outputs
    #dataframe:       data frame de los niveles de la pregunta
    
    df<- valor %>% unlist() %>%  
      data.frame(stringsAsFactors = FALSE) %>%  mutate(pregunta = pregunta)
    colnames(df)<-c("respuesta","pregunta")
    return(df)
  }
  
  lista_a_dataframe<-function(lista){
    require(dplyr)
    
    lista<- lista %>% unlist()
    lista<-lista[!lista%in%""]
    
    df<- lista %>%  t()%>% 
      data.frame(stringsAsFactors = FALSE)
    colnames(df)<-paste0("c",1:ncol(df))
    return(df)
  }
  
  f_load_in_file <- function(con_pass,datos,tabla,modo){
    #### descripción
    # Sube una tabla de información a la base
    #### inputs
    #con_pass:           cadena de conexion a la BD
    #datos:              dataframe a subir a la BD
    #tabla:              nombre de la tabla donde se almacenara la información
    
    # directorio<-dirname(rstudioapi::getActiveDocumentContext()$path)
    
    directorio<-tempdir()
    # cat(paste0('dir:',directorio))
    # cat('\n')
    archivo<-paste0(tabla,".csv")
    ruta<-paste0(directorio,"/",archivo)
    # cat(ruta)
    
    write.csv(datos,ruta,row.names = FALSE,col.names = FALSE)
    
    if(modo == "tabla_principal"){
      DBI::dbSendQuery(con_pass,paste0("CREATE TABLE ",tabla," (
                                  proyecto_id	int(3),
                                  encuestado_id	int(11),
                                  pregunta_id   int(11),
                                  respuesta_id	int(11)
      );") )
    
    }else if(modo == "tabla_preguntas"){
      DBI::dbSendQuery(con_pass,paste0("CREATE TABLE ",tabla," (
                                  pregunta_id	int(11),
                                  pregunta_num	int(11),
                                  pregunta	varchar(200),
                                  tipo	varchar(9)
      );") )
    
    }else if(modo == "tabla_respuestas"){
      DBI::dbSendQuery(con_pass,paste0("CREATE TABLE ",tabla," (
                                  respuesta_id	int(11),
                                  pregunta_id	int(11),
                                  respuesta	varchar(255)
      );") )
      
    }else{
      stop("Se necesita un modo para continuar")
    }
    
    
    
    DBI::dbSendQuery(con_pass,
                paste0("  LOAD DATA LOCAL INFILE '",ruta,"'
                       INTO TABLE ",tabla,"
                       FIELDS TERMINATED BY ',' ENCLOSED BY '\"'
                       LINES TERMINATED BY '\n'
                       IGNORE 1 LINES;"))
    
  }
  
  #Obtenemos los datos del proyecto
  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")
  )
  
  if(proyecto_datos["tabla"]%in%DBI::dbListTables(con_pass)){
    input<-menu(c("Si", "No"), title="Esta operación borrará los datos contenidos en las tablas del proyecto  ¿Deseas continuar?")
    if(input %in% 1){
      DBI::dbSendQuery(con_pass, paste0("DROP TABLE ",proyecto_datos[c("tabla")],";"))
      DBI::dbSendQuery(con_pass, paste0("DROP TABLE ",proyecto_datos[c("tabla_preguntas")],";"))
      DBI::dbSendQuery(con_pass, paste0("DROP TABLE ",proyecto_datos[c("tabla_respuestas")],";"))
    }else{
      stop("No se realizaron cambios")
    }
    # print(dbListTables(con_pass))
  }
  
  #Construimos las tablas
  #Convierto los datos al formato largo
  datos_long<-datos %>% 
    mutate(encuestado_id = row_number()) %>% 
    mutate_if(is.logical,as.numeric) %>% 
    mutate_if(is.numeric,as.character,is.factor, as.character)  %>% 
    tidyr::pivot_longer(-encuestado_id,names_to = "pregunta", values_to = "respuesta") 
  
  #Creo la tabla de preguntas
  tabla_preguntas<-datos %>% 
    lapply(class) %>% 
    purrr::map(.,lista_a_dataframe)%>% 
    do.call(bind_rows, .) %>% 
    cbind(.,names(datos)) %>% 
    mutate(pregunta_id = row_number(),
           pregunta_num = `names(datos)`,
           c1 = ifelse(c1 %in% "labelled",c2,c1)) %>% 
    rename(tipo  = c1,
           pregunta = `names(datos)`)%>% 
    dplyr::select(pregunta_id,pregunta_num,pregunta,tipo)
  
  #Creo la tabla de respuestas
  ordenadas<-tabla_preguntas %>% filter(tipo %in% c("factor","ordered"))%>% dplyr::select(pregunta) %>% t() %>%as.vector
 if(length(ordenadas)>0){
   tabla_respuestas_ordenadas<-datos %>% dplyr::select(!!ordenadas) %>% lapply(levels)
   tabla_respuestas_ordenadas <- purrr::map2(tabla_respuestas_ordenadas,names(tabla_respuestas_ordenadas),niveles_a_dataframe) %>% 
     do.call(bind_rows, .) %>% dplyr::select(pregunta,respuesta)
   
   tabla_respuestas<-  datos_long %>%  
     filter(!pregunta %in% ordenadas) %>% 
     distinct(pregunta,respuesta)  %>% 
     rbind(.,tabla_respuestas_ordenadas) %>% 
     left_join(.,tabla_preguntas %>%  dplyr::select(pregunta_id,pregunta),"pregunta") %>% 
     arrange(pregunta_id) %>% 
     mutate(respuesta_id = row_number(),
            llave_compuesta = paste0(pregunta_id,"-",respuesta)) %>% 
     dplyr::select(respuesta_id,pregunta_id,respuesta,llave_compuesta) 
 }else{
   tabla_respuestas<-  datos_long %>%  
     distinct(pregunta,respuesta)  %>% 
     left_join(.,tabla_preguntas %>%  dplyr::select(pregunta_id,pregunta),"pregunta") %>% 
     arrange(pregunta_id) %>% 
     mutate(respuesta_id = row_number(),
            llave_compuesta = paste0(pregunta_id,"-",respuesta)) %>% 
     dplyr::select(respuesta_id,pregunta_id,respuesta,llave_compuesta)  
   }

  #Tabla con los datos
  tabla<-datos_long %>% 
    left_join(.,tabla_preguntas %>%  dplyr::select(pregunta_id,pregunta),"pregunta") %>% 
    mutate(llave_compuesta = paste0(pregunta_id,"-",respuesta),
           proyecto_id = proyecto_id) %>% 
    left_join(.,tabla_respuestas %>%  dplyr::select(respuesta_id,llave_compuesta),"llave_compuesta")%>% 
    dplyr::select(proyecto_id,encuestado_id,pregunta_id,respuesta_id)
  
  tabla_respuestas<-tabla_respuestas %>% dplyr::select(respuesta_id,pregunta_id,respuesta) 
  
  ### Escribir los datos en base 
  f_load_in_file(con_pass,tabla,proyecto_datos[c("tabla")],modo = "tabla_principal")
  f_load_in_file(con_pass,tabla_preguntas,proyecto_datos[c("tabla_preguntas")],modo = "tabla_preguntas")
  f_load_in_file(con_pass,tabla_respuestas,proyecto_datos[c("tabla_respuestas")],modo = "tabla_respuestas")
  
  DBI::dbDisconnect(con_pass)
  
}