Limpieza de datos en Excel
Ricardo Hurtado Arredondo
2024
if(!require('pacman')) install.packages("pacman")
pacman::p_load(tidyverse,readxl,bizdays, lubridate, flexdashboard,shiny, scales, DT,openxlsx)0.1 Inicio
El siguiente ejercicio contienen una serie de pasos para realizar la limpieza y llenado de una base de datos, entre los cuales se comentan los siguientes:
- Datos fecha en formato fecha
- Datos de tipo texto con datos de tipo numerico en la misma variable
- Cruce de bases de datos con base a una llave de referencia
- Concatenar variables para crear una nueva
- Cálculo de valores con base a variables existentes
- Condicionales
- Cálculo con base a condicionales
0.1.1 Lectura de archivo
Se encuentra que en el archivo hay varias hojas de información, mismas que serviran para alimentar la base central. Por lo que se crea la siguiente función para leer todas las hojas, considerando en la lectura aquellas que deben ser traidas con el formato especifico, en este caso se utiliza “fecha” como indicativo de columnas con el formato “date”.
0.1.1.1 Cargar base
0.1.1.2 Función de lectura
# Función para leer las hojas y manejar tipos de columnas
lista_data <- lapply(hojas, function(x) {
# Leer los nombres de las columnas primero
nombres_columnas <- names(read_excel(ruta_excel, sheet = x, n_max = 0))
# Crear un vector de tipos de columnas
tipos_columnas <- ifelse(grepl("FECHA", nombres_columnas, ignore.case = TRUE), "date", "text")
# Leer la hoja con los tipos de columnas especificados, suprimiendo avisos
data <- suppressWarnings(read_excel(ruta_excel, sheet = x, col_types = tipos_columnas))
# Convertir columnas de texto que deberían ser numéricas, eliminando ceros a la izquierda
data <- data %>%
mutate(across(everything(), ~ if (is.character(.) && all(!grepl("\\D", .))) as.numeric(.) else .)) %>%
mutate(across(contains("FECHA"), ~ if_else(is.na(.), NA_Date_, .)))
return(data)
}
)
# Acceder a los datos de una hoja específica desde la lista
base <- lista_data[[2]] %>%
janitor::clean_names() # Accediendo a
proveedores <- lista_data[[3]] %>%
janitor::clean_names() # Accediendo a
localidades <- lista_data[[4]] %>%
janitor::clean_names() # Accediendo a0.1.2 Cálcular nueva variable
# Crear un calendario que excluya los fines de semana
calendario <- create.calendar(name='calendario', weekdays=c('saturday', 'sunday'))
base <- base %>%
mutate(
`fecha_de_embarque` = ymd(`fecha_de_embarque`),
`fecha_de_entrega` = ymd(`fecha_de_entrega`),
`tiempo_de_entrega` = bizdays(`fecha_de_embarque`, `fecha_de_entrega`, calendario)
)0.1.3 Unir bases
0.1.3.1 Unir para identificar paquetería
# Realizar el join y eliminar columnas duplicadas
base <- base %>%
left_join(
proveedores %>%
select(tracking, courier, `dias_de_garantia`) %>%
rename(
guia = tracking, # Renombrar TRACKING a GUÍA para hacer el join
paqueteria = courier # Renombrar COURIER a PAQUETERÍA
),
by = "guia" # Especificar la columna en común para el join
) %>%
# Seleccionar solo las columnas con .y y las que no tienen duplicado
select(-contains(".x")) %>%
rename_with(~ gsub("\\.y$", "", .), ends_with(".y"))0.1.3.2 Unir para identificar localidad
base <- base %>%
left_join(
localidades %>%
rename(
"codigo_postal_destino" = cp, # Renombrar TRACKING a GUÍA para hacer el join
"colonia_destino" = colonia, # Renombrar COURIER a PAQUETERÍA
"municipio_destino" = municipio,
"estado_destino" = estado
),
by = "codigo_postal_destino" # Especificar la columna en común para el join
) %>%
# Seleccionar solo las columnas con .y y las que no tienen duplicado
select(-contains(".x")) %>%
rename_with(~ gsub("\\.y$", "", .), ends_with(".y"))0.1.4 Concatenar
0.1.5 Cálculo de nueva variable con base a fechas
# Calcular la fecha tentativa de entrega sumando los días de garantía
base <- base %>%
mutate(
fecha_de_embarque = ymd(fecha_de_embarque), # Asegurar que la columna fecha_de_embarque sea de tipo Date
fecha_tentativa_de_entrega = add.bizdays(fecha_de_embarque, dias_de_garantia, calendario) # Sumar días laborables
)0.1.6 Cálculo de nueva variable con condicionales
# Calcular la columna "la_guia_esta_dentro_del_cumplimiento_de_garantia"
base <- base %>%
mutate(
# Calcular tiempo de entrega tentativo excluyendo fines de semana
tiempo_de_entrega_tentativo = bizdays(fecha_de_embarque, fecha_tentativa_de_entrega, calendario),
# Calcular la columna de cumplimiento de garantía
la_guia_esta_dentro_del_cumplimiento_de_garantia = case_when(
status == "Entregado" & tiempo_de_entrega > dias_de_garantia ~ "Fuera de garantia",
status != "Entregado" & tiempo_de_entrega_tentativo > dias_de_garantia ~ "Fuera de garantia",
TRUE ~ "Dentro de la garantia"
)
)0.1.7 Cambiar clase de variables
Para facilitar la visualización se cambia a tipo factor las variables de tipo caracter que son repetidas.
0.1.8 Indicador 01
base %>%
group_by(paqueteria) %>%
summarise(salidas_x_paqueteria = n()) %>%
arrange(salidas_x_paqueteria)0.1.9 Indicador 02
0.1.10 Indicador 03
base %>%
filter(status == "Entregado") %>%
group_by(estado_destino) %>%
summarise(tiempo_promedio_x_destino = round(mean(tiempo_de_entrega, na.rm = TRUE), 2)) %>%
arrange(tiempo_promedio_x_destino)0.1.11 Indicador 04
base %>%
group_by(la_guia_esta_dentro_del_cumplimiento_de_garantia) %>%
summarise(Guias_dentro_de_garantia = n())0.1.12 Indicador 05
base %>%
group_by(paqueteria) %>%
summarise(Guias_dentro_de_garantia = n_distinct(guia)) %>%
ggplot()+
geom_col(aes(x=paqueteria, y=Guias_dentro_de_garantia))
0.1.13 Guardar base creada en una nueva hoja de excel
# Ruta del archivo Excel existente
ruta_archivo <- "D:/RPubs/excel/app/data/PRUEBA DATA ANALYST FINAL.xlsx"
# Cargar el archivo existente
archivo_excel <- loadWorkbook(ruta_archivo)
# Eliminar la hoja si ya existe
if("Data Final" %in% names(archivo_excel)) {
removeWorksheet(archivo_excel, "Data Final")
}
# Agregar una nueva hoja con la base de datos
addWorksheet(archivo_excel, "Data Final")
writeData(archivo_excel, "Data Final", base)
# Guardar el archivo Excel con la nueva hoja
saveWorkbook(archivo_excel, ruta_archivo, overwrite = TRUE)0.2 Dashboard
Para este ejercicio se desarrollo un dashboard interactivo, mismo que se deja en el siguiente link a continuación:
0.2.1 Anexo
Se adjunta el código para shiny
# #Librerias
# if(!require('tidyverse')) install.packages("tidyverse")
# if(!require('readxl')) install.packages("readxl")
# if(!require('bizdays')) install.packages("bizdays")
# if(!require('lubridate')) install.packages("lubridate")
# if(!require('shiny')) install.packages("shiny")
# if(!require('scales')) install.packages("scales")
# if(!require('DT')) install.packages("DT")
# if(!require('openxlsx')) install.packages("openxlsx")
# if(!require('rsconnect')) install.packages("rsconnect")
#
#
# #Archivo
# base <- read_excel("D:/RPubs/excel/app/data/PRUEBA DATA ANALYST FINAL.xlsx", sheet = 6)
#
# # Convertir factores a caracteres para los filtros
# paqueterias <- c("Total", as.character(unique(base$paqueteria)))
# estados_destino <- c("Total", as.character(unique(base$estado_destino)))
#
#
# # Define la interfaz de usuario
# ui <- fluidPage(
# tags$head(
# tags$style(HTML("
# .dataTables_wrapper {
# font-size: 12px;
# }
# .dataTables_wrapper .dataTables_filter {
# float: none;
# text-align: left;
# }
# "))
# ),
# titlePanel("Dashboard de Guías"),
#
# sidebarLayout(
# sidebarPanel(
# width = 4,
# selectInput("paqueteria", "Selecciona Paquetería:", choices = paqueterias),
# selectInput("estado_destino", "Selecciona Estado Destino:", choices = estados_destino),
#
# # Filtros y tablas
# h4("Número de guías por paquetería"),
# DTOutput("tabla_paqueteria"),
#
# h4("Entregas dentro de la garantía"),
# DTOutput("tabla_entregas_dentro_de_garantia"),
#
# h4("Número de guías por status"),
# DTOutput("tabla_status_paqueteria")
# ),
#
# mainPanel(
# width = 8,
# plotOutput("grafico_estado_destino"), # Gráfico de barras por estado destino
# plotOutput("grafico_status"), # Gráfico del número de guías por status
# plotOutput("histograma") # Histograma de tiempo de entrega
# )
# )
# )
#
# # Define la lógica del servidor
# server <- function(input, output) {
# # Filtra los datos basados en la selección del usuario
# datos_filtrados <- reactive({
# datos <- base
#
# if (input$paqueteria != "Total") {
# datos <- datos %>% filter(as.character(paqueteria) == input$paqueteria)
# }
#
# if (input$estado_destino != "Total") {
# datos <- datos %>% filter(estado_destino == input$estado_destino)
# }
#
# datos
# })
#
# # Genera la tabla con el número de guías por paquetería
# output$tabla_paqueteria <- renderDT({
# base %>%
# group_by(paqueteria) %>%
# summarise("Número de guías" = n_distinct(guia)) %>%
# arrange(desc(`Número de guías`)) %>%
# datatable(options = list(pageLength = 5, scrollX = TRUE, autoWidth = TRUE))
# })
#
# # Genera la tabla con el número de entregas realizadas dentro de la garantía
# output$tabla_entregas_dentro_de_garantia <- renderDT({
# base %>%
# group_by(paqueteria, la_guia_esta_dentro_del_cumplimiento_de_garantia) %>%
# summarise("Número de entregas" = n()) %>%
# pivot_wider(names_from = la_guia_esta_dentro_del_cumplimiento_de_garantia, values_from = `Número de entregas`, values_fill = list(`Número de entregas` = 0)) %>%
# arrange(desc(`Dentro de la garantia`)) %>%
# datatable(options = list(pageLength = 5, scrollX = TRUE, autoWidth = TRUE))
# })
#
# # Genera la tabla con el número de guías por status en formato ancho, reemplazando NA por 0
# output$tabla_status_paqueteria <- renderDT({
# base %>%
# group_by(paqueteria, status) %>%
# summarise("Número de guías" = n_distinct(guia)) %>%
# pivot_wider(names_from = status, values_from = `Número de guías`, values_fill = list(`Número de guías` = 0)) %>%
# replace(is.na(.), 0) %>%
# datatable(options = list(pageLength = 5, scrollX = TRUE, autoWidth = TRUE))
# })
#
# # Genera el gráfico de barras por estado destino (barras horizontales)
# output$grafico_estado_destino <- renderPlot({
# datos_filtrados() %>%
# group_by(estado_destino) %>%
# summarise(Numero_de_guias = n_distinct(guia)) %>%
# arrange(desc(Numero_de_guias)) %>%
# ggplot(aes(x = Numero_de_guias, y = reorder(estado_destino, Numero_de_guias))) +
# geom_bar(stat = "identity", fill = "skyblue") +
# geom_text(aes(label = comma(Numero_de_guias)), hjust = -0.1) +
# labs(title = "Número de Guías por Estado Destino",
# x = "Número de Guías",
# y = " ") +
# scale_x_continuous(labels = comma) +
# theme_minimal() +
# theme(axis.text.y = element_text(angle = 0, hjust = 1))
# })
#
# # Genera el gráfico de barras por status (barras horizontales)
# output$grafico_status <- renderPlot({
# datos_filtrados() %>%
# group_by(status) %>%
# summarise(Numero_de_guias = n_distinct(guia)) %>%
# arrange(desc(Numero_de_guias)) %>%
# ggplot(aes(x = Numero_de_guias, y = reorder(status, Numero_de_guias))) +
# geom_bar(stat = "identity", fill = "coral") +
# geom_text(aes(label = comma(Numero_de_guias)), hjust = -0.1) +
# labs(title = "Número de Guías por Status",
# x = "Número de Guías",
# y = " ") +
# scale_x_continuous(labels = comma) +
# theme_minimal()
# })
#
# # Genera el histograma
# output$histograma <- renderPlot({
# ggplot(datos_filtrados(), aes(x = tiempo_de_entrega)) +
# geom_histogram(binwidth = 1, fill = "lightgreen", color = "white") +
# labs(title = paste("Histograma de Tiempo de Entrega para", input$paqueteria),
# x = "Tiempo de Entrega (Días)",
# y = "Frecuencia") +
# theme_minimal()
# })
# }
#
# # Ejecuta la aplicación
# shinyApp(ui = ui, server = server)
#
# rsconnect::deployApp()