Predecir el peso de las personas.

df<-read.csv('../Desktop/datascienceforbusiness-master/heights_weights.csv')

Definición del problema.

Crear un modelo de regresión con el objetivo de predecir el peso del individiuo,el datset cuenta con los sigientes atributos:

-Weight que hace referencía al peso que está en libras.

-Height hace alusión a la altura que está en pulgadas.

-Male que representa el sexo del indiviuo.

summary(df)

     Height          Weight           Male    
 Min.   :54.26   Min.   : 64.7   Min.   :0.0  
 1st Qu.:63.51   1st Qu.:135.8   1st Qu.:0.0  
 Median :66.32   Median :161.2   Median :0.5  
 Mean   :66.37   Mean   :161.4   Mean   :0.5  
 3rd Qu.:69.17   3rd Qu.:187.2   3rd Qu.:1.0  
 Max.   :79.00   Max.   :270.0   Max.   :1.0  

head(df)

dim(df)

[1] 10000     3

La base de datos cuenta con un total de 10000 observaciones y un número de variables de 3.

library(DataExplorer)
library(ggplot2)

plot_histogram(df)

La altura sigue una distibución normal casi en forma de campana donde puede tener una altura minima de 55 pulgadas que es equivalente en metros 1.39 a priori piede parecer una altura muy chica pero hay que tener en cuenta la edad de la persona algo que en este datset carece de información lo cual sospecho que sea de un infante.

df$Male<-factor(df$Male,levels = c(0,1),labels = c('Female','Male'))

ggplot(df,aes(y=Male,fill=Male)) + geom_bar() +
  ggtitle('Number of men and women')

Hay la misma cantidad de hombres y mujeres con un total de 5000 de cada sexo dando un total de 10000 observaciones.

df[df$Height==max(df$Height) | df$Height==min(df$Height),]

ggplot(df,aes(x=Male,y=Height,fill=Male)) + geom_boxplot() +
  ggtitle('Distribution of the height respect to sex') +
  labs(fill='Sex') + theme(legend.position = 'top')

df[df$Weight==max(df$Weight) | df$Weight==min(df$Weight),]

NA

ggplot(df,aes(x=Male,y=Weight,fill=Male)) + geom_boxplot() +
  ggtitle('Distribution of the weight respect to sex') +
  labs(fill='Sex') + theme(legend.position = 'top')

Se puede observar tanto en la gráfica como en el resultados los hombres tienen características fisiológicas mayores que la de los hombres, ya que hormonalmente son distintos.

ggplot(df,aes(x=Height,y=Weight,color=Male)) + geom_point(alpha=0.8) +
  geom_smooth(method='lm',col='red') + facet_grid(Male~.) + 
  ggtitle('Height to weight ratio') + theme(legend.position = 'top')

`geom_smooth()` using formula 'y ~ x'

Se pueden apreciar que ambas variables están altamente correlacionadas y siguen una tendencia lineal independientemente del sexo, algo que no es de extrañar ya que la fórmula matemática del indice de masa corporal (imc) es la relación del peso con la altura.

plot_correlation(df,title = 'Correlation Matrix')

Se pueden observar que todas las variables están altamente correlacionadas por lo cual van a tener un impacto significativo, y son coherentes ya que el sexo influye en la altura y el peso de las personas.

splits<-split(df,df$Male)

female<-splits[[1]]
male<-splits[[2]]

Creamos dos grupos con el objetivo de tratar de una manera más efectiva los valores atípicos.

impute_ut<-function(x){
  
  lower_limit<-mean(x)-1.5*sd(x)
  upper_limit<-median(x)+1.5*sd(x)
  
  
  x[x<lower_limit]<-mean(x)
  x[x>upper_limit]<-median(x)
  
  return(x)
  
}

Si el valor para la altura y el peso son exagerademente altos o bajos los va a remplazar por una medida de tendencia central.

female$Height<-impute_ut(female$Height)
female$Weight<-impute_ut(female$Weight)

male$Height<-impute_ut(male$Height)
male$Weight<-impute_ut(male$Weight)

new_df<-rbind(female,male)

ggplot(new_df,aes(x=Male,y=Height,fill=Male)) + geom_boxplot() +
  ggtitle('Distribution of the height respect to sex') +
  labs(fill='Sex') + theme(legend.position = 'top')

NA
NA
NA

ggplot(new_df,aes(x=Male,y=Weight,fill=Male)) + geom_boxplot() +
  ggtitle('Distribution of the weight respect to sex ') +
  labs(fill='Sex') + theme(legend.position = 'top')

Se pueden observar en la gráfica de caja y bigote que ya carecen valores atípicos y lo mejor de todo sin perder datos.

new_df$Height<-scale(new_df$Height)

Rescalamos las variables predictores continuas con el fin de trabajr en una escala similar.

library(caret)

set.seed(2018)

traning.ids<-createDataPartition(new_df$Weight,p=0.8,list=F)

train<-new_df[traning.ids,]
test<-new_df[-traning.ids,]

Separamos nuestros datos de entrenamiento y validación haciendo uso de la librería caret

Procedemos con la creación de nuestro modelo de regresión.

lm<-lm(Weight~.,data=train)

summary(lm)

Call:
lm(formula = Weight ~ ., data = train)

Residuals:
     Min       1Q   Median       3Q      Max 
-29.5279  -6.7834  -0.0203   6.7736  29.7488 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 148.0806     0.2295  645.11   <2e-16 ***
Height       14.7926     0.1986   74.49   <2e-16 ***
MaleMale     26.9196     0.3965   67.90   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 10.34 on 7997 degrees of freedom
Multiple R-squared:  0.871, Adjusted R-squared:  0.871 
F-statistic: 2.7e+04 on 2 and 7997 DF,  p-value: < 2.2e-16

Se puede observar que tenemos un alto R2 ajustado por lo cual se acopla muy bien con los datos de entrenamiento y no hay mucha diferencia respecto a los valores originales.

Ahora veamos como se comporta con nuestros datos de validación.

y_pred<-predict(lm,newdata = test)

R2(test$Weight,y_pred)

[1] 0.8694438

Tiene un muy bien R2 ajustado con los datos de validación por lo cual dicho modelo nos puede ayudar a la hora de predecir nuevos datos.

test['predictions']<-y_pred

head(test[,c('Weight','predictions')])

Height<-c(70,65,72,64)
Male<-c('Male','Male','Female','Female')

new_data<-data.frame(Height,Male)

new_data$Height<-scale(new_data$Height)

predict(lm,newdata = new_data)

       1        2        3        4 
183.6180 164.4675 164.3585 133.7177 

Mido 1.80 que es el equivalente a 70 pulgadas y medio una predición de 183 libras que es equivalente a 80 kg algo muy cercano a lo que peso en la realidad que son 82 kg.