Examen R
Jorge Cáceres Barrales
2024-07-11
Objetivo de Investigación
El objetivo de esta investigación es desarrollar y validar funciones en R que permitan la búsqueda eficiente de hiperparámetros utilizando validación cruzada para múltiples algoritmos de aprendizaje automático. Además, se busca implementar una función para la normalización de datos que facilite la preparación de conjuntos de datos para el modelado, asegurando la calidad y consistencia de los mismos.
Introducción
En el ámbito del aprendizaje automático, la optimización de
hiperparámetros y la correcta preparación de los datos son esenciales
para mejorar el rendimiento y la precisión de los modelos. En este
proyecto, desarrollaremos una función en R que utiliza la librería
caret para realizar búsquedas de hiperparámetros mediante
validación cruzada, aplicada a diferentes algoritmos de aprendizaje
automático. Adicionalmente, implementaremos una función de normalización
de datos que manejará recodificación de variables categóricas, limpieza
de datos y transformación de valores, utilizando principios y paquetes
del ecosistema Tidyverse, técnicas de simulación de variables
aleatorias, álgebra matricial y algoritmos de optimización.
Desarrollo
Carga de Librerías
En este apartado se cargan todas las librerías necesarias para el desarrollo del proyecto, incluyendo librerías para la manipulación de datos, modelado y validación de modelos, así como para la implementación de tests unitarios.
# Cargar librerías necesarias
library(caret) # Para el preprocesamiento y modelado de datos## Cargando paquete requerido: ggplot2## Cargando paquete requerido: latticelibrary(xgboost) # Para la implementación del algoritmo de boosting
library(data.table) # Para la manipulación rápida de datos
library(dplyr) # Para la manipulación de datos con el uso de pipes##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:data.table':
##
## between, first, last## The following object is masked from 'package:xgboost':
##
## slice## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(stringr) # Para manipulación de cadenas
library(testthat) # Para realizar tests unitarios##
## Adjuntando el paquete: 'testthat'## The following object is masked from 'package:dplyr':
##
## matcheslibrary(tidyverse) # Colección de paquetes para manipulación y visualización de datos## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between() masks data.table::between()
## ✖ readr::edition_get() masks testthat::edition_get()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ purrr::is_null() masks testthat::is_null()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ purrr::lift() masks caret::lift()
## ✖ readr::local_edition() masks testthat::local_edition()
## ✖ tidyr::matches() masks testthat::matches(), dplyr::matches()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ dplyr::slice() masks xgboost::slice()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsCarga de Funciones y Base de Datos
Se cargan funciones específicas desde un archivo alojado en GitHub y se descargan los datos de permisos de circulación en formato CSV también desde GitHub. Esto permite tener acceso a las funciones y datos necesarios para el análisis.
# Enlace raw al archivo de funciones en GitHub
source("https://raw.githubusercontent.com/jkcrs1/R/main/funciones.R")## Warning: package 'ggcorrplot' was built under R version 4.4.1## Warning: package 'rlang' was built under R version 4.4.1##
## Adjuntando el paquete: 'rlang'## The following objects are masked from 'package:purrr':
##
## %@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
## flatten_raw, invoke, splice## The following objects are masked from 'package:testthat':
##
## is_false, is_null, is_true## The following object is masked from 'package:data.table':
##
## :=# Cargar los datos de permisos de circulación desde un CSV en GitHub
url3 <- "https://github.com/jkcrs1/R/raw/main/permiso_circulacion_calbuco.csv"
data_carga <- read.csv(url3, sep = ";", fileEncoding = "ISO-8859-1")Normalización de las Variables
Se definen las mapeos y listas de columnas necesarias para la normalización de datos, incluyendo columnas categóricas, de fecha, numéricas y el objetivo, así como las columnas requeridas para asegurar la consistencia y limpieza de los datos.
cat_col_mappings <- list(
tipo_vehiculo = c(
"AMBULANCIA" = "AMBULANCIA", "AUTOMOVIL" = "AUTOMOVIL",
"BUS" = "BUS", "Cabriolet" = "AUTOMOVIL", "CAMION" = "CAMION",
"CAMIONETA" = "CAMIONETA", "CARRO ARRASTRE A" = "REMOLQUE",
"CARRO BOMBA" = "CARRO BOMBA", "CASA RODANTE" = "CASA RODANTE",
"Comercial" = "COMERCIAL", "CUATRIMOTO" = "CUATRIMOTO",
"FURGON" = "FURGON", "GRUA" = "MAQUINA PESADA", "Hatchback" = "AUTOMOVIL",
"JEEP" = "AUTOMOVIL", "MAQUINA INDUSTRIAL" = "MAQUINA INDUSTRIAL",
"MINIBUS" = "MINIBUS", "MINIBUS ESCOLAR" = "MINIBUS",
"MINIBUS PARTICULAR" = "MINIBUS", "MINIBUS PRIVADO" = "MINIBUS",
"MINIBUS TURISMO" = "MINIBUS", "MOTO" = "MOTOCICLETA",
"MOTOCICLETA" = "MOTOCICLETA", "OTROS" = "OTROS", "REMOLQUE A" = "REMOLQUE",
"REMOLQUE B" = "REMOLQUE", "RETROEXCAVADORA" = "MAQUINA PESADA",
"Sedan" = "AUTOMOVIL", "SEMI REMOLQUE" = "REMOLQUE",
"STATION WAGON" = "AUTOMOVIL", "SUV" = "SUV", "TAXI EJECUTIVO" = "TAXI",
"TAXI BASICO" = "TAXI", "TAXI COLECTIVO" = "TAXI", "TRACTOCAMION" = "CAMION",
"TRACTOR" = "TRACTOR", "VAN" = "VAN"
),
tipo_combustible = c(
"Benc" = "Bencina", "Dies" = "Diesel", "NULL" = "NULL",
"DUAL" = "Hibrido", "Hibr" = "Hibrido", "Elec" = "Electrico"
),
transmision = c(
"Mec" = "Mecanica", "Aut" = "Automatica", "NULL" = "NULL",
"CVT" = "Automatica", "DCT" = "Automatica"
)
)
cat_cols <- c("grupo_vehiculo","tipo_vehiculo", "tipo_combustible",
"transmision", "marca", "forma_pago")
date_cols <- c("fecha_pago")
numeric_cols <- c("valor_neto", "valor_ipc", "valor_multa", "valor_pagado")
nombre_cols <- c("municipalidad", "grupo_vehiculo", "placa",
"digito", "codigo_sii", "forma_pago", "tipo_vehiculo",
"marca", "modelo", "color", "transmision",
"tipo_combustible", "equipamiento")
target_col <- "valor_pagado"
required_cols <- c("valor_pagado", "fecha_pago")Funcion para normalizar datos
La función normalizar_data se encarga de transformar y
limpiar los datos. Realiza la recodificación de variables categóricas,
reemplaza valores nulos, convierte datos numéricos y de fecha, y filtra
duplicados. Al final, retorna los datos normalizados junto con la
duración del proceso en formato S3.
normalizar_data <- function(data,
cat_col_mappings = list(),
cat_cols = c(),
date_cols = c(),
numeric_cols = c(),
title_cols = c(),
target_col = NULL,
required_cols = c(),
date_format = "%d-%m-%y",
replace_nas = TRUE,
replace_nas_with_median = TRUE) {
# Marcar el inicio del tiempo de ejecución
hora_inicio <- Sys.time()
cat("La cantidad de registros:", nrow(data), "\n")
# Convertir data a data.frame (por si no lo es)
data <- data.frame(data)
# Cambio de nombres de columnas: reemplazar puntos por guiones bajos y convertir a minúsculas
colnames(data) <- colnames(data) %>% str_replace_all("\\.", "_") %>% tolower()
# Recodificar las variables categóricas según los mapeos proporcionados
for (col in names(cat_col_mappings)) {
if (col %in% colnames(data) && !is.null(data[[col]])) {
data[[col]] <- dplyr::recode(data[[col]], !!!cat_col_mappings[[col]])
# dplyr::recode para recodificar
}
}
# Reemplazar nulos en todas las variables numéricas si replace_nas es TRUE
if (replace_nas) {
data <- data %>%
dplyr::mutate(dplyr::across(where(is.numeric),
~ replace_na(., median(., na.rm = TRUE))))
# dplyr::mutate y dplyr::across para transformación
}
# Convertir a título en variables específicas
if (length(title_cols) > 0) {
data <- data %>%
dplyr::mutate(dplyr::across(all_of(title_cols), stringr::str_to_title))
# dplyr::mutate y stringr::str_to_title para conversión a título
}
# Quitar las "," y "." de los campos de valores y convertir a numérico
if (length(numeric_cols) > 0) {
data <- data %>%
dplyr::mutate(dplyr::across(all_of(numeric_cols),
~ as.numeric(gsub("[,\\.]", "", .))))
# dplyr::mutate y gsub para limpieza y conversión
}
# Convertir columnas de fecha
if (length(date_cols) > 0) {
for (col in date_cols) {
if (col %in% colnames(data) && !is.null(data[[col]])) {
data[[col]] <- as.Date(data[[col]], format = date_format)
# base::as.Date para conversión de fechas
}
}
# Crear nuevas variables basadas en fechas
if (date_cols[1] %in% colnames(data)) {
data <- data %>%
dplyr::mutate(
ano_pago = lubridate::year(data[[date_cols[1]]]),
# lubridate::year para extraer año
mes_pago = lubridate::month(data[[date_cols[1]]]),
# lubridate::month para extraer mes
ano_mes_pago = paste(sprintf("%02d", mes_pago),
substr(ano_pago, 3, 4), sep = "-")
# base::paste y base::sprintf para formateo
)
}
}
# Filtrar y eliminar duplicados específicos
for (col in required_cols) {
if (col %in% colnames(data)) {
data <- data %>%
dplyr::filter(!is.na(data[[col]]) & data[[col]] > 0) %>%
dplyr::distinct()
# dplyr::filter y dplyr::distinct para filtrar y eliminar duplicados
}
}
# Filtrar y eliminar duplicados si la columna objetivo está definida
if (!is.null(target_col) && target_col %in% colnames(data)) {
data <- data %>%
dplyr::filter(!is.na(data[[target_col]]) & data[[target_col]] > 0) %>%
dplyr::distinct()
}
# Transformación de variables categóricas a factores, manteniendo las columnas originales
if (length(cat_cols) > 0) {
for (col in cat_cols) {
if (col %in% colnames(data)) {
data[[paste0(col, "_factor")]] <- as.numeric(as.factor(data[[col]]))
# base::as.numeric y base::as.factor para conversión
}
}
}
# Incluye la transformación adicional de variables categóricas a factores
data <- data %>%
dplyr::mutate(dplyr::across(where(is.character), as.factor),
fecha = as.Date(paste(ano_pago, mes_pago, "01", sep = "-"),
format = "%Y-%m-%d"),
ano_mes_pago = paste(sprintf("%02d", mes_pago),
substr(ano_pago, 3, 4), sep = "-")) %>%
dplyr::arrange(fecha) %>%
dplyr::mutate(ano_mes_pago = factor(ano_mes_pago,
levels = unique(ano_mes_pago))) %>%
dplyr::select(-fecha)
# Reemplazar valores nulos por la mediana en todas las variables si replace_nas_with_median es TRUE
if (replace_nas_with_median) {
data <- data %>%
dplyr::mutate(dplyr::across(where(is.numeric), ~
replace_na(., median(., na.rm = TRUE))))
}
# Droplevels para la variable marca (si existe)
if ("marca" %in% colnames(data)) {
data$marca <- factor(data$marca)
data$marca <- droplevels(data$marca)
}
# Convertir variables categóricas a numéricas, manteniendo las columnas originales
data <- data %>%
dplyr::mutate(dplyr::across(ends_with("_factor"), as.numeric))
# Mostrar la cantidad de registros válidos
cat("La cantidad de registros válidos:", nrow(data), "\n")
# Marcar el fin del tiempo de ejecución y calcular la duración
hora_fin <- Sys.time()
duracion <- difftime(hora_fin, hora_inicio, units = "secs")
duracion_formateada <- sprintf("%02d:%02d:%02d",
as.integer(duracion) %/% 3600,
(as.integer(duracion) %% 3600) %/% 60,
as.integer(duracion) %% 60)
# Mostrar el tiempo de ejecución
cat("Tiempo de ejecución:", duracion_formateada, "segundos\n")
resultado <- list(data = data, duracion = duracion_formateada)
class(resultado) <- "normalizacion_resultado"
return(resultado)
}
# Método para imprimir la clase S3
print.normalizacion_resultado <- function(x) {
cat("Datos normalizados:\n")
print(head(x$data))
cat("\nDuración de la normalización:", x$duracion, "\n")
}Normalizar Dataset
Se aplica la función normalizar_data al conjunto de
datos cargado previamente, utilizando las configuraciones de mapeo y
columnas definidas. Esto normaliza y limpia los datos para su posterior
análisis.
# Aplicar la función al dataset
resultado_normalizacion <- normalizar_data(data_carga,
cat_col_mappings,
cat_cols,
date_cols,
numeric_cols,
nombre_cols,
target_col)## La cantidad de registros: 63886
## La cantidad de registros válidos: 63819
## Tiempo de ejecución: 00:00:01 segundosPreparacion Dataset
Se realiza un balanceo del dataset utilizando muestreo estratificado para asegurar una distribución equitativa de los tipos de vehículos. Esto es importante para evitar sesgos en el modelo de aprendizaje automático.
# Extraer el data frame normalizado
data <- resultado_normalizacion$data
# Filtrar los datos para incluir solo automóviles y camionetas
data <- data %>% dplyr::filter(tipo_vehiculo == "Automovil" | tipo_vehiculo == "Camioneta")
# Continuar con la preparación del dataset
data <- data %>%
dplyr::select(grupo_vehiculo, grupo_vehiculo_factor,
ano_vehiculo, tipo_de_pago, fecha_pago,
ano_pago, mes_pago, ano_mes_pago,
valor_neto, valor_ipc, valor_multa,
valor_pagado, forma_pago, forma_pago_factor,
tipo_vehiculo, tipo_vehiculo_factor,
marca, marca_factor)Outliers
Se aplica la función eliminar_outliers para eliminar
valores atípicos en la columna valor_pagado del
dataset.
resultado <- eliminar_outliers(data, "valor_pagado")
dataset_sin_outliers <- resultado$dataset_sin_outliers
cat("Número de registros originales:", nrow(data), "\n")## Número de registros originales: 54231cat("Número de registros sin outliers:", nrow(dataset_sin_outliers), "\n")## Número de registros sin outliers: 49079data<- dataset_sin_outliersBalanceo de datos
Se realiza un balanceo de datos para evitar el sobreajuste en el modelo.
set.seed(123)
tamano_muestra <- min(data %>% count(tipo_vehiculo) %>% pull(n))
# Muestreo estratificado para asegurar la misma cantidad de datos por categoría
data <- data %>%
dplyr::group_by(tipo_vehiculo) %>%
dplyr::sample_n(tamano_muestra) %>%
dplyr::ungroup()
# Visualización de la distribución del tipo de vehículo
grafico_torta(data, "tipo_vehiculo")
Variable Objetivo
Se usa la función grafico_boxplot para representar
gráficamente la distribución de valor_pagado, incluyendo la
mediana, los cuartiles, y los valores máximos y mínimos, permitiendo una
comprensión clara de la dispersión y centralización de los datos.
grafico_boxplot(data, "valor_pagado","Valor Pagado")
Funcion de Búsqueda de Hiperparametro
La función GridSearchCV_xgboost realiza una búsqueda de
hiperparámetros utilizando validación cruzada para el algoritmo XGBoost.
Calcula dinámicamente el número de folds, evalúa múltiples combinaciones
de hiperparámetros y retorna los mejores parámetros encontrados junto
con la duración del proceso. La función utiliza una estructura S3 para
manejar los resultados de manera flexible y estructurada.
GridSearchCV_xgboost <- function(parameters, scoring, data, target) {
# Marcar el inicio del tiempo de ejecución
hora_inicio <- Sys.time()
# Calcular el número de folds basado en el tamaño del dataset
n_folds <- min(10, max(2, nrow(data) %/% 100))
# Crear el grid de hiperparámetros
grid <- expand.grid(parameters)
results <- list()
# Preparar los datos para xgboost
dtrain <- xgb.DMatrix(data = as.matrix(data %>% select(-all_of(target))),
label = data[[target]])
# Realizar cross-validation para cada combinación de hiperparámetros
for (i in 1:nrow(grid)) {
params <- grid[i, ]
param_list <- as.list(params)
nrounds <- param_list$nrounds
param_list$nrounds <- NULL
cv <- xgb.cv(params = param_list,
data = dtrain,
nfold = n_folds,
nrounds = nrounds,
metrics = list(scoring),
verbose = FALSE,
early_stopping_rounds = 10,
maximize = ifelse(scoring == "rmse", FALSE, TRUE))
# Ajustar el nombre de la métrica para coincidir con la salida de xgb.cv
metric_name <- paste("test", scoring, "mean", sep = "_")
if (!is.null(cv$evaluation_log[[metric_name]])) {
best_score <- min(cv$evaluation_log[[metric_name]])
results[[i]] <- list(params = param_list, score = best_score)
} else {
warning(paste("Métrica no encontrada:", metric_name))
}
}
# Encontrar la mejor combinación de hiperparámetros
if (length(results) > 0) {
best_result <- results[[which.min(sapply(results, function(x) x$score))]]
} else {
stop("No se encontraron resultados válidos durante la validación cruzada.")
}
hora_fin <- Sys.time()
duracion <- difftime(hora_fin, hora_inicio, units = "secs")
duracion_formateada <- sprintf("%02d:%02d:%02d",
as.integer(duracion) %/% 3600,
(as.integer(duracion) %% 3600) %/% 60,
as.integer(duracion) %% 60)
# Crear la lista de resultados con clase S3
resultado <- list(best_result = best_result, duracion = duracion_formateada)
class(resultado) <- "grid_search_result"
return(resultado)
}
# Método para imprimir la clase S3
print.grid_search_result <- function(x) {
cat("Mejores hiperparámetros:\n")
print(x$best_result$params)
cat("\nPuntuación:\n")
print(x$best_result$score)
cat("\nDuración de la búsqueda de hiperparámetros:", x$duracion, "\n")
}Aplicación de la Función
Se define un grid de hiperparámetros para XGBoost y se preparan los
datos. Luego, se aplica la función GridSearchCV_xgboost
para encontrar los mejores hiperparámetros y se imprimen los resultados,
incluyendo los parámetros óptimos y la puntuación del modelo.
# Definir los hiperparámetros a tunear para xgboost
parameters <- list(
nrounds = c(50, 100),
max_depth = c(3, 6),
eta = c(0.1, 0.3),
gamma = c(0, 1),
colsample_bytree = c(0.5, 0.7),
min_child_weight = c(1, 3),
subsample = c(0.6, 0.8)
)
# Preparar los datos para xgboost
data_xgb <- data %>%
dplyr::mutate(dplyr::across(where(is.factor), as.numeric)) %>%
dplyr::select(-tipo_vehiculo, -fecha_pago)
# Aplicar la búsqueda de hiperparámetros con xgboost
best_model <- GridSearchCV_xgboost(
parameters = parameters,
scoring = "rmse",
data = data_xgb,
target = "valor_pagado"
)
# Mostrar los mejores hiperparámetros y la puntuación correspondiente
print(best_model)## Mejores hiperparámetros:
## $max_depth
## [1] 6
##
## $eta
## [1] 0.1
##
## $gamma
## [1] 0
##
## $colsample_bytree
## [1] 0.7
##
## $min_child_weight
## [1] 1
##
## $subsample
## [1] 0.8
##
## attr(,"out.attrs")
## attr(,"out.attrs")$dim
## nrounds max_depth eta gamma
## 2 2 2 2
## colsample_bytree min_child_weight subsample
## 2 2 2
##
## attr(,"out.attrs")$dimnames
## attr(,"out.attrs")$dimnames$nrounds
## [1] "nrounds= 50" "nrounds=100"
##
## attr(,"out.attrs")$dimnames$max_depth
## [1] "max_depth=3" "max_depth=6"
##
## attr(,"out.attrs")$dimnames$eta
## [1] "eta=0.1" "eta=0.3"
##
## attr(,"out.attrs")$dimnames$gamma
## [1] "gamma=0" "gamma=1"
##
## attr(,"out.attrs")$dimnames$colsample_bytree
## [1] "colsample_bytree=0.5" "colsample_bytree=0.7"
##
## attr(,"out.attrs")$dimnames$min_child_weight
## [1] "min_child_weight=1" "min_child_weight=3"
##
## attr(,"out.attrs")$dimnames$subsample
## [1] "subsample=0.6" "subsample=0.8"
##
##
##
## Puntuación:
## [1] 2603.711
##
## Duración de la búsqueda de hiperparámetros: 00:12:10Interpretacion del Resultado de la funcion
Mejores Hiperparámetros Determinados:
max_depth: El valor óptimo encontrado fue 6, indicando que cada árbol en el modelo tiene una profundidad máxima de 6 niveles. Este nivel de profundidad permite al modelo capturar suficiente complejidad en los datos sin sobreajustarse.
eta: La tasa de aprendizaje óptima fue 0.1. Este parámetro controla la magnitud de la actualización en cada ronda de boosting, y un valor de 0.1 sugiere que el modelo realiza actualizaciones más pequeñas, lo que generalmente conduce a una mejor generalización.
gamma: El valor de gamma fue 0, lo que significa que no se requiere una ganancia mínima para realizar una partición adicional en un nodo de un árbol. Esto permite una mayor flexibilidad en la construcción del árbol.
colsample_bytree: La proporción de columnas usadas por árbol fue 0.7, lo que implica que el 70% de las características se utilizan para construir cada árbol. Esto introduce diversidad en los árboles y mejora la generalización del modelo.
min_child_weight: Este parámetro se optimizó a 1, lo que significa que un nodo se dividirá solo si su suma de pesos es al menos 1. Este parámetro ayuda a controlar la complejidad del modelo y evitar el sobreajuste.
subsample: La proporción de muestra fue 0.8, lo que significa que el 80% de los datos de entrenamiento se utilizan para construir cada árbol. Esto introduce aleatoriedad y mejora la capacidad del modelo para generalizar.
Puntuación del Modelo (RMSE):
- El RMSE del modelo es 2603.711. Dado que la variable
valor_pagadotiene una mediana de 33,696 y una media de 66,357, un RMSE de 2603.711 indica un buen rendimiento del modelo. El RMSE representa aproximadamente el 7.7% de la mediana y el 3.9% de la media, lo que sugiere que el error de predicción es aceptable y que el modelo tiene una precisión razonable.
Testing de funcion usando testthat
Test de GridSearchCV
# Prueba de la función GridSearchCV
test_that("GridSearchCV_xgboost funciona correctamente", {
# Cargar datos de prueba
data_url <- "https://github.com/jkcrs1/R/raw/main/permiso_circulacion_calbuco.csv"
data_test <- data.table::fread(data_url, sep = ";", encoding = "Latin-1")
cat_col_mappings <- list(
tipo_vehiculo = c(
"AMBULANCIA" = "AMBULANCIA", "AUTOMOVIL" = "AUTOMOVIL",
"BUS" = "BUS", "Cabriolet" = "AUTOMOVIL", "CAMION" = "CAMION",
"CAMIONETA" = "CAMIONETA", "CARRO ARRASTRE A" = "REMOLQUE",
"CARRO BOMBA" = "CARRO BOMBA", "CASA RODANTE" = "CASA RODANTE",
"Comercial" = "COMERCIAL", "CUATRIMOTO" = "CUATRIMOTO",
"FURGON" = "FURGON", "GRUA" = "MAQUINA PESADA", "Hatchback" = "AUTOMOVIL",
"JEEP" = "AUTOMOVIL", "MAQUINA INDUSTRIAL" = "MAQUINA INDUSTRIAL",
"MINIBUS" = "MINIBUS", "MINIBUS ESCOLAR" = "MINIBUS",
"MINIBUS PARTICULAR" = "MINIBUS", "MINIBUS PRIVADO" = "MINIBUS",
"MINIBUS TURISMO" = "MINIBUS", "MOTO" = "MOTOCICLETA",
"MOTOCICLETA" = "MOTOCICLETA", "OTROS" = "OTROS", "REMOLQUE A" = "REMOLQUE",
"REMOLQUE B" = "REMOLQUE", "RETROEXCAVADORA" = "MAQUINA PESADA",
"Sedan" = "AUTOMOVIL", "SEMI REMOLQUE" = "REMOLQUE",
"STATION WAGON" = "AUTOMOVIL", "SUV" = "SUV", "TAXI EJECUTIVO" = "TAXI",
"TAXI BASICO" = "TAXI", "TAXI COLECTIVO" = "TAXI", "TRACTOCAMION" = "CAMION",
"TRACTOR" = "TRACTOR", "VAN" = "VAN"
),
tipo_combustible = c(
"Benc" = "Bencina", "Dies" = "Diesel", "NULL" = "NULL",
"DUAL" = "Hibrido", "Hibr" = "Hibrido", "Elec" = "Electrico"
),
transmision = c(
"Mec" = "Mecanica", "Aut" = "Automatica", "NULL" = "NULL",
"CVT" = "Automatica", "DCT" = "Automatica"
)
)
cat_cols <- c("tipo_vehiculo", "tipo_combustible", "transmision", "marca")
date_cols <- c("fecha_pago")
numeric_cols <- c("valor_neto", "valor_ipc", "valor_multa", "valor_pagado")
nombre_cols <- c("municipalidad", "grupo_vehiculo", "placa",
"digito", "codigo_sii", "forma_pago", "tipo_vehiculo",
"marca", "modelo", "color", "transmision",
"tipo_combustible", "equipamiento")
target_col <- "valor_pagado"
required_cols <- c("valor_pagado", "fecha_pago")
# Normalizar y transformar el dataset
data_test <- normalizar_data(data_test,
cat_col_mappings,
cat_cols,
date_cols,
numeric_cols,
nombre_cols,
target_col,
required_cols)
data_test <- data_test$data %>%
dplyr::mutate(dplyr::across(where(is.factor), as.numeric)) %>%
dplyr::select(-tipo_vehiculo, -fecha_pago)
parameters <- list(
nrounds = c(50, 100),
max_depth = c(3, 6),
eta = c(0.1, 0.3),
gamma = c(0, 1),
colsample_bytree = c(0.5, 0.7),
min_child_weight = c(1, 3),
subsample = c(0.6, 0.8)
)
# Capturar la salida de la función GridSearchCV_xgboost
result <- GridSearchCV_xgboost(parameters, "rmse", data_test, "valor_pagado")
salida <- capture.output({
print(result)
cat("Tiempo de ejecución:", result$duracion, "segundos\n")
})
# Verificar que las transformaciones se realizaron correctamente
expect_s3_class(result, "grid_search_result")
expect_true("params" %in% names(result$best_result))
expect_true("score" %in% names(result$best_result))
expect_match(paste(salida, collapse = "\n"), "Tiempo de ejecución:")
})## La cantidad de registros: 63886
## La cantidad de registros válidos: 56566
## Tiempo de ejecución: 00:00:01 segundos
## Test passed 😀Test de normalizar_data
Se realiza una prueba de la función normalizar_data
utilizando testthat. Se carga un conjunto de datos de
prueba y se aplica la función de normalización. La prueba verifica que
las transformaciones y los resultados se han realizado correctamente,
incluyendo la validación de las columnas y la duración del proceso.
test_that("normalizar_data funciona correctamente con datos reales", {
data_url <- "https://github.com/jkcrs1/R/raw/main/permiso_circulacion_calbuco.csv"
data_test <- data.table::fread(data_url, sep = ";", encoding = "Latin-1")
cat_col_mappings <- list(
tipo_vehiculo = c(
"AMBULANCIA" = "AMBULANCIA", "AUTOMOVIL" = "AUTOMOVIL", "BUS" = "BUS",
"Cabriolet" = "AUTOMOVIL", "CAMION" = "CAMION", "CAMIONETA" = "CAMIONETA",
"CARRO ARRASTRE A" = "REMOLQUE", "CARRO BOMBA" = "CARRO BOMBA",
"CASA RODANTE" = "CASA RODANTE", "Comercial" = "COMERCIAL", "CUATRIMOTO" = "CUATRIMOTO",
"FURGON" = "FURGON", "GRUA" = "MAQUINA PESADA", "Hatchback" = "AUTOMOVIL",
"JEEP" = "AUTOMOVIL", "MAQUINA INDUSTRIAL" = "MAQUINA INDUSTRIAL",
"MINIBUS" = "MINIBUS", "MINIBUS ESCOLAR" = "MINIBUS", "MINIBUS PARTICULAR" = "MINIBUS",
"MINIBUS PRIVADO" = "MINIBUS", "MINIBUS TURISMO" = "MINIBUS", "MOTO" = "MOTOCICLETA",
"MOTOCICLETA" = "MOTOCICLETA", "OTROS" = "OTROS", "REMOLQUE A" = "REMOLQUE",
"REMOLQUE B" = "REMOLQUE", "RETROEXCAVADORA" = "MAQUINA PESADA", "Sedan" = "AUTOMOVIL",
"SEMI REMOLQUE" = "REMOLQUE", "STATION WAGON" = "AUTOMOVIL", "SUV" = "SUV",
"TAXI EJECUTIVO" = "TAXI", "TAXI BASICO" = "TAXI", "TAXI COLECTIVO" = "TAXI",
"TRACTOCAMION" = "CAMION", "TRACTOR" = "TRACTOR", "VAN" = "VAN"
),
tipo_combustible = c(
"Benc" = "Bencina", "Dies" = "Diesel", "NULL" = "NULL",
"DUAL" = "Hibrido", "Hibr" = "Hibrido", "Elec" = "Electrico"
),
transmision = c(
"Mec" = "Mecanica", "Aut" = "Automatica", "NULL" = "NULL",
"CVT" = "Automatica", "DCT" = "Automatica"
)
)
cat_cols <- c("tipo_vehiculo", "tipo_combustible", "transmision", "marca")
date_cols <- c("fecha_pago")
numeric_cols <- c("valor_neto", "valor_ipc", "valor_multa", "valor_pagado")
title_cols <- c("municipalidad", "grupo_vehiculo", "placa", "digito", "codigo_sii", "forma_pago", "tipo_vehiculo", "marca", "modelo", "color", "transmision", "tipo_combustible", "equipamiento")
target_col <- "valor_pagado"
required_cols <- c("valor_pagado", "fecha_pago")
# Capturar la salida de la función normalizar_data
salida <- capture.output({
resultado <- normalizar_data(data_test,
cat_col_mappings,
cat_cols,
date_cols,
numeric_cols,
title_cols,
target_col,
required_cols)
})
data_normalizada <- resultado$data
# Verificar que las transformaciones se realizaron correctamente
for (col in cat_cols) {
expect_true(paste0(col, "_factor") %in% colnames(data_normalizada))
}
expect_true(all(!is.na(data_normalizada$valor_pagado)))
expect_true(all(!is.na(data_normalizada$fecha_pago)))
# Verificar que las columnas originales aún existen
for (col in cat_cols) {
expect_true(col %in% colnames(data_normalizada))
}
# Verificar que el tiempo de ejecución se muestra en la salida
expect_match(paste(salida, collapse = "\n"), "Tiempo de ejecución:")
})## Test passed 🎉Conclusión
En este proyecto, desarrollamos y validamos funciones en R para la normalización de datos y la búsqueda de hiperparámetros, enfocándonos en mejorar la eficiencia de los algoritmos de aprendizaje automático.
Función de Normalización: La función
normalizar_data transforma y limpia los conjuntos de datos,
recodificando variables categóricas, normalizando valores y eliminando
duplicados. La salida se estructuró como un objeto S3 para mayor
flexibilidad. La función se validó exitosamente con datos reales,
demostrando su robustez y precisión.
Búsqueda de Hiperparámetros: Implementamos
GridSearchCV_xgboost, que realiza la búsqueda de
hiperparámetros utilizando validación cruzada para XGBoost. La función
calcula dinámicamente los folds y devuelve los mejores hiperparámetros.
El diseño S3 de la función facilita su extensibilidad y manejo intuitivo
de resultados.
Pruebas y Validación: Utilizamos
testthat para validar las funciones, asegurando que las
transformaciones y resultados de la búsqueda de hiperparámetros fueran
correctos. Las pruebas incluyeron medidas de tiempo de ejecución,
proporcionando información sobre la eficiencia de las funciones.
Este trabajo establece una base sólida para futuros proyectos en data science, demostrando buenas prácticas en la estructuración y documentación de proyectos en R, y ofrece herramientas robustas para la normalización de datos y optimización de modelos.