Carga de datos
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(caret)
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(randomForest)
## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## margin
library(ggplot2)
library(readxl)
library(VIM)
## Loading required package: colorspace
## Loading required package: grid
## VIM is ready to use.
##
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
##
## Attaching package: 'VIM'
##
## The following object is masked from 'package:datasets':
##
## sleep
library(missForest)
##
## Attaching package: 'missForest'
##
## The following object is masked from 'package:VIM':
##
## nrmse
library(e1071)
# Cargar datos
library(readxl)
dataset_logistica <- read_excel("Downloads/dataset_logistica.xlsx")
print(dataset_logistica)
## # A tibble: 30,000 × 31
## peso_kg volumen_m3 tipo_producto fragilidad refrigerado distancia_km
## <dbl> <dbl> <chr> <chr> <chr> <dbl>
## 1 14.7 0.185 Ropa Media No 777.
## 2 39.5 1.56 Medicinas Media No 2885.
## 3 20.7 0.570 Ropa Media Sí 3040.
## 4 44.2 1.10 Electrónica Baja Sí 3568.
## 5 47.1 0.397 Medicinas Alta No 4824.
## 6 2.76 0.685 Muebles Media No 2695.
## 7 26.6 1.67 Electrónica Media No 4424.
## 8 44.7 0.701 Muebles Baja Sí 1813.
## 9 27.8 1.47 Muebles Baja No 2447.
## 10 23.1 0.350 Electrónica Baja No 2204.
## # ℹ 29,990 more rows
## # ℹ 25 more variables: zona_destino <chr>, pais_destino <chr>,
## # transportista <chr>, tipo_transporte <chr>, capacidad_carga_kg <dbl>,
## # experiencia_conductor <dbl>, numero_reexpediciones <dbl>,
## # tiempo_aduana_horas <dbl>, tiempo_procesamiento_horas <dbl>,
## # tiempo_almacenamiento_horas <dbl>, ruta_optima <chr>, temporada <chr>,
## # clima <chr>, temperatura_exterior <dbl>, volumen_envios_diarios <dbl>, …
Análisis Exploratorio de Datos
summary(dataset_logistica)
## peso_kg volumen_m3 tipo_producto fragilidad
## Min. : 0.5012 Min. :0.01016 Length:30000 Length:30000
## 1st Qu.:12.8412 1st Qu.:0.50472 Class :character Class :character
## Median :24.9988 Median :0.99672 Mode :character Mode :character
## Mean :25.1582 Mean :1.00149
## 3rd Qu.:37.6170 3rd Qu.:1.49726
## Max. :49.9971 Max. :1.99998
## refrigerado distancia_km zona_destino pais_destino
## Length:30000 Min. : 5.017 Length:30000 Length:30000
## Class :character 1st Qu.:1234.339 Class :character Class :character
## Mode :character Median :2479.251 Mode :character Mode :character
## Mean :2483.756
## 3rd Qu.:3722.885
## Max. :5000.000
## transportista tipo_transporte capacidad_carga_kg experiencia_conductor
## Length:30000 Length:30000 Min. : 500.2 Min. : 1.0
## Class :character Class :character 1st Qu.: 5390.9 1st Qu.: 8.0
## Mode :character Mode :character Median :10246.0 Median :15.5
## Mean :10241.3 Mean :15.5
## 3rd Qu.:15106.4 3rd Qu.:23.0
## Max. :19999.9 Max. :30.0
## numero_reexpediciones tiempo_aduana_horas tiempo_procesamiento_horas
## Min. :0.000 Min. : 0.00228 Min. : 1.000
## 1st Qu.:1.000 1st Qu.:11.85423 1st Qu.: 6.752
## Median :2.000 Median :23.83309 Median :12.421
## Mean :1.503 Mean :23.82795 Mean :12.456
## 3rd Qu.:3.000 3rd Qu.:35.79505 3rd Qu.:18.167
## Max. :3.000 Max. :47.99778 Max. :24.000
## tiempo_almacenamiento_horas ruta_optima temporada
## Min. : 0.00349 Length:30000 Length:30000
## 1st Qu.:17.82581 Class :character Class :character
## Median :35.89173 Mode :character Mode :character
## Mean :35.87662
## 3rd Qu.:53.83834
## Max. :71.99784
## clima temperatura_exterior volumen_envios_diarios
## Length:30000 Min. :-10.000 Min. : 100.1
## Class :character 1st Qu.: 2.454 1st Qu.: 2588.2
## Mode :character Median : 15.056 Median : 5061.1
## Mean : 15.028 Mean : 5067.5
## 3rd Qu.: 27.398 3rd Qu.: 7546.5
## Max. : 40.000 Max. : 9999.9
## congestion_transito costo_envio seguro_envio tipo_cliente
## Min. : 0.0042 Min. : 5.017 Length:30000 Length:30000
## 1st Qu.:25.0910 1st Qu.:126.888 Class :character Class :character
## Median :50.1110 Median :251.036 Mode :character Mode :character
## Mean :50.0673 Mean :251.376
## 3rd Qu.:75.0307 3rd Qu.:375.376
## Max. :99.9875 Max. :500.000
## devoluciones_previas nivel_satisfaccion_cliente numero_puntos_intermedios
## Min. :0.000 Min. :1.000 Min. :0.000
## 1st Qu.:1.000 1st Qu.:3.258 1st Qu.:1.000
## Median :3.000 Median :5.538 Median :3.000
## Mean :2.501 Mean :5.520 Mean :2.501
## 3rd Qu.:4.000 3rd Qu.:7.762 3rd Qu.:4.000
## Max. :5.000 Max. :9.999 Max. :5.000
## vehiculo_utilizado tiempo_entrega_horas categoria_entrega
## Length:30000 Min. :-22.36 Length:30000
## Class :character 1st Qu.: 55.77 Class :character
## Mode :character Median :105.83 Mode :character
## Mean :105.40
## 3rd Qu.:154.85
## Max. :232.19
ggplot(dataset_logistica, aes(x = categoria_entrega, fill = categoria_entrega)) + geom_bar() + theme_minimal()
ggplot(dataset_logistica, aes(x = tiempo_entrega_horas, fill = tiempo_entrega_horas)) + geom_histogram() + theme_minimal()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
# Calcular el porcentaje de filas con al menos un NA
porcentaje_filas_na <- sum(apply(dataset_logistica, 1, function(x) any(is.na(x)))) / nrow(dataset_logistica) * 100
# Mostrar el resultado
print(paste("Porcentaje de filas con valores NA:", round(porcentaje_filas_na, 2), "%"))
## [1] "Porcentaje de filas con valores NA: 4.31 %"
# Contar la cantidad de NAs en cada columna
na_por_columna <- colSums(is.na(dataset_logistica))
# Mostrar los resultados
print(na_por_columna)
## peso_kg volumen_m3
## 0 0
## tipo_producto fragilidad
## 0 0
## refrigerado distancia_km
## 0 0
## zona_destino pais_destino
## 0 0
## transportista tipo_transporte
## 0 0
## capacidad_carga_kg experiencia_conductor
## 0 0
## numero_reexpediciones tiempo_aduana_horas
## 0 0
## tiempo_procesamiento_horas tiempo_almacenamiento_horas
## 0 0
## ruta_optima temporada
## 0 0
## clima temperatura_exterior
## 0 0
## volumen_envios_diarios congestion_transito
## 0 0
## costo_envio seguro_envio
## 0 0
## tipo_cliente devoluciones_previas
## 0 0
## nivel_satisfaccion_cliente numero_puntos_intermedios
## 0 0
## vehiculo_utilizado tiempo_entrega_horas
## 0 0
## categoria_entrega
## 1294
# Eliminar filas con al menos un NA
dataset_sin_na <- na.omit(dataset_logistica)
# Verificar cuántas filas quedaron
print(paste("Filas originales:", nrow(dataset_logistica)))
## [1] "Filas originales: 30000"
print(paste("Filas después de eliminar NA:", nrow(dataset_sin_na)))
## [1] "Filas después de eliminar NA: 28706"
## Modelo de Regresión: Predicción de tiempo de entrega
set.seed(123)
trainIndex <- createDataPartition(dataset_sin_na$tiempo_entrega_horas, p = 0.8, list = FALSE)
trainData <- dataset_sin_na[trainIndex,]
testData <- dataset_sin_na[-trainIndex,]
# Modelos
lm_model <- lm(log(tiempo_entrega_horas) ~ ., data = trainData)
## Warning in log(tiempo_entrega_horas): NaNs produced
sum(is.na(trainData))
## [1] 0
trainData <- na.omit(trainData)
lm_pred <- predict(lm_model, testData)
lm_rmse <- sqrt(mean((lm_pred - testData$tiempo_entrega_horas)^2))
lm_rmse
## [1] 116.7289
#Split the data into training and test sets
set.seed(123) # Para reproducibilidad
data_split <- sample(1:nrow(dataset_sin_na), size = 0.7 * nrow(dataset_sin_na))
train_data <- dataset_sin_na[data_split, ]
test_data <- dataset_sin_na[-data_split, ]
# Crear el modelo Random Forest
rf_model_1 <- randomForest(tiempo_entrega_horas ~ ., data = train_data, ntree = 100)
# Realizar predicciones en el conjunto de prueba
predictions <- predict(rf_model_1, newdata = test_data)
rf_rsme <- sqrt(mean((predictions - test_data$tiempo_entrega_horas)^2))
print(rf_rsme)
## [1] 58.65953
## Modelo de Clasificación: Categoría de Entrega
# Split the data into training and test sets
set.seed(123) # Para reproducibilidad
data_split <- sample(1:nrow(dataset_sin_na), size = 0.7 * nrow(dataset_sin_na))
train_data <- dataset_sin_na[data_split, ]
test_data <- dataset_sin_na[-data_split, ]
train_data$categoria_entrega <- as.factor(train_data$categoria_entrega)
# Crear el modelo Random Forest
rf_model <- randomForest(categoria_entrega ~ ., data = train_data, ntree = 100)
# Realizar predicciones en el conjunto de prueba
predictions <- predict(rf_model, newdata = test_data)
# Evaluar el modelo
confusion_matrix <- table(test_data$categoria_entrega, predictions)
print(confusion_matrix)
## predictions
## Normal Rápida Retrasada
## Normal 1 0 2147
## Rápida 1 0 693
## Retrasada 5 0 5765
# Calcular la precisión
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Precisión del modelo:", round(accuracy * 100, 2), "%"))
## [1] "Precisión del modelo: 66.95 %"
# Dividir los datos en entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
indice <- sample(1:nrow(dataset_sin_na), 0.8 * nrow(dataset_sin_na))
train <- dataset_sin_na[indice, ]
test <- dataset_sin_na[-indice, ]
train$categoria_entrega <- as.factor(train$categoria_entrega)
test$categoria_entrega <- as.factor(test$categoria_entrega)
modelo_svc <- svm(categoria_entrega ~ ., data = train, kernel = "radial", cost = 1, gamma = 0.1)
predicciones <- predict(modelo_svc, test)
# Matriz de confusión
confusion_matrix <- table(Predicho = predicciones, Real = test$categoria_entrega)
print(confusion_matrix)
## Real
## Predicho Normal Rápida Retrasada
## Normal 0 0 0
## Rápida 0 0 0
## Retrasada 1399 476 3867
# Exactitud del modelo
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
cat("Exactitud:", accuracy, "\n")
## Exactitud: 0.6734587
## Recomendaciones
"Basado en los modelos desarrollados, se pueden optimizar las rutas y tiempos de procesamiento para mejorar la entrega.
Los modelos desarrollados de clasificación y regresión dieron resultados mejor que el azar, sin embargo no dieron resultados optimos. Podemos sospechar que esto es debido a una variedad de factores, entre ellos que son muchas variables prediciendo y no todas son importantes. La otra razón grande e importante especialmente en el modelo de clasificación es que las 3 clases no estas balanceadas, es decir, una clase es mucho más garnde que las otras dos. He investigado y creo qu etecnicas como PCA pueden ayudar a reducir las variables y tecnicas como SMOTE pueden ayudar a balancear las clases, pero requiere una complejidad más a la vista en clase "
## [1] "Basado en los modelos desarrollados, se pueden optimizar las rutas y tiempos de procesamiento para mejorar la entrega. \n\nLos modelos desarrollados de clasificación y regresión dieron resultados mejor que el azar, sin embargo no dieron resultados optimos. Podemos sospechar que esto es debido a una variedad de factores, entre ellos que son muchas variables prediciendo y no todas son importantes. La otra razón grande e importante especialmente en el modelo de clasificación es que las 3 clases no estas balanceadas, es decir, una clase es mucho más garnde que las otras dos. He investigado y creo qu etecnicas como PCA pueden ayudar a reducir las variables y tecnicas como SMOTE pueden ayudar a balancear las clases, pero requiere una complejidad más a la vista en clase "