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 creacion de multiples arboles de decisión y combina sus resultados para hacer predicciones más precisas y estables.

Instalar Paquetes y Llamar Librerias

library(randomForest)
library(caret)
library(dplyr)

Importar Base de Datos

df <- read.csv("C:\\Users\\USUARIO\\Desktop\\Bloque - Modulo 2\\House Prices.csv")
df <- na.omit(df)
if ("Id" %in% colnames(df)) {
  df <- select(df, -Id)
}

Entender la base de datos

summary(df)
##    MSSubClass      MSZoning            LotArea        LotConfig        
##  Min.   : 20.0   Length:1460        Min.   :  1300   Length:1460       
##  1st Qu.: 20.0   Class :character   1st Qu.:  7554   Class :character  
##  Median : 50.0   Mode  :character   Median :  9478   Mode  :character  
##  Mean   : 56.9                      Mean   : 10517                     
##  3rd Qu.: 70.0                      3rd Qu.: 11602                     
##  Max.   :190.0                      Max.   :215245                     
##    BldgType          OverallCond      YearBuilt     YearRemodAdd 
##  Length:1460        Min.   :1.000   Min.   :1872   Min.   :1950  
##  Class :character   1st Qu.:5.000   1st Qu.:1954   1st Qu.:1967  
##  Mode  :character   Median :5.000   Median :1973   Median :1994  
##                     Mean   :5.575   Mean   :1971   Mean   :1985  
##                     3rd Qu.:6.000   3rd Qu.:2000   3rd Qu.:2004  
##                     Max.   :9.000   Max.   :2010   Max.   :2010  
##  Exterior1st          BsmtFinSF2       TotalBsmtSF       SalePrice     
##  Length:1460        Min.   :   0.00   Min.   :   0.0   Min.   : 34900  
##  Class :character   1st Qu.:   0.00   1st Qu.: 795.8   1st Qu.:129975  
##  Mode  :character   Median :   0.00   Median : 991.5   Median :163000  
##                     Mean   :  46.55   Mean   :1057.4   Mean   :180921  
##                     3rd Qu.:   0.00   3rd Qu.:1298.2   3rd Qu.:214000  
##                     Max.   :1474.00   Max.   :6110.0   Max.   :755000
head(df)
##   MSSubClass MSZoning LotArea LotConfig BldgType OverallCond YearBuilt
## 1         60       RL    8450    Inside     1Fam           5      2003
## 2         20       RL    9600       FR2     1Fam           8      1976
## 3         60       RL   11250    Inside     1Fam           5      2001
## 4         70       RL    9550    Corner     1Fam           5      1915
## 5         60       RL   14260       FR2     1Fam           5      2000
## 6         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':    1460 obs. of  12 variables:
##  $ 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 ...
##  - attr(*, "na.action")= 'omit' Named int [1:1459] 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 ...
##   ..- attr(*, "names")= chr [1:1459] "1461" "1462" "1463" "1464" ...
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.factor(df$SalePrice)
str(df)
## 'data.frame':    1460 obs. of  12 variables:
##  $ MSSubClass  : int  60 20 60 70 60 50 20 60 50 190 ...
##  $ MSZoning    : Factor w/ 5 levels "C (all)","FV",..: 4 4 4 4 4 4 4 4 5 4 ...
##  $ 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/ 15 levels "AsbShng","AsphShn",..: 13 9 13 14 13 13 13 7 4 9 ...
##  $ 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   : Factor w/ 663 levels "34900","35311",..: 413 340 443 195 495 204 574 391 152 114 ...
##  - attr(*, "na.action")= 'omit' Named int [1:1459] 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 ...
##   ..- attr(*, "names")= chr [1:1459] "1461" "1462" "1463" "1464" ...

Entrenar el Modelo

set.seed(123)

# Dividir en entrenamiento (70%) y prueba (30%)
renglones_entrenamiento <- createDataPartition(df$SalePrice, p = 0.7, list = FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]

# Entrenar modelo Random Forest
modelo <- randomForest(SalePrice ~ ., data = entrenamiento, ntree = 100)

# Mostrar importancia de variables
varImpPlot(modelo)

Evaluar El Modelo

# Predicción en datos de entrenamiento
evaluacion_entrenamiento <- predict(modelo, entrenamiento)

# Predicción en datos de prueba
evaluacion_prueba <- predict(modelo, prueba)

# Calcular error medio absoluto (MAE) y error cuadrático medio (RMSE)
mae_entrenamiento <- mean(abs(evaluacion_entrenamiento - entrenamiento$SalePrice))
## Warning in Ops.factor(evaluacion_entrenamiento, entrenamiento$SalePrice): '-'
## no es significativo para factores
rmse_entrenamiento <- sqrt(mean((evaluacion_entrenamiento - entrenamiento$SalePrice)^2))
## Warning in Ops.factor(evaluacion_entrenamiento, entrenamiento$SalePrice): '-'
## no es significativo para factores
mae_prueba <- mean(abs(evaluacion_prueba - prueba$SalePrice))
## Warning in Ops.factor(evaluacion_prueba, prueba$SalePrice): '-' no es
## significativo para factores
rmse_prueba <- sqrt(mean((evaluacion_prueba - prueba$SalePrice)^2))
## Warning in Ops.factor(evaluacion_prueba, prueba$SalePrice): '-' no es
## significativo para factores
# Mostrar métricas de evaluación
cat("MAE Entrenamiento:", mae_entrenamiento, "\n")
## MAE Entrenamiento: NA
cat("RMSE Entrenamiento:", rmse_entrenamiento, "\n")
## RMSE Entrenamiento: NA
cat("MAE Prueba:", mae_prueba, "\n")
## MAE Prueba: NA
cat("RMSE Prueba:", rmse_prueba, "\n")
## RMSE Prueba: NA

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: 159401.6
cat("RMSE Prueba:", rmse_prueba, "\n")
## RMSE Prueba: 165570.2
cat("R² Prueba:", r2_prueba, "\n")
## R² Prueba: 0.5365039

Generar Predicciones

prediccion <- predict(modelo, prueba)

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

# Mostrar primeras filas con predicciones
head(prueba)
##    MSSubClass MSZoning LotArea LotConfig BldgType OverallCond YearBuilt
## 4          70       RL    9550    Corner     1Fam           5      1915
## 23         20       RL    9742    Inside     1Fam           5      2002
## 29         20       RL   16321   CulDSac     1Fam           6      1957
## 33         20       RL   11049    Corner     1Fam           5      2007
## 41         20       RL    8658    Inside     1Fam           5      1965
## 42         20       RL   16905    Inside     1Fam           6      1959
##    YearRemodAdd Exterior1st BsmtFinSF2 TotalBsmtSF SalePrice PredictedPrice
## 4          1970     Wd Sdng          0         756    140000         105000
## 23         2002     VinylSd          0        1777    230000         227000
## 29         1997     MetalSd          0        1484    207500         200500
## 33         2007     VinylSd          0        1234    179900         200141
## 41         1965     Wd Sdng          0        1088    160000         139000
## 42         1959     VinylSd          0        1350    170000         135000
LS0tDQp0aXRsZTogIlJhbmRvbSBGb3Jlc3QiDQphdXRob3I6ICJGYWJpYW5hIE1lZGluYWNlbGxpIC0gQTAwODM1ODk2Ig0KZGF0ZTogIjIwMjUtMDItMjQiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgICAgdG9jOiBUUlVFDQogICAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICAgIHRoZW1lOiBqb3VybmFsDQotLS0NCg0KIVtdKEM6XFxVc2Vyc1xcVVNVQVJJT1xcRGVza3RvcFxcQmxvcXVlIC0gTW9kdWxvIDJcXHR1bWJscl9lZDE3YWE2N2I3NDI4Yzc2M2Y0ZDg0NjAwM2Y2MjZjM18wZTRhYjRiMl82NDAuZ2lmKQ0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+VGVvcsOtYTwvc3Bhbj4gIA0KDQoqKlJhbmRvbSBGb3Jlc3QqKiBFcyB1biBhbGdvcml0bW8gZGUgYXByZW5kaXphamUgYXV0b23DoXRpY28gc3VwZXJ2aXNhZG8gcXVlIHNlIHVzYSBwYXJhIGNsYXNpZmljYXIgeS9vIGhhY2VyIHJlZ3Jlc2lvbmVzLiBTZSBiYXNhIGVuIGxhIGNyZWFjaW9uIGRlIG11bHRpcGxlcyBhcmJvbGVzIGRlIGRlY2lzacOzbiB5IGNvbWJpbmEgc3VzIHJlc3VsdGFkb3MgcGFyYSBoYWNlciBwcmVkaWNjaW9uZXMgbcOhcyBwcmVjaXNhcyB5IGVzdGFibGVzLg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+SW5zdGFsYXIgUGFxdWV0ZXMgeSBMbGFtYXIgTGlicmVyaWFzPC9zcGFuPiAgDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KbGlicmFyeShyYW5kb21Gb3Jlc3QpDQpsaWJyYXJ5KGNhcmV0KQ0KbGlicmFyeShkcGx5cikNCmBgYA0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IG9yYW5nZTsiPkltcG9ydGFyIEJhc2UgZGUgRGF0b3M8L3NwYW4+ICANCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcVVNVQVJJT1xcRGVza3RvcFxcQmxvcXVlIC0gTW9kdWxvIDJcXEhvdXNlIFByaWNlcy5jc3YiKQ0KZGYgPC0gbmEub21pdChkZikNCmlmICgiSWQiICVpbiUgY29sbmFtZXMoZGYpKSB7DQogIGRmIDwtIHNlbGVjdChkZiwgLUlkKQ0KfQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+RW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4gIA0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0KaGVhZChkZikNCnN0cihkZikNCmRmJE1TWm9uaW5nIDwtIGFzLmZhY3RvcihkZiRNU1pvbmluZykNCmRmJExvdENvbmZpZyA8LSBhcy5mYWN0b3IoZGYkTG90Q29uZmlnKQ0KZGYkQmxkZ1R5cGUgPC0gYXMuZmFjdG9yKGRmJEJsZGdUeXBlKQ0KZGYkRXh0ZXJpb3Ixc3QgPC0gYXMuZmFjdG9yKGRmJEV4dGVyaW9yMXN0KQ0KZGYkU2FsZVByaWNlIDwtIGFzLmZhY3RvcihkZiRTYWxlUHJpY2UpDQpzdHIoZGYpDQpgYGANCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBvcmFuZ2U7Ij5FbnRyZW5hciBlbCBNb2RlbG88L3NwYW4+IA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCnNldC5zZWVkKDEyMykNCg0KIyBEaXZpZGlyIGVuIGVudHJlbmFtaWVudG8gKDcwJSkgeSBwcnVlYmEgKDMwJSkNCnJlbmdsb25lc19lbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oZGYkU2FsZVByaWNlLCBwID0gMC43LCBsaXN0ID0gRkFMU0UpDQplbnRyZW5hbWllbnRvIDwtIGRmW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpwcnVlYmEgPC0gZGZbLXJlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQoNCiMgRW50cmVuYXIgbW9kZWxvIFJhbmRvbSBGb3Jlc3QNCm1vZGVsbyA8LSByYW5kb21Gb3Jlc3QoU2FsZVByaWNlIH4gLiwgZGF0YSA9IGVudHJlbmFtaWVudG8sIG50cmVlID0gMTAwKQ0KDQojIE1vc3RyYXIgaW1wb3J0YW5jaWEgZGUgdmFyaWFibGVzDQp2YXJJbXBQbG90KG1vZGVsbykNCmBgYCAgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBvcmFuZ2U7Ij5FdmFsdWFyIEVsIE1vZGVsbzwvc3Bhbj4gDQpgYGB7cn0NCiMgUHJlZGljY2nDs24gZW4gZGF0b3MgZGUgZW50cmVuYW1pZW50bw0KZXZhbHVhY2lvbl9lbnRyZW5hbWllbnRvIDwtIHByZWRpY3QobW9kZWxvLCBlbnRyZW5hbWllbnRvKQ0KDQojIFByZWRpY2Npw7NuIGVuIGRhdG9zIGRlIHBydWViYQ0KZXZhbHVhY2lvbl9wcnVlYmEgPC0gcHJlZGljdChtb2RlbG8sIHBydWViYSkNCg0KIyBDYWxjdWxhciBlcnJvciBtZWRpbyBhYnNvbHV0byAoTUFFKSB5IGVycm9yIGN1YWRyw6F0aWNvIG1lZGlvIChSTVNFKQ0KbWFlX2VudHJlbmFtaWVudG8gPC0gbWVhbihhYnMoZXZhbHVhY2lvbl9lbnRyZW5hbWllbnRvIC0gZW50cmVuYW1pZW50byRTYWxlUHJpY2UpKQ0Kcm1zZV9lbnRyZW5hbWllbnRvIDwtIHNxcnQobWVhbigoZXZhbHVhY2lvbl9lbnRyZW5hbWllbnRvIC0gZW50cmVuYW1pZW50byRTYWxlUHJpY2UpXjIpKQ0KDQptYWVfcHJ1ZWJhIDwtIG1lYW4oYWJzKGV2YWx1YWNpb25fcHJ1ZWJhIC0gcHJ1ZWJhJFNhbGVQcmljZSkpDQpybXNlX3BydWViYSA8LSBzcXJ0KG1lYW4oKGV2YWx1YWNpb25fcHJ1ZWJhIC0gcHJ1ZWJhJFNhbGVQcmljZSleMikpDQoNCiMgTW9zdHJhciBtw6l0cmljYXMgZGUgZXZhbHVhY2nDs24NCmNhdCgiTUFFIEVudHJlbmFtaWVudG86IiwgbWFlX2VudHJlbmFtaWVudG8sICJcbiIpDQpjYXQoIlJNU0UgRW50cmVuYW1pZW50bzoiLCBybXNlX2VudHJlbmFtaWVudG8sICJcbiIpDQpjYXQoIk1BRSBQcnVlYmE6IiwgbWFlX3BydWViYSwgIlxuIikNCmNhdCgiUk1TRSBQcnVlYmE6Iiwgcm1zZV9wcnVlYmEsICJcbiIpDQoNCmBgYCAgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+TWF0cml6IGRlIENvbmZ1c2nDs248L3NwYW4+IA0KYGBge3J9DQojIEFzZWd1cmFyIHF1ZSBTYWxlUHJpY2UgeSBldmFsdWFjaW9uX3BydWViYSBzZWFuIG51bcOpcmljb3MNCnBydWViYSRTYWxlUHJpY2UgPC0gYXMubnVtZXJpYyhhcy5jaGFyYWN0ZXIocHJ1ZWJhJFNhbGVQcmljZSkpDQpldmFsdWFjaW9uX3BydWViYSA8LSBhcy5udW1lcmljKGV2YWx1YWNpb25fcHJ1ZWJhKQ0KDQojIENhcmdhciBsaWJyZXLDrWEgcGFyYSBtw6l0cmljYXMNCmxpYnJhcnkoTWV0cmljcykNCg0KIyBDYWxjdWxhciBtw6l0cmljYXMgZGUgZXJyb3INCm1hZV9wcnVlYmEgPC0gbWFlKHBydWViYSRTYWxlUHJpY2UsIGV2YWx1YWNpb25fcHJ1ZWJhKSAgIyBFcnJvciBtZWRpbyBhYnNvbHV0bw0Kcm1zZV9wcnVlYmEgPC0gcm1zZShwcnVlYmEkU2FsZVByaWNlLCBldmFsdWFjaW9uX3BydWViYSkgICMgRXJyb3IgY3VhZHLDoXRpY28gbWVkaW8NCnIyX3BydWViYSA8LSBjb3IocHJ1ZWJhJFNhbGVQcmljZSwgZXZhbHVhY2lvbl9wcnVlYmEpXjIgICMgUsKyDQoNCiMgTW9zdHJhciByZXN1bHRhZG9zDQpjYXQoIk1BRSBQcnVlYmE6IiwgbWFlX3BydWViYSwgIlxuIikNCmNhdCgiUk1TRSBQcnVlYmE6Iiwgcm1zZV9wcnVlYmEsICJcbiIpDQpjYXQoIlLCsiBQcnVlYmE6IiwgcjJfcHJ1ZWJhLCAiXG4iKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBvcmFuZ2UiPkdlbmVyYXIgUHJlZGljY2lvbmVzPC9zcGFuPiANCmBgYHtyfQ0KcHJlZGljY2lvbiA8LSBwcmVkaWN0KG1vZGVsbywgcHJ1ZWJhKQ0KDQojIEFncmVnYXIgcHJlZGljY2lvbmVzIGFsIGNvbmp1bnRvIGRlIHBydWViYQ0KcHJ1ZWJhIDwtIHBydWViYSAlPiUNCiAgbXV0YXRlKFByZWRpY3RlZFByaWNlID0gcHJlZGljY2lvbikNCg0KIyBNb3N0cmFyIHByaW1lcmFzIGZpbGFzIGNvbiBwcmVkaWNjaW9uZXMNCmhlYWQocHJ1ZWJhKQ0KYGBgDQoNCg==