#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.