Teoría

Random Forest es un algoritmo de aprendizaje automático supervisado que se usa para clasificar y/o hacer regresiones. Se basa en la creación de múltiples árboles de decisión y combina sus resultados para hacer predicciones más precisas y estables.

Instalar paquetes y llamar librerías

#install.packages("randomForest") "bosques aleatorios
library(randomForest)
#install.packages("caret") #Entrenamiento de ML
library(caret)
library(tidyverse)

Importar base de datos

df <- read.csv("House Prices.csv")

Entender la base de datos

summary(df)
##        Id           MSSubClass       MSZoning            LotArea      
##  Min.   :   0.0   Min.   : 20.00   Length:2919        Min.   :  1300  
##  1st Qu.: 729.5   1st Qu.: 20.00   Class :character   1st Qu.:  7478  
##  Median :1459.0   Median : 50.00   Mode  :character   Median :  9453  
##  Mean   :1459.0   Mean   : 57.14                      Mean   : 10168  
##  3rd Qu.:2188.5   3rd Qu.: 70.00                      3rd Qu.: 11570  
##  Max.   :2918.0   Max.   :190.00                      Max.   :215245  
##                                                                       
##   LotConfig           BldgType          OverallCond      YearBuilt   
##  Length:2919        Length:2919        Min.   :1.000   Min.   :1872  
##  Class :character   Class :character   1st Qu.:5.000   1st Qu.:1954  
##  Mode  :character   Mode  :character   Median :5.000   Median :1973  
##                                        Mean   :5.565   Mean   :1971  
##                                        3rd Qu.:6.000   3rd Qu.:2001  
##                                        Max.   :9.000   Max.   :2010  
##                                                                      
##   YearRemodAdd  Exterior1st          BsmtFinSF2       TotalBsmtSF    
##  Min.   :1950   Length:2919        Min.   :   0.00   Min.   :   0.0  
##  1st Qu.:1965   Class :character   1st Qu.:   0.00   1st Qu.: 793.0  
##  Median :1993   Mode  :character   Median :   0.00   Median : 989.5  
##  Mean   :1984                      Mean   :  49.58   Mean   :1051.8  
##  3rd Qu.:2004                      3rd Qu.:   0.00   3rd Qu.:1302.0  
##  Max.   :2010                      Max.   :1526.00   Max.   :6110.0  
##                                    NA's   :1         NA's   :1       
##    SalePrice     
##  Min.   : 34900  
##  1st Qu.:129975  
##  Median :163000  
##  Mean   :180921  
##  3rd Qu.:214000  
##  Max.   :755000  
##  NA's   :1459
head(df)
##   Id MSSubClass MSZoning LotArea LotConfig BldgType OverallCond YearBuilt
## 1  0         60       RL    8450    Inside     1Fam           5      2003
## 2  1         20       RL    9600       FR2     1Fam           8      1976
## 3  2         60       RL   11250    Inside     1Fam           5      2001
## 4  3         70       RL    9550    Corner     1Fam           5      1915
## 5  4         60       RL   14260       FR2     1Fam           5      2000
## 6  5         50       RL   14115    Inside     1Fam           5      1993
##   YearRemodAdd Exterior1st BsmtFinSF2 TotalBsmtSF SalePrice
## 1         2003     VinylSd          0         856    208500
## 2         1976     MetalSd          0        1262    181500
## 3         2002     VinylSd          0         920    223500
## 4         1970     Wd Sdng          0         756    140000
## 5         2000     VinylSd          0        1145    250000
## 6         1995     VinylSd          0         796    143000
str(df)
## 'data.frame':    2919 obs. of  13 variables:
##  $ Id          : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ MSSubClass  : int  60 20 60 70 60 50 20 60 50 190 ...
##  $ MSZoning    : chr  "RL" "RL" "RL" "RL" ...
##  $ LotArea     : int  8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
##  $ LotConfig   : chr  "Inside" "FR2" "Inside" "Corner" ...
##  $ BldgType    : chr  "1Fam" "1Fam" "1Fam" "1Fam" ...
##  $ 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 ...
##  $ Exterior1st : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
##  $ BsmtFinSF2  : int  0 0 0 0 0 0 0 32 0 0 ...
##  $ TotalBsmtSF : int  856 1262 920 756 1145 796 1686 1107 952 991 ...
##  $ SalePrice   : int  208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...
df$MSZoning <- as.factor(df$MSZoning)
df$LotConfig <- as.factor(df$LotConfig)
df$BldgType <- as.factor(df$BldgType)
df$Exterior1st <- as.factor(df$Exterior1st)
df$SalePrice <- as.numeric(df$SalePrice)
str(df)
## 'data.frame':    2919 obs. of  13 variables:
##  $ Id          : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ MSSubClass  : int  60 20 60 70 60 50 20 60 50 190 ...
##  $ MSZoning    : Factor w/ 6 levels "","C (all)","FV",..: 5 5 5 5 5 5 5 5 6 5 ...
##  $ LotArea     : int  8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
##  $ LotConfig   : Factor w/ 5 levels "Corner","CulDSac",..: 5 3 5 1 3 5 5 1 5 1 ...
##  $ BldgType    : Factor w/ 5 levels "1Fam","2fmCon",..: 1 1 1 1 1 1 1 1 1 2 ...
##  $ 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 ...
##  $ Exterior1st : Factor w/ 16 levels "","AsbShng","AsphShn",..: 14 10 14 15 14 14 14 8 5 10 ...
##  $ BsmtFinSF2  : int  0 0 0 0 0 0 0 32 0 0 ...
##  $ TotalBsmtSF : int  856 1262 920 756 1145 796 1686 1107 952 991 ...
##  $ SalePrice   : num  208500 181500 223500 140000 250000 ...
df <- na.omit(df)

Entrenar el modelo

set.seed(123)
renglones_entrenamiento <- createDataPartition(df$SalePrice, p = 0.7, list = FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]
modelo <- randomForest(SalePrice ~ ., data = entrenamiento)
print(modelo)
## 
## Call:
##  randomForest(formula = SalePrice ~ ., data = entrenamiento) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 4
## 
##           Mean of squared residuals: 1621295030
##                     % Var explained: 74.72

Evaluar el modelo

evaluacion_entrenamiento <- predict(modelo, entrenamiento)
evaluacion_prueba <- predict(modelo, prueba)
mae_entrenamiento <- mean(abs(evaluacion_entrenamiento - entrenamiento$SalePrice))
rmse_entrenamiento <- sqrt(mean((evaluacion_entrenamiento - entrenamiento$SalePrice)^2))
mae_prueba <- mean(abs(evaluacion_prueba - prueba$SalePrice))
rmse_prueba <- sqrt(mean((evaluacion_prueba - prueba$SalePrice)^2))
cat("MAE Entrenamiento:", mae_entrenamiento, "\n")
## MAE Entrenamiento: 11021.04
cat("RMSE Entrenamiento:", rmse_entrenamiento, "\n")
## RMSE Entrenamiento: 18279.45
cat("MAE Prueba:", mae_prueba, "\n")
## MAE Prueba: 23391.76
cat("RMSE Prueba:", rmse_prueba, "\n")
## RMSE Prueba: 37216.55

Matriz de confusión

# Asegurar que SalePrice y evaluacion_prueba sean numéricos
prueba$SalePrice <- as.numeric(as.character(prueba$SalePrice))
evaluacion_prueba <- as.numeric(evaluacion_prueba)

# Cargar librería para métricas
library(Metrics)
## 
## Adjuntando el paquete: 'Metrics'
## The following objects are masked from 'package:caret':
## 
##     precision, recall
# Calcular métricas de error
mae_prueba <- mae(prueba$SalePrice, evaluacion_prueba)  # Error medio absoluto
rmse_prueba <- rmse(prueba$SalePrice, evaluacion_prueba)  # Error cuadrático medio
r2_prueba <- cor(prueba$SalePrice, evaluacion_prueba)^2  # R²

# Mostrar resultados
cat("MAE Prueba:", mae_prueba, "\n")
## MAE Prueba: 23391.76
cat("RMSE Prueba:", rmse_prueba, "\n")
## RMSE Prueba: 37216.55
cat("R² Prueba:", r2_prueba, "\n")
## R² Prueba: 0.7764767

Generar predicciones

prediccion <- predict(modelo, prueba)

# Agregar predicciones al conjunto de prueba
prueba <- prueba %>%
  mutate(PredictedPrice = prediccion)

# Mostrar primeras filas con predicciones
head(prueba)
##    Id MSSubClass MSZoning LotArea LotConfig BldgType OverallCond YearBuilt
## 1   0         60       RL    8450    Inside     1Fam           5      2003
## 4   3         70       RL    9550    Corner     1Fam           5      1915
## 8   7         60       RL   10382    Corner     1Fam           6      1973
## 11 10         20       RL   11200    Inside     1Fam           5      1965
## 13 12         20       RL   12968    Inside     1Fam           6      1962
## 15 14         20       RL   10920    Corner     1Fam           5      1960
##    YearRemodAdd Exterior1st BsmtFinSF2 TotalBsmtSF SalePrice PredictedPrice
## 1          2003     VinylSd          0         856    208500       199896.8
## 4          1970     Wd Sdng          0         756    140000       142311.8
## 8          1973     HdBoard         32        1107    200000       168477.5
## 11         1965     HdBoard          0        1040    129500       136820.0
## 13         1962     HdBoard          0         912    144000       143477.9
## 15         1960     MetalSd          0        1253    157000       153081.8
LS0tDQp0aXRsZTogIkhvdXNlIFByaWNlcyINCmF1dGhvcjogIk1heGltaWxpYW5vIEd1ZXZhcmEgR2FyY2lhIg0KZGF0ZTogIjIwMjUtMDItMjQiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogam91cm5hbA0KLS0tDQoNCiFbXShodHRwczovL3Jlc2l6ZXIuZ2xhbmFjaW9uLmNvbS9yZXNpemVyL3YyL2R1cmFudGUtYWJyaWwtbGFzLXZlbnRhcy1kZS12aXZpZW5kYXMtVzU3NUFZUk1GTkVEWEhVSzdFTEZPSUpRQ1UuSlBHP2F1dGg9OWFkNmJkOWEwMzZkYzY2ODE3YjBiMTY2Mjk4ZDdkZWU0M2JkY2EwMTk5YjgxOGVlNGRkMTI3YTk3Y2EwMDZmZSZ3aWR0aD03NjgmcXVhbGl0eT03MCZzbWFydD1mYWxzZSkNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGdyZWVuOyI+VGVvcsOtYTwvc3Bhbj4NCioqUmFuZG9tIEZvcmVzdCoqIGVzIHVuIGFsZ29yaXRtbyBkZSBhcHJlbmRpemFqZSBhdXRvbcOhdGljbyBzdXBlcnZpc2FkbyBxdWUgc2UgdXNhIHBhcmEgY2xhc2lmaWNhciB5L28gaGFjZXIgcmVncmVzaW9uZXMuIFNlIGJhc2EgZW4gbGEgY3JlYWNpw7NuIGRlIG3Dumx0aXBsZXMgw6FyYm9sZXMgZGUgZGVjaXNpw7NuIHkgY29tYmluYSBzdXMgcmVzdWx0YWRvcyBwYXJhIGhhY2VyIHByZWRpY2Npb25lcyBtw6FzIHByZWNpc2FzIHkgZXN0YWJsZXMuDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmVlbjsiPkluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXM8L3NwYW4+DQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KI2luc3RhbGwucGFja2FnZXMoInJhbmRvbUZvcmVzdCIpICJib3NxdWVzIGFsZWF0b3Jpb3MNCmxpYnJhcnkocmFuZG9tRm9yZXN0KQ0KI2luc3RhbGwucGFja2FnZXMoImNhcmV0IikgI0VudHJlbmFtaWVudG8gZGUgTUwNCmxpYnJhcnkoY2FyZXQpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmVlbjsiPkltcG9ydGFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJIb3VzZSBQcmljZXMuY3N2IikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogZ3JlZW47Ij5FbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zPC9zcGFuPg0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0KaGVhZChkZikNCnN0cihkZikNCmRmJE1TWm9uaW5nIDwtIGFzLmZhY3RvcihkZiRNU1pvbmluZykNCmRmJExvdENvbmZpZyA8LSBhcy5mYWN0b3IoZGYkTG90Q29uZmlnKQ0KZGYkQmxkZ1R5cGUgPC0gYXMuZmFjdG9yKGRmJEJsZGdUeXBlKQ0KZGYkRXh0ZXJpb3Ixc3QgPC0gYXMuZmFjdG9yKGRmJEV4dGVyaW9yMXN0KQ0KZGYkU2FsZVByaWNlIDwtIGFzLm51bWVyaWMoZGYkU2FsZVByaWNlKQ0Kc3RyKGRmKQ0KZGYgPC0gbmEub21pdChkZikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogZ3JlZW47Ij5FbnRyZW5hciBlbCBtb2RlbG88L3NwYW4+DQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCnJlbmdsb25lc19lbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oZGYkU2FsZVByaWNlLCBwID0gMC43LCBsaXN0ID0gRkFMU0UpDQplbnRyZW5hbWllbnRvIDwtIGRmW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpwcnVlYmEgPC0gZGZbLXJlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQptb2RlbG8gPC0gcmFuZG9tRm9yZXN0KFNhbGVQcmljZSB+IC4sIGRhdGEgPSBlbnRyZW5hbWllbnRvKQ0KcHJpbnQobW9kZWxvKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmVlbjsiPkV2YWx1YXIgZWwgbW9kZWxvPC9zcGFuPg0KYGBge3J9DQpldmFsdWFjaW9uX2VudHJlbmFtaWVudG8gPC0gcHJlZGljdChtb2RlbG8sIGVudHJlbmFtaWVudG8pDQpldmFsdWFjaW9uX3BydWViYSA8LSBwcmVkaWN0KG1vZGVsbywgcHJ1ZWJhKQ0KbWFlX2VudHJlbmFtaWVudG8gPC0gbWVhbihhYnMoZXZhbHVhY2lvbl9lbnRyZW5hbWllbnRvIC0gZW50cmVuYW1pZW50byRTYWxlUHJpY2UpKQ0KYGBgDQoNCmBgYHtyfQ0Kcm1zZV9lbnRyZW5hbWllbnRvIDwtIHNxcnQobWVhbigoZXZhbHVhY2lvbl9lbnRyZW5hbWllbnRvIC0gZW50cmVuYW1pZW50byRTYWxlUHJpY2UpXjIpKQ0KbWFlX3BydWViYSA8LSBtZWFuKGFicyhldmFsdWFjaW9uX3BydWViYSAtIHBydWViYSRTYWxlUHJpY2UpKQ0Kcm1zZV9wcnVlYmEgPC0gc3FydChtZWFuKChldmFsdWFjaW9uX3BydWViYSAtIHBydWViYSRTYWxlUHJpY2UpXjIpKQ0KY2F0KCJNQUUgRW50cmVuYW1pZW50bzoiLCBtYWVfZW50cmVuYW1pZW50bywgIlxuIikNCmNhdCgiUk1TRSBFbnRyZW5hbWllbnRvOiIsIHJtc2VfZW50cmVuYW1pZW50bywgIlxuIikNCmNhdCgiTUFFIFBydWViYToiLCBtYWVfcHJ1ZWJhLCAiXG4iKQ0KY2F0KCJSTVNFIFBydWViYToiLCBybXNlX3BydWViYSwgIlxuIikNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmVlbjsiPk1hdHJpeiBkZSBjb25mdXNpw7NuPC9zcGFuPg0KYGBge3J9DQojIEFzZWd1cmFyIHF1ZSBTYWxlUHJpY2UgeSBldmFsdWFjaW9uX3BydWViYSBzZWFuIG51bcOpcmljb3MNCnBydWViYSRTYWxlUHJpY2UgPC0gYXMubnVtZXJpYyhhcy5jaGFyYWN0ZXIocHJ1ZWJhJFNhbGVQcmljZSkpDQpldmFsdWFjaW9uX3BydWViYSA8LSBhcy5udW1lcmljKGV2YWx1YWNpb25fcHJ1ZWJhKQ0KDQojIENhcmdhciBsaWJyZXLDrWEgcGFyYSBtw6l0cmljYXMNCmxpYnJhcnkoTWV0cmljcykNCg0KIyBDYWxjdWxhciBtw6l0cmljYXMgZGUgZXJyb3INCm1hZV9wcnVlYmEgPC0gbWFlKHBydWViYSRTYWxlUHJpY2UsIGV2YWx1YWNpb25fcHJ1ZWJhKSAgIyBFcnJvciBtZWRpbyBhYnNvbHV0bw0Kcm1zZV9wcnVlYmEgPC0gcm1zZShwcnVlYmEkU2FsZVByaWNlLCBldmFsdWFjaW9uX3BydWViYSkgICMgRXJyb3IgY3VhZHLDoXRpY28gbWVkaW8NCnIyX3BydWViYSA8LSBjb3IocHJ1ZWJhJFNhbGVQcmljZSwgZXZhbHVhY2lvbl9wcnVlYmEpXjIgICMgUsKyDQoNCiMgTW9zdHJhciByZXN1bHRhZG9zDQpjYXQoIk1BRSBQcnVlYmE6IiwgbWFlX3BydWViYSwgIlxuIikNCg0KY2F0KCJSTVNFIFBydWViYToiLCBybXNlX3BydWViYSwgIlxuIikNCg0KY2F0KCJSwrIgUHJ1ZWJhOiIsIHIyX3BydWViYSwgIlxuIikNCg0KYGBgDQoNCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogZ3JlZW47Ij5HZW5lcmFyIHByZWRpY2Npb25lczwvc3Bhbj4NCmBgYHtyfQ0KcHJlZGljY2lvbiA8LSBwcmVkaWN0KG1vZGVsbywgcHJ1ZWJhKQ0KDQojIEFncmVnYXIgcHJlZGljY2lvbmVzIGFsIGNvbmp1bnRvIGRlIHBydWViYQ0KcHJ1ZWJhIDwtIHBydWViYSAlPiUNCiAgbXV0YXRlKFByZWRpY3RlZFByaWNlID0gcHJlZGljY2lvbikNCg0KIyBNb3N0cmFyIHByaW1lcmFzIGZpbGFzIGNvbiBwcmVkaWNjaW9uZXMNCmhlYWQocHJ1ZWJhKQ0KYGBgDQoNCg0KDQo=