Construir y evaluar un modelo de árbol regresión para prediccion de rendimiento de frijol y comparar contra un modelo de regresión múltiple.
Se cargan datos simulados de rendimiento de frijol
Las variables indendientes son:
Algunas variables son numéricas y otras categ´rocas pero la variabole a predecir es numérica por eso usamos un modelo de regresión para las predicciones numéricas.
Se va evaluar el modelo con R Square ajustado para ver que tanto representan las variables independientes al rendimiento del frijol.
Se va a calcualr el RMSE para comaprarlo con otro modelo de regresión como árboles de regresión.
Las librerías rpart y rpart.plot se tienen que instalar en R Studio para que funciones el ejercicio ya que son lobrerías para modelos de árboles de regresión.
library(readr)
library(ggplot2)
# Librerías nuevas
library(rpart)
library(rpart.plot) # Para visualizar el árbol
Se cargan datos ya están limpios
datos_entrenamiento <- read.csv("https://raw.githubusercontent.com/rpizarrog/Ciencia-de-los-Datos-Descriptivo-Predictivo/refs/heads/main/datos/rendimiento_frijol_train.csv", stringsAsFactors = TRUE)
datos_validacion <- read.csv("https://raw.githubusercontent.com/rpizarrog/Ciencia-de-los-Datos-Descriptivo-Predictivo/refs/heads/main/datos/rendimiento_frijol_val.csv", stringsAsFactors = TRUE)
print("Datos de entrenamiento")
## [1] "Datos de entrenamiento"
head(datos_entrenamiento)
## Rendimiento_Frijol Tipo_Suelo Precipitacion_mm Fertilizacion_kg
## 1 1302 Limoso 237 65
## 2 1635 Arcilloso 293 63
## 3 1470 Limoso 294 66
## 4 1306 Arenoso 268 57
## 5 1271 Arenoso 435 57
## 6 1900 Arenoso 336 53
## Temperatura_Promedio_C Variedad_Frijol
## 1 21.7 Negro
## 2 22.0 Negro
## 3 25.0 Negro
## 4 21.9 Negro
## 5 22.5 Pinto
## 6 20.4 Negro
summary(datos_entrenamiento)
## Rendimiento_Frijol Tipo_Suelo Precipitacion_mm Fertilizacion_kg
## Min. :1201 Arcilloso:157 Min. :200.0 Min. :40.00
## 1st Qu.:1395 Arenoso :184 1st Qu.:274.0 1st Qu.:47.00
## Median :1602 Limoso :159 Median :348.0 Median :54.00
## Mean :1605 Mean :349.3 Mean :54.66
## 3rd Qu.:1823 3rd Qu.:425.0 3rd Qu.:62.00
## Max. :1999 Max. :498.0 Max. :69.00
## Temperatura_Promedio_C Variedad_Frijol
## Min. :18.00 Negro:178
## 1st Qu.:20.48 Pinto:157
## Median :23.10 Rojo :165
## Mean :22.96
## 3rd Qu.:25.40
## Max. :28.00
str(datos_entrenamiento)
## 'data.frame': 500 obs. of 6 variables:
## $ Rendimiento_Frijol : int 1302 1635 1470 1306 1271 1900 1220 1814 1321 1666 ...
## $ Tipo_Suelo : Factor w/ 3 levels "Arcilloso","Arenoso",..: 3 1 3 2 2 2 3 3 2 3 ...
## $ Precipitacion_mm : int 237 293 294 268 435 336 275 234 200 495 ...
## $ Fertilizacion_kg : int 65 63 66 57 57 53 54 68 51 43 ...
## $ Temperatura_Promedio_C: num 21.7 22 25 21.9 22.5 20.4 21.7 20.3 18.7 24 ...
## $ Variedad_Frijol : Factor w/ 3 levels "Negro","Pinto",..: 1 1 1 1 2 1 3 2 1 3 ...
print ("Datos de validación")
## [1] "Datos de validación"
head(datos_validacion)
## Rendimiento_Frijol Tipo_Suelo Precipitacion_mm Fertilizacion_kg
## 1 1903 Arcilloso 258 58
## 2 1646 Arcilloso 368 55
## 3 1780 Arenoso 468 53
## 4 1989 Arcilloso 244 60
## 5 1446 Arcilloso 380 55
## 6 1275 Limoso 369 44
## Temperatura_Promedio_C Variedad_Frijol
## 1 18.8 Pinto
## 2 25.3 Negro
## 3 23.0 Pinto
## 4 22.4 Rojo
## 5 25.3 Pinto
## 6 25.7 Rojo
summary(datos_validacion)
## Rendimiento_Frijol Tipo_Suelo Precipitacion_mm Fertilizacion_kg
## Min. :1215 Arcilloso:20 Min. :206.0 Min. :40.00
## 1st Qu.:1418 Arenoso :17 1st Qu.:244.2 1st Qu.:45.25
## Median :1632 Limoso :13 Median :360.5 Median :52.00
## Mean :1613 Mean :339.7 Mean :52.80
## 3rd Qu.:1844 3rd Qu.:420.2 3rd Qu.:59.50
## Max. :1991 Max. :494.0 Max. :69.00
## Temperatura_Promedio_C Variedad_Frijol
## Min. :18.20 Negro:15
## 1st Qu.:20.50 Pinto:15
## Median :22.75 Rojo :20
## Mean :22.81
## 3rd Qu.:25.30
## Max. :27.80
str(datos_validacion)
## 'data.frame': 50 obs. of 6 variables:
## $ Rendimiento_Frijol : int 1903 1646 1780 1989 1446 1275 1353 1855 1634 1285 ...
## $ Tipo_Suelo : Factor w/ 3 levels "Arcilloso","Arenoso",..: 1 1 2 1 1 3 1 2 1 3 ...
## $ Precipitacion_mm : int 258 368 468 244 380 369 390 354 387 206 ...
## $ Fertilizacion_kg : int 58 55 53 60 55 44 48 65 69 67 ...
## $ Temperatura_Promedio_C: num 18.8 25.3 23 22.4 25.3 25.7 19.6 24.1 19.4 25.5 ...
## $ Variedad_Frijol : Factor w/ 3 levels "Negro","Pinto",..: 2 1 2 3 2 3 1 3 1 1 ...
La instrucción lm(formula = Rendimiento_Frijol ~ ., datos.entrenamiento) significa que la variabloe dependiente se llama Rendimiento_Frijol y se ve afectada o relacionadas con todas las variables independiente del conjunto de datos.
modelo_ar <- rpart(Rendimiento_Frijol ~ .,
data = datos_entrenamiento,
method = "anova") # 'anova' se usa para árboles de regresión
summary(modelo_ar)
## Call:
## rpart(formula = Rendimiento_Frijol ~ ., data = datos_entrenamiento,
## method = "anova")
## n= 500
##
## CP nsplit rel error xerror xstd
## 1 0.02157249 0 1.0000000 1.002914 0.03894040
## 2 0.01777244 1 0.9784275 1.043455 0.04289061
## 3 0.01647027 2 0.9606551 1.048871 0.04611783
## 4 0.01249882 6 0.8947740 1.050023 0.04926004
## 5 0.01245059 7 0.8822752 1.077706 0.05253338
## 6 0.01032410 9 0.8573740 1.098029 0.05433044
## 7 0.01000000 11 0.8367258 1.122395 0.05757439
##
## Variable importance
## Temperatura_Promedio_C Fertilizacion_kg Precipitacion_mm
## 32 22 21
## Variedad_Frijol Tipo_Suelo
## 15 10
##
## Node number 1: 500 observations, complexity param=0.02157249
## mean=1605.196, MSE=55517.76
## left son=2 (72 obs) right son=3 (428 obs)
## Primary splits:
## Temperatura_Promedio_C < 19.35 to the left, improve=0.021572490, (0 missing)
## Tipo_Suelo splits as LLR, improve=0.012421850, (0 missing)
## Precipitacion_mm < 320 to the left, improve=0.005978845, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.005129916, (0 missing)
## Fertilizacion_kg < 41.5 to the right, improve=0.002805344, (0 missing)
##
## Node number 2: 72 observations, complexity param=0.01249882
## mean=1520.819, MSE=52599.54
## left son=4 (47 obs) right son=5 (25 obs)
## Primary splits:
## Variedad_Frijol splits as LLR, improve=0.091612910, (0 missing)
## Temperatura_Promedio_C < 19.15 to the right, improve=0.024918610, (0 missing)
## Precipitacion_mm < 312.5 to the right, improve=0.019908290, (0 missing)
## Fertilizacion_kg < 54.5 to the right, improve=0.019555590, (0 missing)
## Tipo_Suelo splits as RRL, improve=0.004612426, (0 missing)
## Surrogate splits:
## Fertilizacion_kg < 40.5 to the right, agree=0.667, adj=0.04, (0 split)
## Temperatura_Promedio_C < 18.15 to the right, agree=0.667, adj=0.04, (0 split)
##
## Node number 3: 428 observations, complexity param=0.01777244
## mean=1619.39, MSE=54609.55
## left son=6 (293 obs) right son=7 (135 obs)
## Primary splits:
## Tipo_Suelo splits as LLR, improve=0.021107490, (0 missing)
## Precipitacion_mm < 320 to the left, improve=0.013892850, (0 missing)
## Temperatura_Promedio_C < 23.05 to the right, improve=0.012640970, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.008709155, (0 missing)
## Fertilizacion_kg < 67.5 to the left, improve=0.004449009, (0 missing)
## Surrogate splits:
## Temperatura_Promedio_C < 27.95 to the left, agree=0.692, adj=0.022, (0 split)
## Precipitacion_mm < 493.5 to the left, agree=0.689, adj=0.015, (0 split)
##
## Node number 4: 47 observations
## mean=1470.191, MSE=39715.77
##
## Node number 5: 25 observations
## mean=1616, MSE=62942.88
##
## Node number 6: 293 observations, complexity param=0.01647027
## mean=1596.345, MSE=53240.9
## left son=12 (200 obs) right son=13 (93 obs)
## Primary splits:
## Temperatura_Promedio_C < 22.45 to the right, improve=0.022506030, (0 missing)
## Precipitacion_mm < 309 to the left, improve=0.014023420, (0 missing)
## Fertilizacion_kg < 62.5 to the left, improve=0.010554820, (0 missing)
## Variedad_Frijol splits as RRL, improve=0.009563689, (0 missing)
## Tipo_Suelo splits as LR-, improve=0.002471740, (0 missing)
##
## Node number 7: 135 observations, complexity param=0.0103241
## mean=1669.407, MSE=53925.62
## left son=14 (23 obs) right son=15 (112 obs)
## Primary splits:
## Fertilizacion_kg < 64.5 to the right, improve=0.02735569, (0 missing)
## Precipitacion_mm < 226 to the right, improve=0.02415159, (0 missing)
## Temperatura_Promedio_C < 23.45 to the right, improve=0.02217577, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.01594291, (0 missing)
##
## Node number 12: 200 observations, complexity param=0.01647027
## mean=1572.74, MSE=50221.26
## left son=24 (122 obs) right son=25 (78 obs)
## Primary splits:
## Temperatura_Promedio_C < 25.75 to the left, improve=4.562026e-02, (0 missing)
## Precipitacion_mm < 332 to the left, improve=2.197579e-02, (0 missing)
## Fertilizacion_kg < 43.5 to the right, improve=1.519843e-02, (0 missing)
## Variedad_Frijol splits as RRL, improve=7.416705e-03, (0 missing)
## Tipo_Suelo splits as LR-, improve=4.557127e-06, (0 missing)
## Surrogate splits:
## Precipitacion_mm < 207.5 to the right, agree=0.635, adj=0.064, (0 split)
##
## Node number 13: 93 observations, complexity param=0.01647027
## mean=1647.108, MSE=55959.64
## left son=26 (84 obs) right son=27 (9 obs)
## Primary splits:
## Fertilizacion_kg < 65.5 to the left, improve=0.10583950, (0 missing)
## Temperatura_Promedio_C < 20.55 to the left, improve=0.05451017, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.03334101, (0 missing)
## Tipo_Suelo splits as LR-, improve=0.02093518, (0 missing)
## Precipitacion_mm < 237.5 to the right, improve=0.01797200, (0 missing)
## Surrogate splits:
## Precipitacion_mm < 477.5 to the left, agree=0.914, adj=0.111, (0 split)
##
## Node number 14: 23 observations, complexity param=0.0103241
## mean=1584.652, MSE=65535.79
## left son=28 (7 obs) right son=29 (16 obs)
## Primary splits:
## Precipitacion_mm < 427 to the right, improve=0.2481368, (0 missing)
## Fertilizacion_kg < 67.5 to the left, improve=0.2205181, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.1369471, (0 missing)
## Temperatura_Promedio_C < 24.8 to the right, improve=0.0693734, (0 missing)
## Surrogate splits:
## Temperatura_Promedio_C < 25.5 to the right, agree=0.783, adj=0.286, (0 split)
##
## Node number 15: 112 observations
## mean=1686.812, MSE=49763.28
##
## Node number 24: 122 observations, complexity param=0.01245059
## mean=1534.467, MSE=43802.74
## left son=48 (64 obs) right son=49 (58 obs)
## Primary splits:
## Fertilizacion_kg < 54.5 to the right, improve=0.05792375, (0 missing)
## Temperatura_Promedio_C < 24.65 to the right, improve=0.03990487, (0 missing)
## Precipitacion_mm < 374 to the left, improve=0.02704762, (0 missing)
## Variedad_Frijol splits as LRL, improve=0.02351523, (0 missing)
## Tipo_Suelo splits as LR-, improve=0.00185469, (0 missing)
## Surrogate splits:
## Precipitacion_mm < 348.5 to the left, agree=0.615, adj=0.190, (0 split)
## Temperatura_Promedio_C < 24.65 to the right, agree=0.590, adj=0.138, (0 split)
## Tipo_Suelo splits as RL-, agree=0.549, adj=0.052, (0 split)
## Variedad_Frijol splits as LLR, agree=0.549, adj=0.052, (0 split)
##
## Node number 25: 78 observations, complexity param=0.01647027
## mean=1632.603, MSE=54385.85
## left son=50 (20 obs) right son=51 (58 obs)
## Primary splits:
## Precipitacion_mm < 252 to the left, improve=0.110479300, (0 missing)
## Temperatura_Promedio_C < 26.75 to the right, improve=0.049605820, (0 missing)
## Fertilizacion_kg < 43.5 to the right, improve=0.043748370, (0 missing)
## Variedad_Frijol splits as RLL, improve=0.025744310, (0 missing)
## Tipo_Suelo splits as RL-, improve=0.006191105, (0 missing)
##
## Node number 26: 84 observations
## mean=1621.917, MSE=54588.91
##
## Node number 27: 9 observations
## mean=1882.222, MSE=7551.506
##
## Node number 28: 7 observations
## mean=1391.857, MSE=33002.12
##
## Node number 29: 16 observations
## mean=1669, MSE=56392.88
##
## Node number 48: 64 observations
## mean=1486.516, MSE=39244.19
##
## Node number 49: 58 observations, complexity param=0.01245059
## mean=1587.379, MSE=43495.96
## left son=98 (42 obs) right son=99 (16 obs)
## Primary splits:
## Variedad_Frijol splits as LRL, improve=0.151297500, (0 missing)
## Precipitacion_mm < 388 to the left, improve=0.079590650, (0 missing)
## Fertilizacion_kg < 52.5 to the left, improve=0.022949950, (0 missing)
## Temperatura_Promedio_C < 24.7 to the right, improve=0.018997900, (0 missing)
## Tipo_Suelo splits as LR-, improve=0.007992253, (0 missing)
## Surrogate splits:
## Precipitacion_mm < 486 to the left, agree=0.741, adj=0.063, (0 split)
##
## Node number 50: 20 observations
## mean=1500.6, MSE=44767.54
##
## Node number 51: 58 observations
## mean=1678.121, MSE=49622.11
##
## Node number 98: 42 observations
## mean=1537.31, MSE=37160.45
##
## Node number 99: 16 observations
## mean=1718.812, MSE=36271.15
Se va a analizar y predecir valores con el modelo_ar.
predicciones <- predict(modelo_ar, datos_validacion)
predicciones
## 1 2 3 4 5 6 7 8
## 1470.191 1486.516 1718.812 1621.917 1486.516 1686.812 1621.917 1486.516
## 9 10 11 12 13 14 15 16
## 1882.222 1669.000 1686.812 1678.121 1470.191 1470.191 1621.917 1621.917
## 17 18 19 20 21 22 23 24
## 1621.917 1678.121 1686.812 1621.917 1486.516 1686.812 1678.121 1470.191
## 25 26 27 28 29 30 31 32
## 1718.812 1470.191 1616.000 1500.600 1686.812 1686.812 1621.917 1686.812
## 33 34 35 36 37 38 39 40
## 1686.812 1616.000 1486.516 1678.121 1718.812 1678.121 1616.000 1621.917
## 41 42 43 44 45 46 47 48
## 1621.917 1537.310 1678.121 1882.222 1686.812 1621.917 1486.516 1486.516
## 49 50
## 1678.121 1686.812
datos_comparar <- data.frame(reales = datos_validacion$Rendimiento_Frijol, predicciones)
datos_comparar
## reales predicciones
## 1 1903 1470.191
## 2 1646 1486.516
## 3 1780 1718.812
## 4 1989 1621.917
## 5 1446 1486.516
## 6 1275 1686.812
## 7 1353 1621.917
## 8 1855 1486.516
## 9 1634 1882.222
## 10 1285 1669.000
## 11 1896 1686.812
## 12 1484 1678.121
## 13 1419 1470.191
## 14 1268 1470.191
## 15 1246 1621.917
## 16 1293 1621.917
## 17 1949 1621.917
## 18 1652 1678.121
## 19 1403 1686.812
## 20 1417 1621.917
## 21 1673 1486.516
## 22 1631 1686.812
## 23 1540 1678.121
## 24 1750 1470.191
## 25 1811 1718.812
## 26 1488 1470.191
## 27 1453 1616.000
## 28 1933 1500.600
## 29 1556 1686.812
## 30 1222 1686.812
## 31 1961 1621.917
## 32 1721 1686.812
## 33 1957 1686.812
## 34 1299 1616.000
## 35 1379 1486.516
## 36 1422 1678.121
## 37 1961 1718.812
## 38 1858 1678.121
## 39 1641 1616.000
## 40 1807 1621.917
## 41 1968 1621.917
## 42 1524 1537.310
## 43 1715 1678.121
## 44 1215 1882.222
## 45 1991 1686.812
## 46 1535 1621.917
## 47 1958 1486.516
## 48 1457 1486.516
## 49 1696 1678.121
## 50 1359 1686.812
Hay distintas alternativas para visualziar el árbol, aquí una de ellas.
# Dibujar el árbol
plot(modelo_ar, uniform=TRUE, main="Árbol de Regresión para Rendimiento de Frijol")
text(modelo_ar, use.n=TRUE, all=TRUE, cex=0.8)
# Dibujar el árbol
rpart.plot(modelo_ar, type=3, extra=101, main="Árbol de Regresión para Rendimiento de Frijol")
# Cálculo manual del RMSE
rmse <- sqrt(mean((datos_comparar$reales - datos_comparar$predicciones)^2))
# Imprimir resultado
paste ("RMSE:", rmse)
## [1] "RMSE: 269.269225954773"
El modelo del árbol de regresión tiene un valor de RMSE aproximado a 260.
Al final comparado con otro modelo como regresión mútiple https://rpubs.com/rpizarro/1263682 este modelo resulta tener un mayor valor en RMSE por lo que se concluye que el mejor modelo para estos datos es el modelo de regresión múltiplr ya que tiene un valor de RMSE de aproximadamente 250.