Bosques Aleatorios
Pablo Sancho A01722236
2025-08-27
Teoría
El Bosque Aleatorio es un algoritmo de aprendizaje automatico que combina el resultado de multiples arboles de decision para llegar a un resultado optimo.
Ejemplo 1. Melbourne
En esta base de datos tenemos los precios de 13,000 casas en la ciudad de Melbourne:
Instalar paquetes y cargar librerias
#install.packages("tidyverse")
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors#install.packages("rpart")
#install.packages("rpart.plot")
library(rpart)
library(rpart.plot)
#install.packages("randomForest")
library(randomForest)## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## margin#install.packages("modelr") #Calcular errores
library(modelr)
#install.packages("caret")
library(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftImportar y entender la base de datos
df <- read.csv("/Users/pablosancho/Desktop/Concentración/Modulo 2 Concentracion (R)/melbourne.csv")
summary(df)## Suburb Address Rooms Type
## Length:13580 Length:13580 Min. : 1.000 Length:13580
## Class :character Class :character 1st Qu.: 2.000 Class :character
## Mode :character Mode :character Median : 3.000 Mode :character
## Mean : 2.938
## 3rd Qu.: 3.000
## Max. :10.000
##
## Price Method SellerG Date
## Min. : 85000 Length:13580 Length:13580 Length:13580
## 1st Qu.: 650000 Class :character Class :character Class :character
## Median : 903000 Mode :character Mode :character Mode :character
## Mean :1075684
## 3rd Qu.:1330000
## Max. :9000000
##
## Distance Postcode Bedroom2 Bathroom
## Min. : 0.00 Min. :3000 Min. : 0.000 Min. :0.000
## 1st Qu.: 6.10 1st Qu.:3044 1st Qu.: 2.000 1st Qu.:1.000
## Median : 9.20 Median :3084 Median : 3.000 Median :1.000
## Mean :10.14 Mean :3105 Mean : 2.915 Mean :1.534
## 3rd Qu.:13.00 3rd Qu.:3148 3rd Qu.: 3.000 3rd Qu.:2.000
## Max. :48.10 Max. :3977 Max. :20.000 Max. :8.000
##
## Car Landsize BuildingArea YearBuilt
## Min. : 0.00 Min. : 0.0 Min. : 0 Min. :1196
## 1st Qu.: 1.00 1st Qu.: 177.0 1st Qu.: 93 1st Qu.:1940
## Median : 2.00 Median : 440.0 Median : 126 Median :1970
## Mean : 1.61 Mean : 558.4 Mean : 152 Mean :1965
## 3rd Qu.: 2.00 3rd Qu.: 651.0 3rd Qu.: 174 3rd Qu.:1999
## Max. :10.00 Max. :433014.0 Max. :44515 Max. :2018
## NA's :62 NA's :6450 NA's :5375
## CouncilArea Lattitude Longtitude Regionname
## Length:13580 Min. :-38.18 Min. :144.4 Length:13580
## Class :character 1st Qu.:-37.86 1st Qu.:144.9 Class :character
## Mode :character Median :-37.80 Median :145.0 Mode :character
## Mean :-37.81 Mean :145.0
## 3rd Qu.:-37.76 3rd Qu.:145.1
## Max. :-37.41 Max. :145.5
##
## Propertycount
## Min. : 249
## 1st Qu.: 4380
## Median : 6555
## Mean : 7454
## 3rd Qu.:10331
## Max. :21650
## str(df)## 'data.frame': 13580 obs. of 21 variables:
## $ Suburb : chr "Abbotsford" "Abbotsford" "Abbotsford" "Abbotsford" ...
## $ Address : chr "85 Turner St" "25 Bloomburg St" "5 Charles St" "40 Federation La" ...
## $ Rooms : int 2 2 3 3 4 2 3 2 1 2 ...
## $ Type : chr "h" "h" "h" "h" ...
## $ Price : num 1480000 1035000 1465000 850000 1600000 ...
## $ Method : chr "S" "S" "SP" "PI" ...
## $ SellerG : chr "Biggin" "Biggin" "Biggin" "Biggin" ...
## $ Date : chr "3/12/2016" "4/02/2016" "4/03/2017" "4/03/2017" ...
## $ Distance : num 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 ...
## $ Postcode : num 3067 3067 3067 3067 3067 ...
## $ Bedroom2 : num 2 2 3 3 3 2 4 2 1 3 ...
## $ Bathroom : num 1 1 2 2 1 1 2 1 1 1 ...
## $ Car : num 1 0 0 1 2 0 0 2 1 2 ...
## $ Landsize : num 202 156 134 94 120 181 245 256 0 220 ...
## $ BuildingArea : num NA 79 150 NA 142 NA 210 107 NA 75 ...
## $ YearBuilt : num NA 1900 1900 NA 2014 ...
## $ CouncilArea : chr "Yarra" "Yarra" "Yarra" "Yarra" ...
## $ Lattitude : num -37.8 -37.8 -37.8 -37.8 -37.8 ...
## $ Longtitude : num 145 145 145 145 145 ...
## $ Regionname : chr "Northern Metropolitan" "Northern Metropolitan" "Northern Metropolitan" "Northern Metropolitan" ...
## $ Propertycount: num 4019 4019 4019 4019 4019 ...df <- na.omit(df)Arbol de Decisión
arbol <- rpart(Price ~ Rooms + Distance + Postcode + Bedroom2 + Bathroom + Car + Landsize + BuildingArea + YearBuilt + Propertycount , data= df)
plot(arbol, uniform=TRUE)
text(arbol, cex=0.4)
predict(arbol,head(df))## 2 3 5 7 8 10
## 1095995.9 1330176.8 807590.2 1578642.6 1095995.9 1095995.9head(df$Price)## [1] 1035000 1465000 1600000 1876000 1636000 1097000prueba_arbol <- head(df)
mae_arbol <- mae(arbol, prueba_arbol) #MAE = Error Cuadrado promedioBosque Aleatorio
set.seed(123)
renglones_entrenamiento <- createDataPartition(df$Price, p=0.8, list=FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]
rf <- randomForest(Price ~ Rooms + Distance + Postcode + Bedroom2 + Bathroom + Car + Landsize + BuildingArea + YearBuilt + Propertycount , data = entrenamiento, ntree=500, mtry=3, importance=TRUE)
resultado_entrenamiento <- predict(rf,entrenamiento)
resultado_prueba <- predict(rf,prueba)
mae_rf <- mae(rf,prueba)
resultados <- tibble(Modelo = c("Arbol de decisión", "Bosque Aleatorio"), MAE = c(mae_arbol, mae_rf))
resultados## # A tibble: 2 × 2
## Modelo MAE
## <chr> <dbl>
## 1 Arbol de decisión 304432.
## 2 Bosque Aleatorio 173220.Ejercicio 1: Rendimiento Automotriz
Importar y entender la base de datos
df2 <- mtcars
summary(df2)## mpg cyl disp hp
## Min. :10.40 Min. :4.000 Min. : 71.1 Min. : 52.0
## 1st Qu.:15.43 1st Qu.:4.000 1st Qu.:120.8 1st Qu.: 96.5
## Median :19.20 Median :6.000 Median :196.3 Median :123.0
## Mean :20.09 Mean :6.188 Mean :230.7 Mean :146.7
## 3rd Qu.:22.80 3rd Qu.:8.000 3rd Qu.:326.0 3rd Qu.:180.0
## Max. :33.90 Max. :8.000 Max. :472.0 Max. :335.0
## drat wt qsec vs
## Min. :2.760 Min. :1.513 Min. :14.50 Min. :0.0000
## 1st Qu.:3.080 1st Qu.:2.581 1st Qu.:16.89 1st Qu.:0.0000
## Median :3.695 Median :3.325 Median :17.71 Median :0.0000
## Mean :3.597 Mean :3.217 Mean :17.85 Mean :0.4375
## 3rd Qu.:3.920 3rd Qu.:3.610 3rd Qu.:18.90 3rd Qu.:1.0000
## Max. :4.930 Max. :5.424 Max. :22.90 Max. :1.0000
## am gear carb
## Min. :0.0000 Min. :3.000 Min. :1.000
## 1st Qu.:0.0000 1st Qu.:3.000 1st Qu.:2.000
## Median :0.0000 Median :4.000 Median :2.000
## Mean :0.4062 Mean :3.688 Mean :2.812
## 3rd Qu.:1.0000 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :1.0000 Max. :5.000 Max. :8.000str(df2)## 'data.frame': 32 obs. of 11 variables:
## $ mpg : num 21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
## $ cyl : num 6 6 4 6 8 6 8 4 4 6 ...
## $ disp: num 160 160 108 258 360 ...
## $ hp : num 110 110 93 110 175 105 245 62 95 123 ...
## $ drat: num 3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
## $ wt : num 2.62 2.88 2.32 3.21 3.44 ...
## $ qsec: num 16.5 17 18.6 19.4 17 ...
## $ vs : num 0 0 1 1 0 1 0 1 1 1 ...
## $ am : num 1 1 1 0 0 0 0 0 0 0 ...
## $ gear: num 4 4 4 3 3 3 3 4 4 4 ...
## $ carb: num 4 4 1 1 2 1 4 2 2 4 ...df <- na.omit(df2)Arbol de Decisión
arbol2 <- rpart(mpg ~ cyl + disp + hp + drat + wt + qsec + gear + carb, data= df2)
plot(arbol2, uniform=TRUE)
text(arbol2, cex=0.4)
predict(arbol2,head(df2))## Mazda RX4 Mazda RX4 Wag Datsun 710 Hornet 4 Drive
## 18.26429 18.26429 26.66364 18.26429
## Hornet Sportabout Valiant
## 18.26429 18.26429head(df2$mpg)## [1] 21.0 21.0 22.8 21.4 18.7 18.1prueba_arbol2 <- head(df2)
mae_arbol2 <- mae(arbol2, prueba_arbol2) #MAE = Error Cuadrado promedioBosque Aleatorio
set.seed(123)
renglones_entrenamiento2 <- createDataPartition(df2$mpg, p=0.8, list=FALSE)
entrenamiento2 <- df2[renglones_entrenamiento2, ]
prueba2 <- df2[-renglones_entrenamiento2, ]
rf2 <- randomForest(mpg ~ cyl + disp + hp + drat + wt + qsec + gear + carb, data= entrenamiento2, ntree=500, mtry=3, importance=TRUE)
resultado_entrenamiento2 <- predict(rf2,entrenamiento2)
resultado_prueba2 <- predict(rf2,prueba2)
mae_rf2 <- mae(rf2,prueba2)
resultados2 <- tibble(Modelo = c("Arbol de decisión", "Bosque Aleatorio"), MAE = c(mae_arbol2, mae_rf2))
resultados2## # A tibble: 2 × 2
## Modelo MAE
## <chr> <dbl>
## 1 Arbol de decisión 2.18
## 2 Bosque Aleatorio 1.75LS0tCnRpdGxlOiAiQm9zcXVlcyBBbGVhdG9yaW9zIgphdXRob3I6ICJQYWJsbyBTYW5jaG8gQTAxNzIyMjM2IgpkYXRlOiAiMjAyNS0wOC0yNyIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUKICAgIHRoZW1lOiB1bml0ZWQKLS0tCgoKCiFbXShodHRwczovL2NvbnRlbnQucjljZG4ubmV0L3JpbWcvZGltZy9lNy9lMi9hMDkyZTkzYi1jaXR5LTEzOTk4LTE2NDFlYWJhOGEzLmpwZz93aWR0aD0xMjAwJmhlaWdodD02MzAmeGhpbnQ9MTAxNiZ5aGludD0xMDI0JmNyb3A9dHJ1ZSkKCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IFRlb3LDrWEgPC9zcGFuPiAKCkVsICpCb3NxdWUgQWxlYXRvcmlvKiBlcyB1biBhbGdvcml0bW8gZGUgYXByZW5kaXphamUgYXV0b21hdGljbyBxdWUgY29tYmluYSBlbCByZXN1bHRhZG8gZGUgbXVsdGlwbGVzIGFyYm9sZXMgZGUgZGVjaXNpb24gcGFyYSBsbGVnYXIgYSB1biByZXN1bHRhZG8gb3B0aW1vLgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEVqZW1wbG8gMS4gTWVsYm91cm5lIDwvc3Bhbj4gCgpFbiBlc3RhIGJhc2UgZGUgZGF0b3MgdGVuZW1vcyBsb3MgcHJlY2lvcyBkZSAxMywwMDAgY2FzYXMgZW4gbGEgY2l1ZGFkIGRlIE1lbGJvdXJuZToKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBJbnN0YWxhciBwYXF1ZXRlcyB5IGNhcmdhciBsaWJyZXJpYXMgPC9zcGFuPgpgYGB7cn0KI2luc3RhbGwucGFja2FnZXMoInRpZHl2ZXJzZSIpCmxpYnJhcnkodGlkeXZlcnNlKQojaW5zdGFsbC5wYWNrYWdlcygicnBhcnQiKQojaW5zdGFsbC5wYWNrYWdlcygicnBhcnQucGxvdCIpCmxpYnJhcnkocnBhcnQpCmxpYnJhcnkocnBhcnQucGxvdCkKI2luc3RhbGwucGFja2FnZXMoInJhbmRvbUZvcmVzdCIpCmxpYnJhcnkocmFuZG9tRm9yZXN0KQojaW5zdGFsbC5wYWNrYWdlcygibW9kZWxyIikgI0NhbGN1bGFyIGVycm9yZXMKbGlicmFyeShtb2RlbHIpCiNpbnN0YWxsLnBhY2thZ2VzKCJjYXJldCIpCmxpYnJhcnkoY2FyZXQpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEltcG9ydGFyIHkgZW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+CmBgYHtyfQpkZiA8LSByZWFkLmNzdigiL1VzZXJzL3BhYmxvc2FuY2hvL0Rlc2t0b3AvQ29uY2VudHJhY2lvzIFuL01vZHVsbyAyIENvbmNlbnRyYWNpb24gKFIpL21lbGJvdXJuZS5jc3YiKQoKc3VtbWFyeShkZikKc3RyKGRmKQpkZiA8LSBuYS5vbWl0KGRmKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBBcmJvbCBkZSBEZWNpc2nDs24gPC9zcGFuPgpgYGB7cn0KYXJib2wgPC0gcnBhcnQoUHJpY2UgfiBSb29tcyArIERpc3RhbmNlICsgUG9zdGNvZGUgKyBCZWRyb29tMiArIEJhdGhyb29tICsgQ2FyICsgTGFuZHNpemUgKyAgQnVpbGRpbmdBcmVhICsgWWVhckJ1aWx0ICsgUHJvcGVydHljb3VudCAsIGRhdGE9IGRmKQpwbG90KGFyYm9sLCB1bmlmb3JtPVRSVUUpCnRleHQoYXJib2wsIGNleD0wLjQpCgpwcmVkaWN0KGFyYm9sLGhlYWQoZGYpKQpoZWFkKGRmJFByaWNlKQpwcnVlYmFfYXJib2wgPC0gaGVhZChkZikKCm1hZV9hcmJvbCA8LSBtYWUoYXJib2wsIHBydWViYV9hcmJvbCkgI01BRSA9IEVycm9yIEN1YWRyYWRvIHByb21lZGlvCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEJvc3F1ZSBBbGVhdG9yaW8gPC9zcGFuPgpgYGB7cn0Kc2V0LnNlZWQoMTIzKQpyZW5nbG9uZXNfZW50cmVuYW1pZW50byA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKGRmJFByaWNlLCBwPTAuOCwgbGlzdD1GQUxTRSkKZW50cmVuYW1pZW50byA8LSBkZltyZW5nbG9uZXNfZW50cmVuYW1pZW50bywgXQpwcnVlYmEgPC0gZGZbLXJlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdCgpyZiA8LSByYW5kb21Gb3Jlc3QoUHJpY2UgfiBSb29tcyArIERpc3RhbmNlICsgUG9zdGNvZGUgKyBCZWRyb29tMiArIEJhdGhyb29tICsgQ2FyICsgTGFuZHNpemUgKyAgQnVpbGRpbmdBcmVhICsgWWVhckJ1aWx0ICsgUHJvcGVydHljb3VudCAsIGRhdGEgPSBlbnRyZW5hbWllbnRvLCBudHJlZT01MDAsIG10cnk9MywgaW1wb3J0YW5jZT1UUlVFKQoKcmVzdWx0YWRvX2VudHJlbmFtaWVudG8gPC0gcHJlZGljdChyZixlbnRyZW5hbWllbnRvKQpyZXN1bHRhZG9fcHJ1ZWJhIDwtIHByZWRpY3QocmYscHJ1ZWJhKQoKbWFlX3JmIDwtIG1hZShyZixwcnVlYmEpCgpyZXN1bHRhZG9zIDwtIHRpYmJsZShNb2RlbG8gPSBjKCJBcmJvbCBkZSBkZWNpc2nDs24iLCAiQm9zcXVlIEFsZWF0b3JpbyIpLCBNQUUgPSBjKG1hZV9hcmJvbCwgbWFlX3JmKSkKcmVzdWx0YWRvcwpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBFamVyY2ljaW8gMTogUmVuZGltaWVudG8gQXV0b21vdHJpeiA8L3NwYW4+CgojIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gSW1wb3J0YXIgeSBlbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmRmMiA8LSBtdGNhcnMKCnN1bW1hcnkoZGYyKQpzdHIoZGYyKQpkZiA8LSBuYS5vbWl0KGRmMikKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gQXJib2wgZGUgRGVjaXNpw7NuIDwvc3Bhbj4KYGBge3J9CmFyYm9sMiA8LSBycGFydChtcGcgfiBjeWwgKyBkaXNwICsgaHAgKyBkcmF0ICsgd3QgKyBxc2VjICsgZ2VhciArIGNhcmIsIGRhdGE9IGRmMikKcGxvdChhcmJvbDIsIHVuaWZvcm09VFJVRSkKdGV4dChhcmJvbDIsIGNleD0wLjQpCgpwcmVkaWN0KGFyYm9sMixoZWFkKGRmMikpCmhlYWQoZGYyJG1wZykKcHJ1ZWJhX2FyYm9sMiA8LSBoZWFkKGRmMikKCm1hZV9hcmJvbDIgPC0gbWFlKGFyYm9sMiwgcHJ1ZWJhX2FyYm9sMikgI01BRSA9IEVycm9yIEN1YWRyYWRvIHByb21lZGlvCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEJvc3F1ZSBBbGVhdG9yaW8gPC9zcGFuPgpgYGB7cn0Kc2V0LnNlZWQoMTIzKQpyZW5nbG9uZXNfZW50cmVuYW1pZW50bzIgPC0gY3JlYXRlRGF0YVBhcnRpdGlvbihkZjIkbXBnLCBwPTAuOCwgbGlzdD1GQUxTRSkKZW50cmVuYW1pZW50bzIgPC0gZGYyW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvMiwgXQpwcnVlYmEyIDwtIGRmMlstcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8yLCBdCgpyZjIgPC0gcmFuZG9tRm9yZXN0KG1wZyB+IGN5bCArIGRpc3AgKyBocCArIGRyYXQgKyB3dCArIHFzZWMgKyBnZWFyICsgY2FyYiwgZGF0YT0gZW50cmVuYW1pZW50bzIsIG50cmVlPTUwMCwgbXRyeT0zLCBpbXBvcnRhbmNlPVRSVUUpCgpyZXN1bHRhZG9fZW50cmVuYW1pZW50bzIgPC0gcHJlZGljdChyZjIsZW50cmVuYW1pZW50bzIpCnJlc3VsdGFkb19wcnVlYmEyIDwtIHByZWRpY3QocmYyLHBydWViYTIpCgptYWVfcmYyIDwtIG1hZShyZjIscHJ1ZWJhMikKCnJlc3VsdGFkb3MyIDwtIHRpYmJsZShNb2RlbG8gPSBjKCJBcmJvbCBkZSBkZWNpc2nDs24iLCAiQm9zcXVlIEFsZWF0b3JpbyIpLCBNQUUgPSBjKG1hZV9hcmJvbDIsIG1hZV9yZjIpKQpyZXN1bHRhZG9zMgpgYGAK