Bosque aleatorio
Ana Gonzalez a00835512
2025-08-27
TeorĆa
El Bosque Aleatorio es un algoritmo de aprendizaje automĆ”tico que combina el resultado de mĆŗltiples Ć”rboles de decisiĆ³n para llegar a un resultado Ć³ptimo.
Ejemplo 1.Melborne
En esta base de datos tenemos los precios de mƔs 13,000 cadad de la ciudad de Melborne.
Instalar paquetes y llamar lbrerĆas
#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")
library(rpart)
#install.packages("rpart.plot")
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")
library(modelr)
#install.packages("caret")
library(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftInstalar la base de datos
df <- read_csv("C:/Users/anama/Downloads/melbourne.csv")## Rows: 13580 Columns: 21
## āā Column specification āāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāā
## Delimiter: ","
## chr (8): Suburb, Address, Type, Method, SellerG, Date, CouncilArea, Regionname
## dbl (13): Rooms, Price, Distance, Postcode, Bedroom2, Bathroom, Car, Landsiz...
##
## ā¹ Use `spec()` to retrieve the full column specification for this data.
## ā¹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Entender la base de datos
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)## spc_tbl_ [13,580 Ć 21] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Suburb : chr [1:13580] "Abbotsford" "Abbotsford" "Abbotsford" "Abbotsford" ...
## $ Address : chr [1:13580] "85 Turner St" "25 Bloomburg St" "5 Charles St" "40 Federation La" ...
## $ Rooms : num [1:13580] 2 2 3 3 4 2 3 2 1 2 ...
## $ Type : chr [1:13580] "h" "h" "h" "h" ...
## $ Price : num [1:13580] 1480000 1035000 1465000 850000 1600000 ...
## $ Method : chr [1:13580] "S" "S" "SP" "PI" ...
## $ SellerG : chr [1:13580] "Biggin" "Biggin" "Biggin" "Biggin" ...
## $ Date : chr [1:13580] "3/12/2016" "4/02/2016" "4/03/2017" "4/03/2017" ...
## $ Distance : num [1:13580] 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 ...
## $ Postcode : num [1:13580] 3067 3067 3067 3067 3067 ...
## $ Bedroom2 : num [1:13580] 2 2 3 3 3 2 4 2 1 3 ...
## $ Bathroom : num [1:13580] 1 1 2 2 1 1 2 1 1 1 ...
## $ Car : num [1:13580] 1 0 0 1 2 0 0 2 1 2 ...
## $ Landsize : num [1:13580] 202 156 134 94 120 181 245 256 0 220 ...
## $ BuildingArea : num [1:13580] NA 79 150 NA 142 NA 210 107 NA 75 ...
## $ YearBuilt : num [1:13580] NA 1900 1900 NA 2014 ...
## $ CouncilArea : chr [1:13580] "Yarra" "Yarra" "Yarra" "Yarra" ...
## $ Lattitude : num [1:13580] -37.8 -37.8 -37.8 -37.8 -37.8 ...
## $ Longtitude : num [1:13580] 145 145 145 145 145 ...
## $ Regionname : chr [1:13580] "Northern Metropolitan" "Northern Metropolitan" "Northern Metropolitan" "Northern Metropolitan" ...
## $ Propertycount: num [1:13580] 4019 4019 4019 4019 4019 ...
## - attr(*, "spec")=
## .. cols(
## .. Suburb = col_character(),
## .. Address = col_character(),
## .. Rooms = col_double(),
## .. Type = col_character(),
## .. Price = col_double(),
## .. Method = col_character(),
## .. SellerG = col_character(),
## .. Date = col_character(),
## .. Distance = col_double(),
## .. Postcode = col_double(),
## .. Bedroom2 = col_double(),
## .. Bathroom = col_double(),
## .. Car = col_double(),
## .. Landsize = col_double(),
## .. BuildingArea = col_double(),
## .. YearBuilt = col_double(),
## .. CouncilArea = col_character(),
## .. Lattitude = col_double(),
## .. Longtitude = col_double(),
## .. Regionname = col_character(),
## .. Propertycount = col_double()
## .. )
## - attr(*, "problems")=<externalptr>df <- na.omit(df)Arbol de decisiĆ³n
arbol <- rpart(Price ~ Rooms + Distance + Bedroom2 + Bathroom + Car + Landsize + BuildingArea + Propertycount, data= df)
plot(arbol, uniform=TRUE)
text(arbol, cex=.5)
predict(arbol,head(df))## 1 2 3 4 5 6
## 791092.6 1109870.5 1109870.5 1929237.4 1109870.5 541873.9head(df$Price)## [1] 1035000 1465000 1600000 1876000 1636000 1097000prueba_arbol <- head(df)
# MAE: Error cuadrado promedio (Ventaja: Mismas Unidades)
mae_arbol <- mae(arbol, prueba_arbol)Arbol de decisiĆ³n
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 + Bedroom2 + Bathroom + Car + Landsize + BuildingArea + 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 ("Ćrbol de DecisiĆ³n", "Bosque Aleatorio"), MAE = c(mae_arbol, mae_rf))
resultados## # A tibble: 2 Ć 2
## Modelo MAE
## <chr> <dbl>
## 1 Ćrbol de DecisiĆ³n 370610.
## 2 Bosque Aleatorio 226836.Ejemplo 2. Rendimiento automotriz
Cargar la base de datos
df2 <- mtcarsEntender la base de datos
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 ...df2 <- na.omit(df2)Ćrbol de decisiĆ³n
rpart.plot(arbol, type = 2, extra = 101)
LS0tDQp0aXRsZTogIkJvc3F1ZSBhbGVhdG9yaW8iDQphdXRob3I6ICJBbmEgR29uemFsZXogYTAwODM1NTEyIg0KZGF0ZTogIjIwMjUtMDgtMjciDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogeWV0aQ0KLS0tDQohW10oaHR0cHM6Ly82NC5tZWRpYS50dW1ibHIuY29tLzIwMzhkMGMyMTE1YzMxYjUwMjc4M2Y1OTllOTU1ZjFmL3R1bWJscl9pbmxpbmVfcGswbmVhWWY4SzFxYTdsYW5fMTI4MC5naWYpDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5UZW9yw61hIDwvc3Bhbj4NCg0KRWwgKkJvc3F1ZSBBbGVhdG9yaW8qIGVzIHVuIGFsZ29yaXRtbyBkZSBhcHJlbmRpemFqZSBhdXRvbcOhdGljbyBxdWUgY29tYmluYSBlbCByZXN1bHRhZG8gZGUgbcO6bHRpcGxlcyDDoXJib2xlcyBkZSBkZWNpc2nDs24gcGFyYSBsbGVnYXIgYSB1biByZXN1bHRhZG8gw7NwdGltby4NCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6cmVkIDsiPkVqZW1wbG8gMS5NZWxib3JuZSA8L3NwYW4+DQoNCkVuIGVzdGEgYmFzZSBkZSBkYXRvcyB0ZW5lbW9zIGxvcyBwcmVjaW9zIGRlIG3DoXMgMTMsMDAwIGNhZGFkIGRlIGxhIGNpdWRhZCBkZSBNZWxib3JuZS4NCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPkluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxicmVyw61hcyA8L3NwYW4+DQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJ0aWR5dmVyc2UiKQ0KbGlicmFyeSh0aWR5dmVyc2UpDQojaW5zdGFsbC5wYWNrYWdlcygicnBhcnQiKQ0KbGlicmFyeShycGFydCkNCiNpbnN0YWxsLnBhY2thZ2VzKCJycGFydC5wbG90IikNCmxpYnJhcnkocnBhcnQucGxvdCkNCiNpbnN0YWxsLnBhY2thZ2VzKCJyYW5kb21Gb3Jlc3QiKQ0KbGlicmFyeShyYW5kb21Gb3Jlc3QpDQojaW5zdGFsbC5wYWNrYWdlcygibW9kZWxyIikNCmxpYnJhcnkobW9kZWxyKQ0KI2luc3RhbGwucGFja2FnZXMoImNhcmV0IikNCmxpYnJhcnkoY2FyZXQpDQpgYGANCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5JbnN0YWxhciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4NCmBgYHtyfQ0KZGYgPC0gcmVhZF9jc3YoIkM6L1VzZXJzL2FuYW1hL0Rvd25sb2Fkcy9tZWxib3VybmUuY3N2IikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+RW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+DQpgYGB7cn0NCnN1bW1hcnkoZGYpDQpzdHIoZGYpDQpkZiA8LSBuYS5vbWl0KGRmKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+QXJib2wgZGUgZGVjaXNpw7NuIDwvc3Bhbj4NCmBgYHtyfQ0KYXJib2wgPC0gcnBhcnQoUHJpY2UgfiBSb29tcyArIERpc3RhbmNlICsgQmVkcm9vbTIgKyBCYXRocm9vbSArIENhciArIExhbmRzaXplICsgQnVpbGRpbmdBcmVhICsgUHJvcGVydHljb3VudCwgZGF0YT0gZGYpDQpwbG90KGFyYm9sLCB1bmlmb3JtPVRSVUUpDQp0ZXh0KGFyYm9sLCBjZXg9LjUpDQoNCnByZWRpY3QoYXJib2wsaGVhZChkZikpDQpoZWFkKGRmJFByaWNlKQ0KcHJ1ZWJhX2FyYm9sIDwtIGhlYWQoZGYpDQoNCiMgTUFFOiBFcnJvciBjdWFkcmFkbyBwcm9tZWRpbyAoVmVudGFqYTogTWlzbWFzIFVuaWRhZGVzKQ0KbWFlX2FyYm9sIDwtIG1hZShhcmJvbCwgcHJ1ZWJhX2FyYm9sKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5BcmJvbCBkZSBkZWNpc2nDs24gPC9zcGFuPg0KYGBge3J9DQpzZXQuc2VlZCgxMjMpDQpyZW5nbG9uZXNfZW50cmVuYW1pZW50byA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKGRmJFByaWNlLCBwPTAuOCwgbGlzdD1GQUxTRSkNCmVudHJlbmFtaWVudG8gPC0gZGZbcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0NCnBydWViYSA8LSBkZlstcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0NCg0KcmYgPC0gcmFuZG9tRm9yZXN0KFByaWNlIH4gUm9vbXMgKyBEaXN0YW5jZSArIEJlZHJvb20yICsgQmF0aHJvb20gKyBDYXIgKyBMYW5kc2l6ZSArIEJ1aWxkaW5nQXJlYSArIFByb3BlcnR5Y291bnQsIGRhdGE9IGVudHJlbmFtaWVudG8sIG50cmVlPSA1MDAsIG10cnk9IDMsIGltcG9ydGFuY2U9VFJVRSkNCg0KcmVzdWx0YWRvX2VudHJlbmFtaWVudG8gPC0gcHJlZGljdChyZiwgZW50cmVuYW1pZW50bykNCnJlc3VsdGFkb19wcnVlYmEgPC0gcHJlZGljdCAocmYsIHBydWViYSkNCg0KbWFlX3JmIDwtIG1hZShyZiwgcHJ1ZWJhKQ0KcmVzdWx0YWRvcyA8LSB0aWJibGUoTW9kZWxvID1jICgiw4FyYm9sIGRlIERlY2lzacOzbiIsICJCb3NxdWUgQWxlYXRvcmlvIiksIE1BRSA9IGMobWFlX2FyYm9sLCBtYWVfcmYpKQ0KcmVzdWx0YWRvcw0KYGBgDQoNCg0KDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnJlZDsiPkVqZW1wbG8gMi4gUmVuZGltaWVudG8gYXV0b21vdHJpeiA8L3NwYW4+DQoNCg0KIVtdKGh0dHBzOi8vaS5waW5pbWcuY29tL29yaWdpbmFscy80Ny83NS9lNi80Nzc1ZTY4ZDg0MmZiZDIzNjhlMGI3YjVlYzE1MjlmMC5naWYpDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5DYXJnYXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+DQoNCmBgYHtyfQ0KZGYyIDwtIG10Y2Fycw0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5FbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4NCmBgYHtyfQ0Kc3VtbWFyeShkZjIpDQpzdHIoZGYyKQ0KZGYyIDwtIG5hLm9taXQoZGYyKQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij7DgXJib2wgZGUgZGVjaXNpw7NuIDwvc3Bhbj4NCg0KYGBge3J9DQpycGFydC5wbG90KGFyYm9sLCB0eXBlID0gMiwgZXh0cmEgPSAxMDEpDQpgYGANCg0K