Proyecto Final Estadística No Paramétrica
Wilson David Florez Rodriguez
2025-06-01
El siguiente documento revisa el database de “Datos Kuiper” con el cual realizaremos un modelo con LOESS y otro con RANDOM FOREST.
1. Activación de librerías:
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
suppressMessages(suppressPackageStartupMessages({
library(readxl)
library(dplyr)
library(ggplot2)
library(plotly)
library(gganimate)
library(nortest)
library(randomForest)
library(caret)
library(skimr)
library(corrplot)
library(viridis)
}))## Warning: package 'gganimate' was built under R version 4.4.3## Warning: package 'randomForest' was built under R version 4.4.3## Warning: package 'caret' was built under R version 4.4.3## Warning: package 'skimr' was built under R version 4.4.32.Carga de datos:
file.choose()## [1] "C:\\Users\\SFDav\\OneDrive\\Documentos\\Proyectos RStudio\\ProyectoFinalEstNoPara\\Proyecto-Final-Estadistica-No-Paramétrica.html"kuiper <- "C:\\Users\\SFDav\\Downloads\\kuiper.xls"
data <- read_excel(kuiper)3. Explicando si es aplicable un modelo paramétrico:
Para determinar si un modelo paramétrico es adecuado, evaluamos la normalidad de la variable dependiente Price
- Hipótesis nula (H₀): Los datos de Price siguen una distribución normal.
- Hipótesis alternativa (H₁): Los datos no siguen una distribución normal.
shapiro_test <- shapiro.test(data$Price)
cat("Prueba de Shapiro-Wilk:\n")## Prueba de Shapiro-Wilk:cat("Estadístico:", shapiro_test$statistic, "\n")## Estadístico: 0.8615023cat("p-valor:", shapiro_test$p.value, "\n\n")## p-valor: 5.197618e-26Viendo que en el test el p-value es menor a 0,05 podemos concluir que los datos de la columna price no siguen una distribución normal. Rechazamos la hipótesis nula.
4. Análisis descriptivo de los datos:
summary(data)## Price Mileage Make Model
## Min. : 8639 Min. : 266 Length:804 Length:804
## 1st Qu.:14273 1st Qu.:14624 Class :character Class :character
## Median :18025 Median :20914 Mode :character Mode :character
## Mean :21343 Mean :19832
## 3rd Qu.:26717 3rd Qu.:25213
## Max. :70755 Max. :50387
## Trim Type Cylinder Liter
## Length:804 Length:804 Min. :4.000 Min. :1.600
## Class :character Class :character 1st Qu.:4.000 1st Qu.:2.200
## Mode :character Mode :character Median :6.000 Median :2.800
## Mean :5.269 Mean :3.037
## 3rd Qu.:6.000 3rd Qu.:3.800
## Max. :8.000 Max. :6.000
## Doors Cruise Sound Leather
## Min. :2.000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:4.000 1st Qu.:1.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :4.000 Median :1.0000 Median :1.0000 Median :1.0000
## Mean :3.527 Mean :0.7525 Mean :0.6791 Mean :0.7239
## 3rd Qu.:4.000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :4.000 Max. :1.0000 Max. :1.0000 Max. :1.0000# Boxplot interactivo de Price por Type
p2 <- plot_ly(data, x = ~Type, y = ~Price, type = "box", color = ~Type, colors = "viridis") %>%
layout(title = "Boxplot de Price por Tipo de Auto",
xaxis = list(title = "Tipo de Auto"),
yaxis = list(title = "Precio (USD)"))
p2# Gráfico de barras para Make
p3_static <- ggplot(data, aes(x = Make, fill = Make)) +
geom_bar() +
scale_fill_viridis_d() +
theme_minimal(base_size = 12) +
labs(title = "Distribución de Marcas", x = "Marca", y = "Frecuencia") +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"))
p3 <- plotly::ggplotly(p3_static) %>%
layout(title = list(text = "Distribución de Marcas", x = 0.5))
p3# Matriz de correlación para variables numéricas
num_vars <- data %>% select(Price, Mileage, Cylinder, Liter, Doors)
corr <- cor(num_vars)
corrplot(corr, method = "color", type = "upper", col = viridis::viridis(100),
tl.col = "black", tl.srt = 45, addCoef.col = "black")
5. Modelo LOESS con una variable explicativa (Mileage)
loess1 <- loess(Price ~ Mileage, data = data, span = 0.75)
# Predicciones
newdata1 <- data.frame(Mileage = seq(min(data$Mileage), max(data$Mileage), length.out = 100))
pred_loess1 <- predict(loess1, newdata1, se = TRUE)
# Gráfico 2D interactivo
p4 <- plot_ly(data, x = ~Mileage, y = ~Price, type = "scatter", mode = "markers",
marker = list(color = "#1f77b4", opacity = 0.5)) %>%
add_lines(x = newdata1$Mileage, y = pred_loess1$fit, line = list(color = "#ff7f0e")) %>%
layout(title = "LOESS: Price vs Mileage", xaxis = list(title = "Mileage"),
yaxis = list(title = "Price (USD)"))
p4# Pronóstico
pred_point <- data.frame(Mileage = 30000)
pred_loess1_point <- predict(loess1, pred_point)
cat("Pronóstico LOESS (Mileage = 30,000):", round(pred_loess1_point, 2), "USD\n")## Pronóstico LOESS (Mileage = 30,000): 19786.85 USD6. Modelo LOESS con múltiples variables (Mileage, Cylinder, Leather)
loess2 <- loess(Price ~ Mileage + Cylinder + Leather, data = data, span = 0.75)
# Gráfico 3D interactivo
pred_grid <- expand.grid(Mileage = seq(min(data$Mileage), max(data$Mileage), length.out = 20),
Cylinder = mean(data$Cylinder),
Leather = 1)
pred_loess2 <- predict(loess2, pred_grid)
p5 <- plot_ly(data, x = ~Mileage, y = ~Cylinder, z = ~Price, type = "scatter3d", mode = "markers",
marker = list(size = 3, color = "#1f77b4")) %>%
add_trace(x = pred_grid$Mileage, y = pred_grid$Cylinder, z = pred_loess2,
type = "scatter3d", mode = "lines", line = list(color = "#ff7f0e")) %>%
layout(title = "LOESS 3D: Price vs Mileage, Cylinder, Leather",
scene = list(xaxis = list(title = "Mileage"),
yaxis = list(title = "Cylinder"),
zaxis = list(title = "Price (USD)")))
p5# Pronóstico
pred_point2 <- data.frame(Mileage = 30000, Cylinder = 4, Leather = 1)
pred_loess2_point <- predict(loess2, pred_point2)
cat("Pronóstico LOESS (Mileage = 30,000, Cylinder = 4, Leather = 1):",
round(pred_loess2_point, 2), "USD\n")## Pronóstico LOESS (Mileage = 30,000, Cylinder = 4, Leather = 1): 16338.21 USD7. Modelo RANDOM FOREST con una variable explicativa (Mileage)
set.seed(123)
rf1 <- randomForest(Price ~ Mileage, data = data, ntree = 100)
# Predicciones
pred_rf1 <- predict(rf1, newdata1)
# Gráfico interactivo
p6 <- plot_ly(data, x = ~Mileage, y = ~Price, type = "scatter", mode = "markers",
marker = list(color = "#1f77b4", opacity = 0.5)) %>%
add_lines(x = newdata1$Mileage, y = pred_rf1, line = list(color = "#d62728")) %>%
layout(title = "Random Forest: Price vs Mileage", xaxis = list(title = "Mileage"),
yaxis = list(title = "Price (USD)"))
p6# Pronóstico
pred_rf1_point <- predict(rf1, pred_point)
cat("Pronóstico RF (Mileage = 30,000):", round(pred_rf1_point, 2), "USD\n")## Pronóstico RF (Mileage = 30,000): 11937.89 USD8. Modelo RANDOM FOREST con múltiples variables (Mileage, Cylinder, Leather)
set.seed(123)
rf2 <- randomForest(Price ~ Mileage + Cylinder + Leather, data = data, ntree = 100)
# Gráfico 3D
pred_rf2 <- predict(rf2, pred_grid)
p7 <- plot_ly(data, x = ~Mileage, y = ~Cylinder, z = ~Price, type = "scatter3d", mode = "markers",
marker = list(size = 3, color = "#1f77b4")) %>%
add_trace(x = pred_grid$Mileage, y = pred_grid$Cylinder, z = pred_rf2,
type = "scatter3d", mode = "lines", line = list(color = "#d62728")) %>%
layout(title = "Random Forest 3D: Price vs Mileage, Cylinder, Leather",
scene = list(xaxis = list(title = "Mileage"),
yaxis = list(title = "Cylinder"),
zaxis = list(title = "Price (USD)")))
p7# Pronóstico
pred_rf2_point <- predict(rf2, pred_point2)
cat("Pronóstico RF (Mileage = 30,000, Cylinder = 4, Leather = 1):",
round(pred_rf2_point, 2), "USD\n")## Pronóstico RF (Mileage = 30,000, Cylinder = 4, Leather = 1): 18318.22 USD9. Comparación de pronosticos:
Comparamos los pronósticos de ambos modelos para el punto de predicción (Mileage = 30,000, Cylinder = 4, Leather = 1).
# Tabla de resultados
results <- data.frame(
Model = c("LOESS (1 var)", "LOESS (multi-var)", "Random Forest (1 var)", "Random Forest (multi-var)"),
Prediction = c(pred_loess1_point, pred_loess2_point, pred_rf1_point, pred_rf2_point)
)
# Gráfico de barras comparativo
p8 <- plot_ly(results, x = ~Model, y = ~Prediction, type = "bar", marker = list(color = viridis::viridis(4))) %>%
layout(title = "Comparación de Pronósticos",
xaxis = list(title = "Modelo"),
yaxis = list(title = "Predicción (USD)"))
p8# Resumen
print(results)## Model Prediction
## 1 LOESS (1 var) 19786.85
## 2 LOESS (multi-var) 16338.21
## 3 Random Forest (1 var) 11937.89
## 4 Random Forest (multi-var) 18318.2210. Conclusión:
En la modelación, LOESS demostró una capacidad excepcional para capturar tendencias no lineales locales, especialmente en configuraciones con múltiples variables, ofreciendo visualizaciones suaves y precisas en gráficos 3D interactivos. Por otro lado, Random Forest sobresalió por su robustez ante interacciones complejas y multicolinealidad, proporcionando predicciones más estables y precisas, particularmente en el modelo multivariable (Mileage, Cylinder, Leather). Los pronósticos para el punto de prueba (Mileage = 30,000, Cylinder = 4, Leather = 1) muestran que Random Forest tiende a superar a LOESS en precisión, reflejada en valores predichos más consistentes con las tendencias observadas en los datos.
La comparación de los modelos evidencia que Random Forest es la elección óptima para este conjunto de datos, gracias a su capacidad para manejar relaciones no lineales y efectos de interacción sin requerir transformaciones previas, mientras que LOESS es ideal para exploraciones visuales y tendencias locales. Para aplicaciones prácticas, recomendamos evaluar el error de predicción (como RMSE) en un conjunto de validación para confirmar la superioridad de Random Forest y optimizar la selección de variables. Este análisis no solo proporciona una herramienta poderosa para predecir precios de autos, sino que también establece un marco sólido para la toma de decisiones basada en datos en contextos similares, con visualizaciones dinámicas que potencian la interpretación y comunicación de resultados en entornos profesionales.