Cargar librerías

library(rpart)
library(rpart.plot)
library(caret)
library(tidyverse)
library(lattice)

Crear un Data Frame con estatura del padre, la madre y el género del hijo

set.seed(123)
altura.padre <- round(rnorm(400, mean=168, sd=5),1)
altura.madre <- round(rnorm(400,mean = 150, sd=2.8),1)
sexo.hijo <-  factor(rbinom(400,1,0.5), levels = c(0,1), labels = c("Male", "Female"))
hist(altura.madre)

Agrupo las variable en un Dataframe con las variables de Decision

t.alturas <- data_frame(altura.padre,altura.madre,sexo.hijo)
## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## ℹ Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
knitr::kable(head(t.alturas))
altura.padre altura.madre sexo.hijo
165.2 149.8 Female
166.8 146.7 Male
175.8 148.2 Male
168.4 149.9 Female
168.6 151.9 Female
176.6 145.4 Male

Calcular la altura de los hijos

set.seed(123)
altura.hijo <- ifelse(t.alturas$sexo.hijo == "Male",
                      (t.alturas$altura.padre+t.alturas$altura.madre)*rnorm(1,1,0.03)/2, (t.alturas$altura.padre+t.alturas$altura.madre)*rnorm(1,1,0.2)/2)

t.alturas$altura.hijo <-  round(altura.hijo,1)
knitr::kable(head(t.alturas))
altura.padre altura.madre sexo.hijo altura.hijo
165.2 149.8 Female 150.2
166.8 146.7 Male 154.1
175.8 148.2 Male 159.3
168.4 149.9 Female 151.8
168.6 151.9 Female 152.9
176.6 145.4 Male 158.3

Crear el ARBOL DE DECISION

modelo.alturasHijos <- rpart(altura.hijo ~ ., data = t.alturas, method = "anova", cp = 0.02)

Dibuja el árbol de decisión del modelo : modelo.alturasHijos

rpart.plot(modelo.alturasHijos, fallen.leaves = FALSE, main= "Arbol de alturas hijos", shadow.col = "green")

Construimos un Dataframe de prueba

prueba <- data.frame(altura.padre= c(190,150), 
                 altura.madre= c(180,140), 
                 sexo.hijo= c("Male","Male"))
knitr::kable(head(prueba))
altura.padre altura.madre sexo.hijo
190 180 Male
150 140 Male

hacemos un pronostico

predict(modelo.alturasHijos, prueba)
##        1        2 
## 160.9190 153.5094

Agregamos la Solucion al Dataframe de Prueba

prueba$prediccion <- predict(modelo.alturasHijos, prueba)
knitr::kable(head(prueba))
altura.padre altura.madre sexo.hijo prediccion
190 180 Male 160.9190
150 140 Male 153.5094