Predicción

PREDICCIÓN PRECIOS PORTÁTILES

Cargamos la BBDD e imputamos los valores faltantes con mice.

library(mice)

## 
## Adjuntando el paquete: 'mice'

## The following object is masked from 'package:stats':
## 
##     filter

## The following objects are masked from 'package:base':
## 
##     cbind, rbind

library(randomForest)

## Warning: package 'randomForest' was built under R version 4.4.3

## randomForest 4.7-1.2

## Type rfNews() to see new features/changes/bug fixes.

library(caret)

## Warning: package 'caret' was built under R version 4.4.3

## Cargando paquete requerido: ggplot2

## Warning: package 'ggplot2' was built under R version 4.4.3

## 
## Adjuntando el paquete: 'ggplot2'

## The following object is masked from 'package:randomForest':
## 
##     margin

## Cargando paquete requerido: lattice

library(dplyr)

## 
## Adjuntando el paquete: 'dplyr'

## The following object is masked from 'package:randomForest':
## 
##     combine

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2)

port2 = read.csv("C:/Users/Ana/Downloads/2ºGCD/2ºcuatri/PROYECTO II/PROYECTO/BBDDport2.csv", sep = ",")
head(port2)

##                                  Nombre Marca         SO RAM DiscoDuroGB
## 1   Acer Aspire Go 15 Portátil AG15-42P  ACER Windows 11   8         512
## 2                          Acer A315-59  ACER    FreeDOS  16         512
## 3        Acer Aspire 5 Portátil A515-57  ACER Windows 11  16        1024
## 4        Acer Aspire 3 Portátil A317-54  ACER Windows 11   8         512
## 5                 Acer Aspire 3 A315-59  ACER     Sin SO  16        1024
## 6 Acer Nitro 16 Portátil gaming AN16-73  ACER Windows 11  16        1024
##   ProcesadorCPU NúcleosCPU VelocidadMaxProcesador                     GPU
## 1   AMD Ryzen 5          6                    4,3     AMD Radeon Graphics
## 2 Intel Core i7         10                    4,7            Intel Iris X
## 3 Intel Core i5          8                      2      Intel UHD Graphics
## 4 Intel Core i5         10                    1,3            Intel Iris X
## 5 Intel Core i5         10                    4,4      Intel UHD Graphics
## 6 Intel Core i7         16                    2,2 NVIDIA GeForce RTX 4050
##   NúcleosGPU Pantalla Peso Tactil           Web Precio RankingMarca
## 1         NA     15.6 1.78      0          Acer    599          346
## 2         NA     15.6  1.7      0    Mediamarkt    627          346
## 3         NA     15.6 1.76      0          Acer    899          346
## 4         NA     17.3 2.23      0          Acer    799          346
## 5         NA     15.6 1.82      0 PcComponentes    602          346
## 6         NA       16 2.45      0          Acer   1499          346
##   OTRAS.CARACTERÍSTICAS.Q.CONSIDERÉIS gpu_dedicada
## 1                                                0
## 2                                                0
## 3                                                0
## 4                                                0
## 5                                                0
## 6                                                1

# Realizamos la imputación 
port2 = mice(port2, m = 1)

## 
##  iter imp variable
##   1   1  NúcleosCPU  NúcleosGPU  Tactil  Precio  RankingMarca
##   2   1  NúcleosCPU  NúcleosGPU  Tactil  Precio  RankingMarca
##   3   1  NúcleosCPU  NúcleosGPU  Tactil  Precio  RankingMarca
##   4   1  NúcleosCPU  NúcleosGPU  Tactil  Precio  RankingMarca
##   5   1  NúcleosCPU  NúcleosGPU  Tactil  Precio  RankingMarca

## Warning: Number of logged events: 16

# Recuperamos los datos imputados
port2 = mice::complete(port2)
port2 %>%
  summarise(across(everything(), list(
    Total_NA = ~sum(is.na(.)),
    Porcentaje_NA = ~round(mean(is.na(.)) * 100,2)
)))

##   Nombre_Total_NA Nombre_Porcentaje_NA Marca_Total_NA Marca_Porcentaje_NA
## 1               0                    0              0                   0
##   SO_Total_NA SO_Porcentaje_NA RAM_Total_NA RAM_Porcentaje_NA
## 1           0                0            0                 0
##   DiscoDuroGB_Total_NA DiscoDuroGB_Porcentaje_NA ProcesadorCPU_Total_NA
## 1                    0                         0                      0
##   ProcesadorCPU_Porcentaje_NA NúcleosCPU_Total_NA NúcleosCPU_Porcentaje_NA
## 1                           0                   0                        0
##   VelocidadMaxProcesador_Total_NA VelocidadMaxProcesador_Porcentaje_NA
## 1                               0                                    0
##   GPU_Total_NA GPU_Porcentaje_NA NúcleosGPU_Total_NA NúcleosGPU_Porcentaje_NA
## 1            0                 0                   0                        0
##   Pantalla_Total_NA Pantalla_Porcentaje_NA Peso_Total_NA Peso_Porcentaje_NA
## 1                 0                      0             0                  0
##   Tactil_Total_NA Tactil_Porcentaje_NA Web_Total_NA Web_Porcentaje_NA
## 1               0                    0            0                 0
##   Precio_Total_NA Precio_Porcentaje_NA RankingMarca_Total_NA
## 1               0                    0                     0
##   RankingMarca_Porcentaje_NA OTRAS.CARACTERÍSTICAS.Q.CONSIDERÉIS_Total_NA
## 1                          0                                            0
##   OTRAS.CARACTERÍSTICAS.Q.CONSIDERÉIS_Porcentaje_NA gpu_dedicada_Total_NA
## 1                                                 0                     0
##   gpu_dedicada_Porcentaje_NA
## 1                          0

cat(sprintf("La media del precio de los portátiles es: %.4f\n", mean(port2$Precio)))

## La media del precio de los portátiles es: 1870.3944

Se crea el modelo:

# Eliminamos columnas que no nos interesan
port2 <- port2[, !names(port2) %in% c("Nombre","OTRAS.CARACTERÍSTICAS.Q.CONSIDERÉIS", "NúcleosGPU")]

# Cogemos los portátiles de precios mayores a 4700 euros para evitar outliers
port2_filtrado <- port2[port2$Precio <= 4700, ]


# Convertimos las variables categóricas a factor
categoricas <- c("Marca", "ProcesadorCPU", "GPU")
port2_filtrado[categoricas] <- lapply(port2_filtrado[categoricas], as.factor)

# Dividimos la base de datos para coger datos de entrenamiento y de prueba

set.seed(123)
indices <- createDataPartition(port2_filtrado$Precio, p = 0.9, list = FALSE)
train_data <- port2_filtrado[indices, ]
test_data <- port2_filtrado[-indices, ]

# Entrenamos el modelo inicial, usamos randomforest porque es robusto y nos permite manejar muchas variables

modelo_inicial <- randomForest(
  Precio ~ .,
  data = train_data,
  ntree = 1000,
  mtry = 2,
  importance = TRUE)

# Cogemos las variables que son más importantes (las que tienen %IncMSE > 20)
importancias <- importance(modelo_inicial)
variables_utiles <- rownames(importancias[importancias[, "%IncMSE"] > 20, ])

# Volvemos a coger los datos pero con las variables seleccionadas
train_data_reducido <- train_data[, c("Precio", variables_utiles)]
test_data_reducido  <- test_data[, c("Precio", variables_utiles)]

# Volvemos a entrenar un modelo con los datos reducidos (las variables más importantes)

modelo_reducido <- randomForest(
  Precio ~ .,
  data = train_data_reducido,
  ntree = 1000,
  mtry = 2,
  importance = TRUE)

# Evaluamos el modelo con los datos de entrenamiento

pred_train <- predict(modelo_reducido, newdata = train_data_reducido)
obs_train <- train_data_reducido$Precio

r2_train <- cor(obs_train, pred_train)^2
rmse_train <- sqrt(mean((obs_train - pred_train)^2))
mae_train <- mean(abs(obs_train - pred_train))
mape_train <- mean(abs((obs_train - pred_train) / obs_train)) * 100

cat("Evaluación del modelo sobre el conjunto de ENTRENAMIENTO:\n")

## Evaluación del modelo sobre el conjunto de ENTRENAMIENTO:

cat(sprintf("R²: %.4f\n", r2_train))

## R²: 0.9627

cat(sprintf("RMSE: %.2f €\n", rmse_train))

## RMSE: 204.32 €

cat(sprintf("MAE: %.2f €\n", mae_train))

## MAE: 147.21 €

cat(sprintf("MAPE: %.2f %%\n", mape_train))

## MAPE: 11.74 %

# Evaluamos el modelo con los datos de prueba 

pred_test <- predict(modelo_reducido, newdata = test_data_reducido)
obs_test <- test_data_reducido$Precio

r2_test <- cor(obs_test, pred_test)^2
rmse_test <- sqrt(mean((obs_test - pred_test)^2))
mae_test <- mean(abs(obs_test - pred_test))
mape_test <- mean(abs((obs_test - pred_test) / obs_test)) * 100
sse <- sum((obs_test - pred_test)^2)
sst <- sum((obs_test - mean(obs_test))^2)
q2 <- 1 - (sse / sst)

cat("\nEvaluación del modelo sobre el conjunto de PRUEBA:\n")

## 
## Evaluación del modelo sobre el conjunto de PRUEBA:

cat(sprintf("R²: %.4f\n", r2_test))

## R²: 0.8862

cat(sprintf("Q²: %.4f\n", q2))

## Q²: 0.8667

cat(sprintf("RMSE: %.2f €\n", rmse_test))

## RMSE: 322.72 €

cat(sprintf("MAE: %.2f €\n", mae_test))

## MAE: 230.07 €

cat(sprintf("MAPE: %.2f %%\n", mape_test))

## MAPE: 15.83 %

# Hacemos el gráfico del modelo final


df_eval <- data.frame(
  Observado = obs_test,
  Predicho = pred_test
)

ggplot(df_eval, aes(x = Observado, y = Predicho)) +
  geom_point(color = "blue", alpha = 0.6) +
  geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
  labs(title = "Predicción vs Precio Real",
       x = "Precio Real (€)",
       y = "Precio Predicho (€)") +
  theme_minimal()

# Hacemos predicciones sobre el conjunto de entrenamiento
predicciones_train <- predict(modelo_reducido, newdata = train_data)

# Evaluamos el modelo con el conjunto de entrenamiento
observados_train <- train_data$Precio
predichos_train <- predicciones_train

# Calculamos los estadísticos en el conjunto de entrenamiento
r2_train <- cor(observados_train, predichos_train)^2
rmse_train <- sqrt(mean((observados_train - predichos_train)^2))
mae_train <- mean(abs(observados_train - predichos_train))
mape_train <- mean(abs((observados_train - predichos_train) / observados_train)) * 100

cat("Evaluación del modelo sobre el conjunto de entrenamiento:\n")

## Evaluación del modelo sobre el conjunto de entrenamiento:

cat(sprintf("R²: %.4f\n", r2_train))

## R²: 0.9627

cat(sprintf("RMSE: %.2f €\n", rmse_train))

## RMSE: 204.32 €

cat(sprintf("MAE: %.2f €\n", mae_train))

## MAE: 147.21 €

cat(sprintf("MAPE: %.2f %%\n", mape_train))

## MAPE: 11.74 %

# Gráfico de Precio Real vs Precio Predicho para el conjunto de entrenamiento
df_eval_train <- data.frame(
  Observado = observados_train,
  Predicho = predichos_train
)

ggplot(df_eval_train, aes(x = Observado, y = Predicho)) +
  geom_point(color = "blue", alpha = 0.6) +
  geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
  labs(title = "Predicción vs Precio Real (Conjunto de Entrenamiento)",
       x = "Precio Real (€)",
       y = "Precio Predicho (€)") +
  theme_minimal()

# Gráfico de Precio Real vs Precio Predicho para los dos conjuntos
df_eval_comparacion <- data.frame(
  Observado = c(observados_train, obs_test),
  Predicho = c(predichos_train, pred_test),
  Conjunto = rep(c("Entrenamiento", "Prueba"), c(length(predichos_train), length(pred_test)))
)

ggplot(df_eval_comparacion, aes(x = Observado, y = Predicho, color = Conjunto)) +
  geom_point(alpha = 0.6) +
  geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
  labs(title = "Comparación de Predicción vs Precio Real",
       x = "Precio Real (€)",
       y = "Precio Predicho (€)") +
  theme_minimal()

Se comparan los valores sacados con el conjunto de entrenamiento y los sacados con los datos de prueba.

# Métricas de los dos conjuntos para comparar
resultados_completos <- data.frame(
  Conjunto = c("Entrenamiento", "Prueba"),
  R2 = c(r2_train, r2_test),
  RMSE = c(rmse_train, rmse_test),
  MAE = c(mae_train, mae_test),
  MAPE = c(mape_train, mape_test)
)

print(resultados_completos)

##        Conjunto        R2     RMSE      MAE     MAPE
## 1 Entrenamiento 0.9626954 204.3220 147.2144 11.73590
## 2        Prueba 0.8862272 322.7222 230.0693 15.83024

A continuación se realizaron métricas para comprobar la utilidad de las variables del modelo, además lo podemos observar en los gráficos, donde vemos que las variables con más importancia en el modelo son ProcesorCPU, GPU y DiscoDuroGB.

# Observamos el porcentaje para elegir las variables más útiles y lo vemos también en 2 gráficos
importance(modelo_reducido)

##                         %IncMSE IncNodePurity
## Marca                  33.17108      46760632
## RAM                    29.52142      47670995
## DiscoDuroGB            36.80516      13390043
## ProcesadorCPU          39.98278      71849777
## NúcleosCPU             31.73724      21165821
## VelocidadMaxProcesador 23.17026       8824007
## GPU                    32.71970      57886475

varImpPlot(modelo_reducido)

También se han realizado gráficos de resiudos para observar como varian los errores en los precios.

# Gráfico de residuos
residuos <- obs_test - pred_test
ggplot(data.frame(Residuos = residuos), aes(x = Residuos)) +
  geom_histogram(binwidth = 20, fill = "skyblue", color = "black", alpha = 0.7) +
  labs(title = "Histograma de Residuales", x = "Residuos (Error de Predicción)", y = "Frecuencia") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

# Gráfico de error absoluto
error_absoluto <- abs(residuos)

ggplot(data.frame(Error_Absoluto = error_absoluto), aes(x = Error_Absoluto)) +
  geom_histogram(binwidth = 50, fill = "orange", color = "black", alpha = 0.7) +
  labs(title = "Histograma de Error Absoluto", x = "Error Absoluto (€)", y = "Frecuencia") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

• La mayoría de los errores están entre 0 € y 300 €, lo que indica que el modelo es bastante preciso en la mayoría de casos.

• Hay unos pocos errores grandes (alrededor de 700–800 €) que se consideran outliers o predicciones poco precisas.

• Tiene una forma sesgada hacia la derecha, lo que es típico en modelos donde la mayoría de predicciones son buenas, pero hay algunos errores grandes ocasionales.

# Gráfico de distribución de precios reales vs predichos
ggplot() +
  geom_density(aes(x = obs_test, fill = "Observado"), alpha = 0.5) +
  geom_density(aes(x = pred_test, fill = "Predicho"), alpha = 0.5) +
  scale_fill_manual(values = c("Observado" = "blue", "Predicho" = "red")) +
  labs(title = "Distribución de los Precios Reales vs Predichos",
       x = "Precio (€)",
       y = "Densidad",
       fill = "Tipo") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Finalmente se ha realizado un pequeño programa.

# Mostramos opciones de Marca
cat("Opciones de Marca:\n")

## Opciones de Marca:

print(levels(train_data_reducido$Marca))

##  [1] "ACER"      "Apple"     "ASUS"      "DELL"      "HP"        "HUAWEI"   
##  [7] "LENOVO"    "MICROSOFT" "MSI"       "Razer"     "SAMSUNG"

marca_input <- readline(prompt = "Introduce la Marca: ")

## Introduce la Marca:

# Validamos la marca
#if (!(marca_input %in% levels(train_data_reducido$Marca))) {
#  stop("⚠️ Marca no válida. Ejecuta de nuevo el script y elige una de las opciones #mostradas.")
#}

# Filtramos solo los registros con esa Marca
subset_marca <- train_data_reducido[train_data_reducido$Marca == marca_input, ]

# Obtenemos opciones de procesador y GPU válidas para esa marca
opciones_cpu <- unique(subset_marca$ProcesadorCPU)
opciones_gpu <- unique(subset_marca$GPU)

cat("Opciones de ProcesadorCPU para esa marca:\n")

## Opciones de ProcesadorCPU para esa marca:

print(opciones_cpu)

## factor()
## 22 Levels: AMD Ryzen 5 AMD Ryzen 7 AMD Ryzen 9 ... Qualcomm Snapdragon X Plus

cpu_input <- readline(prompt = "Introduce el ProcesadorCPU: ")

## Introduce el ProcesadorCPU:

#if (!(cpu_input %in% opciones_cpu)) {
#  stop("⚠️ Procesador no válido para esa marca.")
#}

ram_input <- as.numeric(readline(prompt = "Introduce la cantidad de RAM (GB): "))

## Introduce la cantidad de RAM (GB):

disco_input <- as.numeric(readline(prompt = "Introduce la capacidad del Disco Duro (GB): "))

## Introduce la capacidad del Disco Duro (GB):

nucleos_input <- as.numeric(readline(prompt = "Introduce el número de Núcleos CPU: "))

## Introduce el número de Núcleos CPU:

velocidad_input <- as.numeric(readline(prompt = "Introduce la velocidad máxima del procesador (GHz): "))

## Introduce la velocidad máxima del procesador (GHz):

cat("Opciones de GPU para esa marca:\n")

## Opciones de GPU para esa marca:

print(opciones_gpu)

## factor()
## 20 Levels:  Adreno Onboard Graphics ... Radeon Onboard Graphics

gpu_input <- readline(prompt = "Introduce la GPU: ")

## Introduce la GPU:

#if (!(gpu_input %in% opciones_gpu)) {
#  stop("⚠️ GPU no válida para esa marca.")
#}

# Nuevo portátil
nuevo_portatil <- data.frame(
  Marca = factor(marca_input, levels = levels(train_data_reducido$Marca)),
  ProcesadorCPU = factor(cpu_input, levels = levels(train_data_reducido$ProcesadorCPU)),
  RAM = ram_input,
  DiscoDuroGB = disco_input,
  NúcleosCPU = nucleos_input,
  VelocidadMaxProcesador = velocidad_input,
  GPU = factor(gpu_input, levels = levels(train_data_reducido$GPU))
)

# Predicción
pred_precio <- predict(modelo_reducido, newdata = nuevo_portatil)

# Hacemos el intervalo con MAE / 3
limite_inferior <- round(pred_precio - (mae_test)/3)
limite_superior <- round(pred_precio + (mae_test)/3)

# Mostramos el resultado
cat(sprintf("\n📏 Intervalo probable basado en MAE (± %.2f €): %.2f € – %.2f €\n",
            round(mae_test/3), limite_inferior, limite_superior))

## 
## 📏 Intervalo probable basado en MAE (± 77.00 €): NA € – NA €