Predicción del precio de viviendas residenciales mediante análisis multivariante y técnicas de regularización
Pedro Jesús Lorente Molina
2025-12-15
1 0. Librerías, funciones y configuración inicial
En esta sección cargamos las librerías necesarias, fijamos la semilla de aleatoriedad para garantizar la reproducibilidad y definimos las funciones de evaluación (RMSE y MAE) que utilizaremos más adelante.
# install.packages("tidyverse")
# install.packages("glmnet")
library(tidyverse) # Manipulación de datos y gráficos
library(glmnet) # Modelos Lasso / Ridge
set.seed(123) # Semilla para reproducibilidad
# Funciones de métricas con comprobación de longitudes
rmse <- function(y, y_hat) {
if (length(y) != length(y_hat)) {
stop("RMSE: 'y' (", length(y),
") y 'y_hat' (", length(y_hat),
") tienen longitudes distintas.")
}
sqrt(mean((y - y_hat)^2))
}
mae <- function(y, y_hat) {
if (length(y) != length(y_hat)) {
stop("MAE: 'y' y 'y_hat' tienen longitudes distintas.")
}
mean(abs(y - y_hat))
}2 1. Carga de datos y exploración inicial
En primer lugar cargamos el fichero train.csv,
exploramos la dimensión del dataset, la estructura de las variables y la
distribución de la variable respuesta SalePrice.
# Se asume que "train.csv" está en el directorio de trabajo
house <- read.csv("train.csv", stringsAsFactors = FALSE)
# Dimensión del dataset: nº de observaciones y variables
dim(house)## [1] 1460 81## 'data.frame': 1460 obs. of 81 variables:
## $ Id : int 1 2 3 4 5 6 7 8 9 10 ...
## $ MSSubClass : int 60 20 60 70 60 50 20 60 50 190 ...
## $ MSZoning : chr "RL" "RL" "RL" "RL" ...
## $ LotFrontage : int 65 80 68 60 84 85 75 NA 51 50 ...
## $ LotArea : int 8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
## $ Street : chr "Pave" "Pave" "Pave" "Pave" ...
## $ Alley : chr NA NA NA NA ...
## $ LotShape : chr "Reg" "Reg" "IR1" "IR1" ...
## $ LandContour : chr "Lvl" "Lvl" "Lvl" "Lvl" ...
## $ Utilities : chr "AllPub" "AllPub" "AllPub" "AllPub" ...
## $ LotConfig : chr "Inside" "FR2" "Inside" "Corner" ...
## $ LandSlope : chr "Gtl" "Gtl" "Gtl" "Gtl" ...
## $ Neighborhood : chr "CollgCr" "Veenker" "CollgCr" "Crawfor" ...
## $ Condition1 : chr "Norm" "Feedr" "Norm" "Norm" ...
## $ Condition2 : chr "Norm" "Norm" "Norm" "Norm" ...
## $ BldgType : chr "1Fam" "1Fam" "1Fam" "1Fam" ...
## $ HouseStyle : chr "2Story" "1Story" "2Story" "2Story" ...
## $ OverallQual : int 7 6 7 7 8 5 8 7 7 5 ...
## $ OverallCond : int 5 8 5 5 5 5 5 6 5 6 ...
## $ YearBuilt : int 2003 1976 2001 1915 2000 1993 2004 1973 1931 1939 ...
## $ YearRemodAdd : int 2003 1976 2002 1970 2000 1995 2005 1973 1950 1950 ...
## $ RoofStyle : chr "Gable" "Gable" "Gable" "Gable" ...
## $ RoofMatl : chr "CompShg" "CompShg" "CompShg" "CompShg" ...
## $ Exterior1st : chr "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
## $ Exterior2nd : chr "VinylSd" "MetalSd" "VinylSd" "Wd Shng" ...
## $ MasVnrType : chr "BrkFace" "None" "BrkFace" "None" ...
## $ MasVnrArea : int 196 0 162 0 350 0 186 240 0 0 ...
## $ ExterQual : chr "Gd" "TA" "Gd" "TA" ...
## $ ExterCond : chr "TA" "TA" "TA" "TA" ...
## $ Foundation : chr "PConc" "CBlock" "PConc" "BrkTil" ...
## $ BsmtQual : chr "Gd" "Gd" "Gd" "TA" ...
## $ BsmtCond : chr "TA" "TA" "TA" "Gd" ...
## $ BsmtExposure : chr "No" "Gd" "Mn" "No" ...
## $ BsmtFinType1 : chr "GLQ" "ALQ" "GLQ" "ALQ" ...
## $ BsmtFinSF1 : int 706 978 486 216 655 732 1369 859 0 851 ...
## $ BsmtFinType2 : chr "Unf" "Unf" "Unf" "Unf" ...
## $ BsmtFinSF2 : int 0 0 0 0 0 0 0 32 0 0 ...
## $ BsmtUnfSF : int 150 284 434 540 490 64 317 216 952 140 ...
## $ TotalBsmtSF : int 856 1262 920 756 1145 796 1686 1107 952 991 ...
## $ Heating : chr "GasA" "GasA" "GasA" "GasA" ...
## $ HeatingQC : chr "Ex" "Ex" "Ex" "Gd" ...
## $ CentralAir : chr "Y" "Y" "Y" "Y" ...
## $ Electrical : chr "SBrkr" "SBrkr" "SBrkr" "SBrkr" ...
## $ X1stFlrSF : int 856 1262 920 961 1145 796 1694 1107 1022 1077 ...
## $ X2ndFlrSF : int 854 0 866 756 1053 566 0 983 752 0 ...
## $ LowQualFinSF : int 0 0 0 0 0 0 0 0 0 0 ...
## $ GrLivArea : int 1710 1262 1786 1717 2198 1362 1694 2090 1774 1077 ...
## $ BsmtFullBath : int 1 0 1 1 1 1 1 1 0 1 ...
## $ BsmtHalfBath : int 0 1 0 0 0 0 0 0 0 0 ...
## $ FullBath : int 2 2 2 1 2 1 2 2 2 1 ...
## $ HalfBath : int 1 0 1 0 1 1 0 1 0 0 ...
## $ BedroomAbvGr : int 3 3 3 3 4 1 3 3 2 2 ...
## $ KitchenAbvGr : int 1 1 1 1 1 1 1 1 2 2 ...
## $ KitchenQual : chr "Gd" "TA" "Gd" "Gd" ...
## $ TotRmsAbvGrd : int 8 6 6 7 9 5 7 7 8 5 ...
## $ Functional : chr "Typ" "Typ" "Typ" "Typ" ...
## $ Fireplaces : int 0 1 1 1 1 0 1 2 2 2 ...
## $ FireplaceQu : chr NA "TA" "TA" "Gd" ...
## $ GarageType : chr "Attchd" "Attchd" "Attchd" "Detchd" ...
## $ GarageYrBlt : int 2003 1976 2001 1998 2000 1993 2004 1973 1931 1939 ...
## $ GarageFinish : chr "RFn" "RFn" "RFn" "Unf" ...
## $ GarageCars : int 2 2 2 3 3 2 2 2 2 1 ...
## $ GarageArea : int 548 460 608 642 836 480 636 484 468 205 ...
## $ GarageQual : chr "TA" "TA" "TA" "TA" ...
## $ GarageCond : chr "TA" "TA" "TA" "TA" ...
## $ PavedDrive : chr "Y" "Y" "Y" "Y" ...
## $ WoodDeckSF : int 0 298 0 0 192 40 255 235 90 0 ...
## $ OpenPorchSF : int 61 0 42 35 84 30 57 204 0 4 ...
## $ EnclosedPorch: int 0 0 0 272 0 0 0 228 205 0 ...
## $ X3SsnPorch : int 0 0 0 0 0 320 0 0 0 0 ...
## $ ScreenPorch : int 0 0 0 0 0 0 0 0 0 0 ...
## $ PoolArea : int 0 0 0 0 0 0 0 0 0 0 ...
## $ PoolQC : chr NA NA NA NA ...
## $ Fence : chr NA NA NA NA ...
## $ MiscFeature : chr NA NA NA NA ...
## $ MiscVal : int 0 0 0 0 0 700 0 350 0 0 ...
## $ MoSold : int 2 5 9 2 12 10 8 11 4 1 ...
## $ YrSold : int 2008 2007 2008 2006 2008 2009 2007 2009 2008 2008 ...
## $ SaleType : chr "WD" "WD" "WD" "WD" ...
## $ SaleCondition: chr "Normal" "Normal" "Normal" "Abnorml" ...
## $ SalePrice : int 208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 34900 129975 163000 180921 214000 755000## Análisis exploratorio
# 1) Histograma de SalePrice para ver su asimetría
ggplot(house, aes(x = SalePrice)) +
geom_histogram(bins = 30) +
labs(title = "Distribución de SalePrice")
# 2) Diagrama de dispersión: SalePrice vs GrLivArea (superficie habitable)
ggplot(house, aes(x = GrLivArea, y = SalePrice)) +
geom_point(alpha = 0.4) +
labs(
title = "Relación entre superficie habitable (GrLivArea) y precio de venta",
x = "GrLivArea (superficie habitable sobre rasante)",
y = "SalePrice"
)
# 3) Boxplot: SalePrice por calidad global de la vivienda (OverallQual)
ggplot(house, aes(x = factor(OverallQual), y = SalePrice)) +
geom_boxplot() +
labs(
title = "SalePrice según la calidad global de la vivienda (OverallQual)",
x = "OverallQual (calidad global, factor)",
y = "SalePrice"
)
# 4) Mapa de calor de correlaciones con SalePrice para las variables numéricas más relevantes
num_vars <- house %>% dplyr::select(where(is.numeric))
cor_mat <- cor(num_vars, use = "pairwise.complete.obs")
# Correlaciones absolutas con SalePrice
cor_sp <- sort(abs(cor_mat[, "SalePrice"]), decreasing = TRUE)
# Nos quedamos con las 10 variables numéricas más asociadas (incluyendo SalePrice)
top_vars <- names(cor_sp)[1:10]
cor_top <- cor_mat[top_vars, top_vars]
# Transformamos a formato largo para ggplot
cor_df <- as.data.frame(as.table(cor_top))
names(cor_df) <- c("Var1", "Var2", "Cor")
ggplot(cor_df, aes(x = Var1, y = Var2, fill = Cor)) +
geom_tile() +
scale_fill_gradient2(
low = "darkred",
mid = "white",
high = "darkblue",
midpoint = 0
) +
labs(
title = "Mapa de calor de correlaciones\n(variables numéricas más asociadas a SalePrice)",
x = "",
y = ""
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
En conjunto, el histograma confirma que SalePrice es una
variable continua claramente asimétrica a la derecha, con una cola de
precios altos. Los gráficos exploratorios muestran una relación
creciente entre precio y superficie (GrLivArea), así como
incrementos casi monotónicos de SalePrice al aumentar la
calidad global (OverallQual). El mapa de calor de
correlaciones indica que las variables de tamaño y calidad son las más
asociadas al precio y que presentan una multicolinealidad apreciable, lo
que motiva el uso posterior de PCA y regularización en los modelos.
3 2. Partición en entrenamiento, validación y test (60/20/20)
Siguiendo las recomendaciones metodológicas, realizamos la partición antes de cualquier preprocesamiento, para evitar fuga de información (data leakage).
n_total <- nrow(house)
idx_all <- 1:n_total
# Train: 60% de las observaciones
idx_train <- sample(idx_all, size = round(0.6 * n_total))
# El 40% restante se divide en 20% valid y 20% test
idx_rest <- setdiff(idx_all, idx_train)
idx_valid <- sample(idx_rest, size = round(0.5 * length(idx_rest)))
idx_test <- setdiff(idx_rest, idx_valid)
# Construimos los tres conjuntos
train <- house[idx_train, ]
valid <- house[idx_valid, ]
test <- house[idx_test, ]
# Comprobación de tamaños
sapply(list(train = train, valid = valid, test = test), nrow)## train valid test
## 876 292 2924 3. Preprocesamiento sin fuga de información
En esta sección tratamos los valores perdidos, distinguiendo entre NA “estructurales” (que representan ausencia de característica) y NA “reales” (datos faltantes). Todas las decisiones se basan exclusivamente en el conjunto de entrenamiento.
# Trabajamos con copias preprocesadas
train_pp <- train
valid_pp <- valid
test_pp <- test
## 3.1. NA “estructurales”: ausencia de la característica
# Ejemplos: no hay sótano, no hay garaje, no hay piscina, etc.
na_as_none_vars <- c(
"Alley",
"BsmtQual", "BsmtCond", "BsmtExposure", "BsmtFinType1", "BsmtFinType2",
"FireplaceQu",
"GarageType", "GarageFinish", "GarageQual", "GarageCond",
"PoolQC",
"Fence",
"MiscFeature",
"MasVnrType" # NA ~ no hay revestimiento de mampostería
)
replace_na_with_none <- function(df, vars) {
for (v in vars) {
if (v %in% names(df)) {
df[[v]][is.na(df[[v]])] <- "None"
}
}
df
}
train_pp <- replace_na_with_none(train_pp, na_as_none_vars)
valid_pp <- replace_na_with_none(valid_pp, na_as_none_vars)
test_pp <- replace_na_with_none(test_pp, na_as_none_vars)
## 3.2. NA categóricos “reales”: imputación por moda (Electrical)
mode_from_train <- function(x) {
x_no_na <- x[!is.na(x)]
tab <- table(x_no_na)
names(tab)[which.max(tab)]
}
if ("Electrical" %in% names(train_pp)) {
moda_electrical <- mode_from_train(train_pp$Electrical)
train_pp$Electrical[is.na(train_pp$Electrical)] <- moda_electrical
valid_pp$Electrical[is.na(valid_pp$Electrical)] <- moda_electrical
test_pp$Electrical[is.na(test_pp$Electrical)] <- moda_electrical
}
## 3.3. NA numéricos: imputación por mediana de train
numeric_na_vars <- c("LotFrontage", "MasVnrArea", "GarageYrBlt")
num_medians <- sapply(train_pp[numeric_na_vars], function(x) median(x, na.rm = TRUE))
for (v in numeric_na_vars) {
if (v %in% names(train_pp)) {
train_pp[[v]][is.na(train_pp[[v]])] <- num_medians[v]
valid_pp[[v]][is.na(valid_pp[[v]])] <- num_medians[v]
test_pp[[v]][is.na(test_pp[[v]])] <- num_medians[v]
}
}
# Comprobamos que no quedan NA “reales” en train_pp
colSums(is.na(train_pp))## Id MSSubClass MSZoning LotFrontage LotArea
## 0 0 0 0 0
## Street Alley LotShape LandContour Utilities
## 0 0 0 0 0
## LotConfig LandSlope Neighborhood Condition1 Condition2
## 0 0 0 0 0
## BldgType HouseStyle OverallQual OverallCond YearBuilt
## 0 0 0 0 0
## YearRemodAdd RoofStyle RoofMatl Exterior1st Exterior2nd
## 0 0 0 0 0
## MasVnrType MasVnrArea ExterQual ExterCond Foundation
## 0 0 0 0 0
## BsmtQual BsmtCond BsmtExposure BsmtFinType1 BsmtFinSF1
## 0 0 0 0 0
## BsmtFinType2 BsmtFinSF2 BsmtUnfSF TotalBsmtSF Heating
## 0 0 0 0 0
## HeatingQC CentralAir Electrical X1stFlrSF X2ndFlrSF
## 0 0 0 0 0
## LowQualFinSF GrLivArea BsmtFullBath BsmtHalfBath FullBath
## 0 0 0 0 0
## HalfBath BedroomAbvGr KitchenAbvGr KitchenQual TotRmsAbvGrd
## 0 0 0 0 0
## Functional Fireplaces FireplaceQu GarageType GarageYrBlt
## 0 0 0 0 0
## GarageFinish GarageCars GarageArea GarageQual GarageCond
## 0 0 0 0 0
## PavedDrive WoodDeckSF OpenPorchSF EnclosedPorch X3SsnPorch
## 0 0 0 0 0
## ScreenPorch PoolArea PoolQC Fence MiscFeature
## 0 0 0 0 0
## MiscVal MoSold YrSold SaleType SaleCondition
## 0 0 0 0 0
## SalePrice
## 0En este punto hemos tratado los NA, sin eliminar observaciones y respetando el significado de “ausencia” en variables estructurales.
5 4. Matriz de diseño y eliminación de varianza cero para PCA
A continuación construimos una matriz de diseño con variables numéricas y dummies para las categóricas. Para evitar pérdidas de filas en valid/test, unificamos primero los tres conjuntos, codificamos, y luego separamos de nuevo. Después, eliminamos predictores con varianza nula en train antes de aplicar PCA.
# Añadimos columna que indica el origen (train/valid/test)
train_pp$dataset <- "train"
valid_pp$dataset <- "valid"
test_pp$dataset <- "test"
# Unimos todo
all_pp <- bind_rows(train_pp, valid_pp, test_pp)
# Convertimos todas las variables character en factor
all_pp <- all_pp %>%
mutate(across(where(is.character), as.factor))
# Construimos la matriz de diseño excluyendo Id y dataset
make_x_matrix_all <- function(df) {
mm <- model.matrix(SalePrice ~ . - Id - dataset, data = df)
mm[, -1, drop = FALSE] # eliminamos el intercepto
}
X_all <- make_x_matrix_all(all_pp)
# Separamos de nuevo en X_train, X_valid, X_test
idx_train_all <- which(all_pp$dataset == "train")
idx_valid_all <- which(all_pp$dataset == "valid")
idx_test_all <- which(all_pp$dataset == "test")
X_train <- X_all[idx_train_all, , drop = FALSE]
X_valid <- X_all[idx_valid_all, , drop = FALSE]
X_test <- X_all[idx_test_all, , drop = FALSE]
# Vectores de respuesta (SalePrice)
y_train <- train_pp$SalePrice
y_valid <- valid_pp$SalePrice
y_test <- test_pp$SalePrice
# Comprobación de coherencia
dim(X_train)## [1] 876 259## [1] 292 259## [1] 292 259## [1] 876## [1] 292## [1] 292## 4.bis. Eliminación de columnas con varianza cero para PCA
var_train <- apply(X_train, 2, var)
zero_var_cols <- names(var_train[var_train == 0])
length(zero_var_cols) # nº de predictores constantes en train## [1] 5cols_pca <- setdiff(colnames(X_train), zero_var_cols)
X_train_pca <- X_train[, cols_pca, drop = FALSE]
X_valid_pca <- X_valid[, cols_pca, drop = FALSE]
X_test_pca <- X_test[, cols_pca, drop = FALSE]
dim(X_train_pca)## [1] 876 254## [1] 292 254## [1] 292 2546 5. PCA y regresión lineal múltiple (PCR)
Aplicamos PCA sobre los predictores estandarizados de train, proyectamos valid y test sobre las mismas componentes, y seleccionamos el número óptimo de componentes usando el conjunto de validación.
# Estandarización para PCA usando SOLO train_pca
X_train_scaled <- scale(X_train_pca)
center_vec <- attr(X_train_scaled, "scaled:center")
scale_vec <- attr(X_train_scaled, "scaled:scale")
X_valid_scaled <- scale(X_valid_pca, center = center_vec, scale = scale_vec)
X_test_scaled <- scale(X_test_pca, center = center_vec, scale = scale_vec)
# PCA sobre X_train ya estandarizado
pca_obj <- prcomp(X_train_scaled, center = FALSE, scale. = FALSE)
# Varianza explicada acumulada (opcional)
var_explained <- pca_obj$sdev^2 / sum(pca_obj$sdev^2)
cumvar <- cumsum(var_explained)
plot(cumvar, type = "b",
xlab = "Número de componentes",
ylab = "Varianza explicada acumulada",
main = "PCA: varianza explicada acumulada")
# Scores (componentes principales)
Z_train <- pca_obj$x
colnames(Z_train) <- paste0("PC", 1:ncol(Z_train))
Z_valid <- as.matrix(X_valid_scaled) %*% pca_obj$rotation
colnames(Z_valid) <- paste0("PC", 1:ncol(Z_valid))
Z_test <- as.matrix(X_test_scaled) %*% pca_obj$rotation
colnames(Z_test) <- paste0("PC", 1:ncol(Z_test))
# Selección de K mediante RMSE en validación
Ks <- seq(10, 100, by = 10)
Ks <- Ks[Ks <= ncol(Z_train)]
results_pcr <- data.frame(
K = Ks,
RMSE_train = NA_real_,
RMSE_valid = NA_real_
)
for (i in seq_along(Ks)) {
k <- Ks[i]
Ztr_k <- Z_train[, 1:k, drop = FALSE]
Zv_k <- Z_valid[, 1:k, drop = FALSE]
# Regresión lineal sobre las K primeras PCs
df_tr_k <- data.frame(SalePrice = y_train, Ztr_k)
fit_k <- lm(SalePrice ~ ., data = df_tr_k)
pred_train_k <- predict(fit_k, newdata = df_tr_k)
df_val_k <- data.frame(Zv_k)
pred_valid_k <- predict(fit_k, newdata = df_val_k)
results_pcr$RMSE_train[i] <- rmse(y_train, pred_train_k)
results_pcr$RMSE_valid[i] <- rmse(y_valid, pred_valid_k)
}
results_pcr# Elegimos el K que minimiza el RMSE en validation
K_opt <- results_pcr$K[which.min(results_pcr$RMSE_valid)]
K_opt## [1] 20# Ajuste final PCR con K_opt componentes
Ztr_opt <- Z_train[, 1:K_opt, drop = FALSE]
Zva_opt <- Z_valid[, 1:K_opt, drop = FALSE]
Zte_opt <- Z_test[, 1:K_opt, drop = FALSE]
df_tr_opt <- data.frame(SalePrice = y_train, Ztr_opt)
fit_pcr <- lm(SalePrice ~ ., data = df_tr_opt)
pred_train_pcr <- predict(fit_pcr, newdata = df_tr_opt)
pred_valid_pcr <- predict(fit_pcr, newdata = data.frame(Zva_opt))
pred_test_pcr <- predict(fit_pcr, newdata = data.frame(Zte_opt))7 6. Lasso y Ridge en variables originales
A continuación ajustamos modelos Lasso y Ridge usando todos los
predictores originales (con dummies). La selección del parámetro de
regularización lambda se realiza mediante validación
cruzada en el conjunto de entrenamiento.
## 6.1. Lasso (alpha = 1)
lasso_cv <- cv.glmnet(
x = X_train,
y = y_train,
alpha = 1, # Lasso (penalización L1)
nfolds = 10,
standardize = TRUE
)
lambda_lasso <- lasso_cv$lambda.min
lambda_lasso## [1] 878.0316pred_train_lasso <- as.numeric(predict(lasso_cv, s = lambda_lasso, newx = X_train))
pred_valid_lasso <- as.numeric(predict(lasso_cv, s = lambda_lasso, newx = X_valid))
pred_test_lasso <- as.numeric(predict(lasso_cv, s = lambda_lasso, newx = X_test))
## 6.2. Ridge (alpha = 0)
ridge_cv <- cv.glmnet(
x = X_train,
y = y_train,
alpha = 0, # Ridge (penalización L2)
nfolds = 10,
standardize = TRUE
)
lambda_ridge <- ridge_cv$lambda.min
lambda_ridge## [1] 37134.098 7. Lasso y Ridge sobre componentes principales
Finalmente combinamos PCA con regularización, ajustando Lasso y Ridge
sobre las K_opt primeras componentes principales.
Ztr_k <- Ztr_opt
Zva_k <- Zva_opt
Zte_k <- Zte_opt
## 7.1. Lasso sobre PCA
lasso_pca_cv <- cv.glmnet(
x = Ztr_k,
y = y_train,
alpha = 1,
nfolds = 10,
standardize = TRUE
)
lambda_lasso_pca <- lasso_pca_cv$lambda.min
pred_train_lasso_pca <- as.numeric(predict(lasso_pca_cv, s = lambda_lasso_pca, newx = Ztr_k))
pred_valid_lasso_pca <- as.numeric(predict(lasso_pca_cv, s = lambda_lasso_pca, newx = Zva_k))
pred_test_lasso_pca <- as.numeric(predict(lasso_pca_cv, s = lambda_lasso_pca, newx = Zte_k))
## 7.2. Ridge sobre PCA
ridge_pca_cv <- cv.glmnet(
x = Ztr_k,
y = y_train,
alpha = 0,
nfolds = 10,
standardize = TRUE
)
lambda_ridge_pca <- ridge_pca_cv$lambda.min
pred_train_ridge_pca <- as.numeric(predict(ridge_pca_cv, s = lambda_ridge_pca, newx = Ztr_k))
pred_valid_ridge_pca <- as.numeric(predict(ridge_pca_cv, s = lambda_ridge_pca, newx = Zva_k))
pred_test_ridge_pca <- as.numeric(predict(ridge_pca_cv, s = lambda_ridge_pca, newx = Zte_k))9 8. Comparación de modelos mediante RMSE y MAE
Para comparar rigurosamente los modelos construimos una tabla resumen con RMSE y MAE en los tres conjuntos: entrenamiento, validación y test.
metrics <- data.frame(
Model = character(),
Dataset = character(),
RMSE = numeric(),
MAE = numeric(),
stringsAsFactors = FALSE
)
metrics <- rbind(
metrics,
data.frame(
Model = "PCR (PCA + LM)",
Dataset = c("Train", "Valid", "Test"),
RMSE = c(rmse(y_train, pred_train_pcr),
rmse(y_valid, pred_valid_pcr),
rmse(y_test, pred_test_pcr)),
MAE = c(mae(y_train, pred_train_pcr),
mae(y_valid, pred_valid_pcr),
mae(y_test, pred_test_pcr))
),
data.frame(
Model = "Lasso (glmnet)",
Dataset = c("Train", "Valid", "Test"),
RMSE = c(rmse(y_train, pred_train_lasso),
rmse(y_valid, pred_valid_lasso),
rmse(y_test, pred_test_lasso)),
MAE = c(mae(y_train, pred_train_lasso),
mae(y_valid, pred_valid_lasso),
mae(y_test, pred_test_lasso))
),
data.frame(
Model = "Ridge (glmnet)",
Dataset = c("Train", "Valid", "Test"),
RMSE = c(rmse(y_train, pred_train_ridge),
rmse(y_valid, pred_valid_ridge),
rmse(y_test, pred_test_ridge)),
MAE = c(mae(y_train, pred_train_ridge),
mae(y_valid, pred_valid_ridge),
mae(y_test, pred_test_ridge))
),
data.frame(
Model = "Lasso sobre PCA",
Dataset = c("Train", "Valid", "Test"),
RMSE = c(rmse(y_train, pred_train_lasso_pca),
rmse(y_valid, pred_valid_lasso_pca),
rmse(y_test, pred_test_lasso_pca)),
MAE = c(mae(y_train, pred_train_lasso_pca),
mae(y_valid, pred_valid_lasso_pca),
mae(y_test, pred_test_lasso_pca))
),
data.frame(
Model = "Ridge sobre PCA",
Dataset = c("Train", "Valid", "Test"),
RMSE = c(rmse(y_train, pred_train_ridge_pca),
rmse(y_valid, pred_valid_ridge_pca),
rmse(y_test, pred_test_ridge_pca)),
MAE = c(mae(y_train, pred_train_ridge_pca),
mae(y_valid, pred_valid_ridge_pca),
mae(y_test, pred_test_ridge_pca))
)
)
metrics_sorted <- metrics %>%
arrange(Dataset, RMSE)
metrics_sorted# Tomamos el modelo con mejor rendimiento en Test según RMSE: Lasso (glmnet)
df_pred_test <- data.frame(
Real = y_test,
Predicho = pred_test_lasso
)
ggplot(df_pred_test, aes(x = Real, y = Predicho)) +
geom_point(alpha = 0.4) +
geom_abline(intercept = 0, slope = 1, colour = "red", linetype = "dashed") +
labs(
title = "Predicciones vs valores reales de SalePrice (Test, Lasso)",
x = "SalePrice real",
y = "SalePrice predicho"
)
## Coeficientes no nulos del modelo Lasso
coef_lasso <- coef(lasso_cv, s = lambda_lasso)
coef_lasso_df <- data.frame(
Variable = rownames(coef_lasso),
Coeficiente = as.numeric(coef_lasso)
)
# Filtramos solo las variables con coeficiente distinto de cero
coef_lasso_df <- coef_lasso_df %>%
dplyr::filter(Coeficiente != 0) %>%
dplyr::arrange(desc(abs(Coeficiente)))
head(coef_lasso_df, 15)El diagrama de dispersión de predicciones frente a valores reales en el conjunto de test muestra que la mayoría de los puntos se alinean razonablemente con la recta identidad (línea roja discontinua), lo que indica un buen grado de ajuste del modelo Lasso. La dispersión aumenta ligeramente en los precios más altos y se aprecia cierta tendencia a infraestimar algunos valores extremos, un comportamiento típico en modelos lineales regularizados que tienden a “encoger” las predicciones más alejadas de la media.
Entre los coeficientes no nulos de mayor magnitud, el modelo Lasso
asigna efectos negativos importantes a categorías que reflejan peores
condiciones o funcionalidades problemáticas (por ejemplo, ciertas
calidades de piscina, condiciones adversas de la parcela o funcionalidad
severamente limitada), mientras que otorga coeficientes positivos a
barrios de mayor estatus (StoneBr, NridgHt,
NoRidge, Crawfor), al tipo de venta nueva
(SaleTypeNew) o a una mejor exposición del sótano
(BsmtExposureGd). La presencia de un intercepto muy
negativo es habitual en modelos con muchas variables dummy: el valor
esperado final de SalePrice surge de la combinación del
intercepto con numerosos efectos positivos y negativos relativos a las
categorías de referencia.