Objetivo

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.

Descripción

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.

Cargar librerías

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

cargar datos

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)

Análisis descriptivo

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 ...

Construir un modelo de regresion múltiple

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.

Predecir con datos de validación

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

Construir datos a comparar

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

Visualizar árbol de regresión

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")

Evaluar el modelo

# Cálculo manual del RMSE
rmse <- sqrt(mean((datos_comparar$reales - datos_comparar$predicciones)^2))

# Imprimir resultado
paste ("RMSE:", rmse)
## [1] "RMSE: 269.269225954773"

Interpretación

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.