House Prices: Advanced Regression Techniques

Este problema es una de las competencias juego de la plataforma Kaggle, en la cual busca predecir el precio de venta de una propiedad en dólares (SalePrice) teniendo un gran número de características (79) como su área, número de habitaciones, área del garaje, altura del sótano, etc.

Se evalúa el nivel de ajuste del modelo en base a la raíz del error cuadrático medio (RMSE).

Enlace competencia: https://www.kaggle.com/c/house-prices-advanced-regression-techniques/overview

la competencia brinda una base de entrenamiento y una base de prueba, en esta última se debe predecir el precio de venta de un conjunto de propiedades desconociendo su valor original.

# Base de entrenamiento
train <- read.csv(file = "train.csv", header = T, stringsAsFactors = T)

# Base de prueba
test <- read.csv(file = "test.csv", header = T, stringsAsFactors = T)

Con la ayuda de R se crea una función para calcular el RMSE de las predicciones obtenidas.

RMSE <- function(y, yhat) sqrt(mean((y-yhat)**2))

A continuación se presentarán los dos mejores modelos de ambos estudiantes, ambos seleccionados por el puntaje alcanzado en la competencia.

1 Jaime Andrés Molina Correa - Mejor modelo (0.15649 de puntaje)

Se realizaron modelos de regresión lineal, bagging y Random Forest para predecir el predecir el precio de venta de una propiedad. El mejor modelo obtenido fue un baggin con 12 variables consideradas. El procedimiento para llegar al modelo se enseña a continuación.

paquetes utilizados:

library(randomForest) # Para crear modelos de bosques aleatorios y bagging
library(dplyr)        # Para modificar los conjuntos de datos.

semilla <- 1998 # Se crea una semilla para reproductividad.

A continuación se enseñan el número de datos faltantes (NA) en las variables del conjunto de entrenamiento. Las que no se muestran no tienen datos faltantes.

sort(sapply(train, function(y) sum(length(which(is.na(y))))), decreasing = T)[1:19]

##       PoolQC  MiscFeature        Alley        Fence  FireplaceQu  LotFrontage 
##         1453         1406         1369         1179          690          259 
##   GarageType  GarageYrBlt GarageFinish   GarageQual   GarageCond BsmtExposure 
##           81           81           81           81           81           38 
## BsmtFinType2     BsmtQual     BsmtCond BsmtFinType1   MasVnrType   MasVnrArea 
##           38           37           37           37            8            8 
##   Electrical 
##            1

Se eliminan las variables con mayor número de datos faltantes, variable con más de 50 faltantes en el conjunto de entrenamiento se desprecia.

train <- train %>% select(-c(PoolQC, MiscFeature, Alley, Fence,
                             FireplaceQu, LotFrontage, GarageType, GarageYrBlt,
                             GarageFinish, GarageQual,GarageCond))

Posteriormente se eliminan las observaciones con datos faltantes ya que ahora se podrían perder pocas observaciones.

train <- na.omit(train)

1.1 Modelo Random Forest para selección de variables.

Para entrenar un modelo con el método Random Forest se hace uso de la función randomForest del paquete randomForest.

Se procede a la creación del modelo con el número de árboles que utiliza por defecto la función (500). El número de variables que selecciona aleatoriamente en cada muestra bootstrap es calculado según el número de variables consideradas, para este número de variables se usan 22 en cada muestra.

set.seed(semilla)
modRF <- randomForest(SalePrice ~ ., data = train[,-1], importance = TRUE)
modRF

## 
## Call:
##  randomForest(formula = SalePrice ~ ., data = train[, -1], importance = TRUE) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 22
## 
##           Mean of squared residuals: 781781463
##                     % Var explained: 87.55

A continación se muestran cuales son las variables que aportan más al modelo según dos metricas diferentes.

varImpPlot(modRF, col = 4, pch = 16, main = "Modelo Random Forest", cex = 0.65)

1.2 Modelo Bagging.

En un principio se pensó en utilizar las 3 variables que son más informativas según el MSE, pero al no tener muy buenos resultados en el puntaje de la competencia, se decide utilizar las primeras 12. A continuación se crea el modelo.

set.seed(semilla)
modbag <- randomForest(SalePrice ~ GrLivArea + Neighborhood + OverallQual +
                        TotalBsmtSF + X1stFlrSF + X2ndFlrSF + GarageCars +
                        GarageArea + LotArea + BsmtFinSF1 + ExterQual + FullBath,
                      data = train,
                      importance = TRUE, ntree = 500, mtry = 12)

modbag

## 
## Call:
##  randomForest(formula = SalePrice ~ GrLivArea + Neighborhood +      OverallQual + TotalBsmtSF + X1stFlrSF + X2ndFlrSF + GarageCars +      GarageArea + LotArea + BsmtFinSF1 + ExterQual + FullBath,      data = train, importance = TRUE, ntree = 500, mtry = 12) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 12
## 
##           Mean of squared residuals: 847029853
##                     % Var explained: 86.51

1.3 Conjunto de prueba kaggle

Se seleccionan solo las variables usadas en el modelo final

test <- test %>% select(Id, GrLivArea, Neighborhood, OverallQual, TotalBsmtSF,
                        X1stFlrSF, X2ndFlrSF, GarageCars, GarageArea, LotArea,
                        BsmtFinSF1, ExterQual, FullBath)

número de datos faltantes en el conjunto de prueba.

sort(sapply(test, function(y) sum(length(which(is.na(y))))), decreasing = T)

##  TotalBsmtSF   GarageCars   GarageArea   BsmtFinSF1           Id    GrLivArea 
##            1            1            1            1            0            0 
## Neighborhood  OverallQual    X1stFlrSF    X2ndFlrSF      LotArea    ExterQual 
##            0            0            0            0            0            0 
##     FullBath 
##            0

Se puede observar que cuatro de las variables usadas en el modelo tienen un valor faltante, por lo que se deben reemplazar. Como son variables continuas se decide reemplazar el valor faltante con la mediana de la respectiva variable en el conjunto de entrenamiento

test$TotalBsmtSF[is.na(test$TotalBsmtSF)] <- median(train$TotalBsmtSF, na.rm = T)
test$GarageCars[is.na(test$GarageCars)] <- median(train$GarageCars, na.rm = T)
test$GarageArea[is.na(test$GarageArea)] <- median(train$GarageArea, na.rm = T)
test$BsmtFinSF1[is.na(test$BsmtFinSF1)] <- median(train$BsmtFinSF1, na.rm = T)

1.4 Predicción y creación de base de datos

Finalmente, con la ayuda de la función predict() se obtienen los valores ajustados para subir a la competencia.

test.Sales <- predict(modbag, newdata = test, type = "response")

Por último, se crea la base de datos.

write.csv(data.frame(Id = test$Id, SalePrice = test.Sales), file = "baggin12.csv",
          row.names = F)

2 Valentina Garcia Velasquez - Mejor modelo (0.13398 de puntaje)

library(xgboost)
library(caret)

Se lee nuevamente el conjunto de datos y entrenamiento

# Leer datos de entrenamiento
df <- read.csv('train.csv', stringsAsFactors = T)
test <- read.csv('test.csv', stringsAsFactors = T)

Se seleccionan únicamente las columnas numéricas y se reeemplazan los NA con el valor -99.

numeric_columns <- df %>% dplyr::select(where(is.numeric))
numeric_columns[is.na(numeric_columns)] <- -99

Se crea una matriz con las covariables y otra para la variable respuesta, re realiza el mismo procedimiento para el conjunto de prueba.

train_x <- data.matrix(numeric_columns[, -c(1,38)])
train_y <- numeric_columns[, 38]

numeric_columns2 <- test %>% dplyr::select(where(is.numeric))
numeric_columns2[is.na(numeric_columns2)] <- -99

test_x = data.matrix(numeric_columns2[, -1])

2.1 Modelo xgboost con grid search (Mejor modelo)

Se ajusta un modelo XGBoost, se realiza una rejilla con valores para los diferentes parámetros y se obtiene el más óptimo con el método cross validation.

# Se deben preparar los datos de otra forma
X <- xgb.DMatrix(as.matrix(train_x))
y <- train_y

xgb_trcontrol = trainControl(
  method = "cv", # Cross validation
  number = 10,  
  allowParallel = TRUE,
  verboseIter = FALSE,
  returnData = FALSE
)

xgbGrid <- expand.grid(nrounds=c(100,200,300,400),
                       max_depth = c(3:7),
                       eta = seq(0.05, 1,10),
                       gamma = seq(0.01,1,10),
                       colsample_bytree = c(0.75),
                       subsample = c(0.50),
                       min_child_weight = c(0))

Entrenamiento del modelo

mod2 <- train(
  X, y,
  trControl = xgb_trcontrol,
  tuneGrid = xgbGrid,
  method = "xgbTree",
  objective = 'reg:squarederror'
)

Se guardan las predicciones

xgb_test <- xgb.DMatrix(as.matrix(test_x))
pred_y <- predict(mod2, xgb_test)
write.csv(data.frame(Id = numeric_columns2$Id, SalePrice = pred_y),'sample3.csv',row.names = F)

2.2 Modelo XGBoost con gridsearch y variables seleccionadas anteriormente con RF

SalePrice ~ ,

train_x2 <- numeric_columns[, -c(1,38)]
train_x2 <- data.matrix(train_x2[,c('GrLivArea','OverallQual',
                        'TotalBsmtSF','X1stFlrSF','X2ndFlrSF','GarageCars',
                        'GarageArea', 'LotArea', 'BsmtFinSF1','FullBath')])
train_y2 <- numeric_columns[, 38]
test_x2 <- numeric_columns2[, -1]
test_x2 <- data.matrix(test_x2[,c('GrLivArea','OverallQual',
                        'TotalBsmtSF','X1stFlrSF','X2ndFlrSF','GarageCars',
                        'GarageArea', 'LotArea', 'BsmtFinSF1','FullBath')])


# Se deben preparar los datos de otra forma
X2 <- xgb.DMatrix(as.matrix(train_x2))
y2 <- train_y2

xgb_trcontrol = trainControl(
  method = "cv", # Cross validation
  number = 10,  
  allowParallel = TRUE,
  verboseIter = FALSE,
  returnData = FALSE
)

xgbGrid <- expand.grid(nrounds=c(100,200,300,400),
                       max_depth = c(3:7),
                       eta = seq(0.05, 1,10),
                       gamma = seq(0.01,1,10),
                       colsample_bytree = c(0.75),
                       subsample = c(0.50),
                       min_child_weight = c(0))

mod3 <- train(
  X2, y2,
  trControl = xgb_trcontrol,
  tuneGrid = xgbGrid,
  method = "xgbTree",
  objective = 'reg:squarederror'
)

xgb_test2 <- xgb.DMatrix(as.matrix(test_x2))
pred_y2 <- predict(mod3, xgb_test2)
write.csv(data.frame(Id = numeric_columns2$Id, SalePrice = pred_y2),'final_sample.csv',row.names = F)

3 Evidencias

3.1 Ranking alcanzado

3.2 Mejor puntaje Valentina Garcia

3.3 Mejor puntaje Jaime Molina