Abstract

Este trabajo lo realizan David Andrés Ordoñez Chiliquinga, joven de 22 años, estudiante de Ingeniería en Biotecnología en la Universidad de las Fuerzas Armadas ESPE y Mirza Massiel Zurita Villacrés de 21 años de edad, estudiante de la misma carrera antes ya mencionada.

David Andrés y Massiel Zurita

David Andrés y Massiel Zurita

Base de Datos

1.Describir la base de datos y las variables

La base de datos se trata sobre Edad, Altura y Peso de empleados como variables continuas pues pues pueden tomar valores intermedios es decir valores reales y la variable categérica siendo esta Sexo y definida como nominal pues no puede ser expresada en cifras.

2. Lectura de la base de datos, nombres de columnas adecuados, definir tipo de varibles y etiquetas a las tipo factor

library(readxl)
empleados_data <- read_excel("empleados.xls")
colnames(empleados_data)[c(1,2,3,4)]<-c("Edad","Altura","Peso","Sexo")
empleados_data$Edad<-as.numeric(empleados_data$Edad)
empleados_data$Altura<-as.numeric(empleados_data$Altura)
empleados_data$Peso<-as.numeric(empleados_data$Peso)
empleados_data$Sexo<-as.factor(empleados_data$Sexo)

library(kableExtra)
kable_styling(kable(empleados_data),bootstrap_options = "striped", full_width = F, position = "center")
Edad Altura Peso Sexo
20 178 82 Hombre
18 168 87 Hombre
19 194 94 Hombre
19 159 62 Mujer
21 177 78 Hombre
18 180 53 Hombre
20 180 62 Mujer
18 168 68 Hombre
19 190 82 Hombre
18 187 79 Mujer
24 181 100 Hombre
18 163 56 Mujer
21 200 90 Hombre
22 180 79 Hombre
18 185 70 Hombre
18 173 60 Mujer
18 172 68 Mujer
19 170 67 Mujer
19 185 70 Mujer
24 180 74 Hombre
18 193 94 Hombre
24 189 75 Hombre
18 170 68 Hombre
18 172 70 Mujer
18 174 58 Mujer
18 162 53 Mujer
18 169 70 Mujer
18 160 53 Mujer
22 179 110 Hombre
32 182 90 Hombre
21 180 87 Mujer
18 172 72 Mujer
18 178 70 Mujer
22 178 117 Hombre
18 174 80 Hombre
19 182 95 Hombre
18 177 81 Hombre
26 165 60 Hombre
18 183 76 Hombre
24 183 90 Hombre
26 182 70 Hombre
20 171 64 Hombre
23 173 75 Mujer
18 178 72 Mujer
19 168 54 Mujer
18 187 72 Hombre
19 168 65 Hombre
19 170 64 Hombre
18 179 71 Mujer
18 180 68 Mujer
18 174 73 Mujer
21 184 88 Mujer
18 179 70 Mujer
22 176 85 Hombre
19 172 76 Hombre
18 176 72 Mujer
21 176 74 Hombre
18 175 72 Hombre
21 168 65 Hombre
18 173 60 Hombre
19 188 75 Hombre
19 175 85 Hombre
19 185 64 Mujer
18 185 87 Mujer
19 182 82 Mujer
18 165 51 Hombre
21 195 90 Hombre
25 179 73 Hombre
19 196 83 Hombre
22 181 78 Mujer
19 171 74 Mujer
28 173 61 Hombre
19 170 65 Hombre
18 191 75 Hombre
18 167 67 Hombre
19 180 78 Mujer
18 180 65 Mujer
19 183 71 Hombre
19 175 67 Mujer
23 165 60 Hombre
24 175 85 Hombre
26 182 72 Hombre
22 168 70 Hombre
18 180 70 Mujer
19 177 74 Mujer
20 180 73 Mujer
22 185 87 Mujer
24 172 72 Hombre
20 180 82 Hombre
23 167 60 Hombre
19 167 70 Hombre
24 170 70 Mujer
23 182 87 Mujer
51 180 83 Mujer
18 162 57 Mujer
23 182 120 Mujer
20 180 73 Mujer
19 167 80 Mujer
28 180 105 Hombre 
View(empleados_data)

Análisis Exploratorio de Datos

1. Mostrar la estructura (str) y resumen de la base de datos (summary) (minimo, media, maximo, desviacon estandar, primer cuartil de cada variable numerica y la frecuencia en el caso de variables categóricas)

Estructura

str(empleados_data)
## Classes 'tbl_df', 'tbl' and 'data.frame':    99 obs. of  4 variables:
##  $ Edad  : num  20 18 19 19 21 18 20 18 19 18 ...
##  $ Altura: num  178 168 194 159 177 180 180 168 190 187 ...
##  $ Peso  : num  82 87 94 62 78 53 62 68 82 79 ...
##  $ Sexo  : Factor w/ 2 levels "Hombre","Mujer": 1 1 1 2 1 1 2 1 1 2 ...

Resumen

summary(empleados_data)
##       Edad           Altura         Peso            Sexo   
##  Min.   :18.00   Min.   :159   Min.   : 51.00   Hombre:55  
##  1st Qu.:18.00   1st Qu.:171   1st Qu.: 67.00   Mujer :44  
##  Median :19.00   Median :178   Median : 72.00              
##  Mean   :20.52   Mean   :177   Mean   : 74.76              
##  3rd Qu.:22.00   3rd Qu.:182   3rd Qu.: 82.00              
##  Max.   :51.00   Max.   :200   Max.   :120.00

Limpieza de datos

missmap(empleados_data,col=c('gold','red'),y.at=1,y.labels='',legend=TRUE)

2. Genere diagramas de caja para variables continuas y diagramas de barras para variables discretas, describir resultados

Variables continuas

Altura

La media de la altura de tanto hombres como mujeres se encuentra alrededor de 178, en el caso de los dos la mayoria de los datos se encuentra mas dispersos entre el 25% y 50% de la población que entre el 50% y 75%, en el caso de los hombres los más altos se encuentran más dispersos que los mas bajos al contrario de las mujeres.

Peso

boxplot(empleados_data$Peso ~ empleados_data$Sexo, col = c("red","yellow"), ylab = "Peso")

La media del peso tanto en hombre y mujeres se encuentra entre el 70 y 80 kg, de igual manera los datos se encuentran mas dispersos entre el 50% y 75% al ser más la distancia de la caja en la parte superior,en el caso de los hombres se puede decir que los más pesados se encuentran dispersos que los que no pues el bigote de la izquierda es mas largo, en el de las mujeres ambos casos se encuentran en similar concentración y finalmente en los dos casos se encuentra un dato atípico muy superiror a las medias.

Edad

Las medias en ambos casos se encuentran entre 15 y 20 años, en el caso de las mujeres los datos se encuentran distribuidos simétricamente a pesar de existir dos datos atípicos uno muy cerca a la media y otro muy lejano que se podría descartar, en el caso de los hombres hay mayor dispersión entre el 50 y 75% y un dato atípico cerca del valor máximo, de igual manera al ser los bigotes de la derecha en ambos casos indica que se encuentran el 25% de los mayores se encuentran más dispersos que los más jóvenes.

Variables discreta

Sexo

ggplot(empleados_data, aes(x=as.factor(empleados_data$Sexo) )) + geom_bar()+
  labs(title="Diagrama de barras",subtitle="Sexo de empleados")

En el diagrama de barras se puede identificar que hay mayor número de hombres con 55 que de mujeres con 44.

3. Calcule la correlación

Altura

correlacion=corrplot(cor(select(empleados_data,-Sexo)))

correlacion  
##              Edad     Altura      Peso
## Edad   1.00000000 0.09399014 0.2553284
## Altura 0.09399014 1.00000000 0.5439601
## Peso   0.25532839 0.54396008 1.0000000

Entre altura y peso existe más correlación pues el tamaño de la bolita es mayor y el color es más fuerte, entre peso y edad la correlación es menor pues el color disminuye y acerca a cero como es el caso de altura y edad en el cual no existe correlación, en los otros dos casos la correlación puede ser lineal directa pues tienen colores más fuertes.

Gráfico de densidad con ggplot

Las visualizaciones reflejan que las densidades máximas del peso se encuentra aproximadamente en 70kg.

*Gráfico de densidad con plotly**

ggplotly(empleados_data %>% 
  ggplot(aes(Peso)) +
  stat_density() + 
  theme_bw())

Las visualizaciones reflejan que las densidades máximas del peso se encuentra aproximadamente en 70kg.

*4.Muestre el efecto de las variables independientes con respecto a la variable dependiente**

empleados_data%>%
  select(c(Altura, Peso, Edad )) %>%
  melt(id.vars = "Edad") %>%
  ggplot(aes(x = value, y = Edad, colour = variable)) +
  geom_point(alpha = 0.7) +
  stat_smooth(aes(colour = "red ")) +
  facet_wrap(~variable, scales = "free", ncol = 2) +
  labs(x = "Variable Value", y = "Edad") +
  theme_minimal()

Los datos tienen correlación con el corrplot anterior.

Analisis de ANOVA

1.Considere una variable categarica y realice un analisis ANOVA (como el revisado en clase), incluya resultados y conclusion al final

Diagrama de caja

Media

##   Hombre    Mujer 
## 178.0364 175.7045

Hipótesis

Ho: Las medias de la muestra son iguales

H1: Al menos una media de la muestra es diferente

Tabla se resumen ANOVA

summary(empleados)
##                     Df Sum Sq Mean Sq F value Pr(>F)
## empleados_data$Sexo  1    133  132.91    1.99  0.162
## Residuals           97   6479   66.79

Elementos generados en ANOVA

names(empleados)
##  [1] "coefficients"  "residuals"     "effects"       "rank"         
##  [5] "fitted.values" "assign"        "qr"            "df.residual"  
##  [9] "contrasts"     "xlevels"       "call"          "terms"        
## [13] "model"

Pruebas Post-Hoc

qf(0.05, 2-1, 70-2, lower.tail = F)
## [1] 3.981896

Como 1.99<3.981896 es decir el F value es menor al valor F calculado, se acepta la Ho y se rechaza H1, conluyendo que las medias son iguales.

Tras esto se concluye que la variable n oes significativa.

Intervalos de confianza

Intervalo de confianza de la media de la de los pacientes hombres, con un nivel de confianza del 95%:

## [1] 178.0364

Limite superior

## [1] 180.7825

Limite inferior

## [1] 175.2903

Prueba de Tukey

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = lm(empleados_data$Altura ~ empleados_data$Sexo))
## 
## $`empleados_data$Sexo`
##                   diff       lwr       upr     p adj
## Mujer-Hombre -2.331818 -5.612627 0.9489903 0.1615521
plot(intervals1)

Validación del modelo ANOVA

A partir de los residuos del modelo comprobaremos si el modelo ANOVA es adecuado. Los supuestos que se deben cumplir son tres: independencia, homocedasticidad y normalidad.

1.Independencia

plot(empleados$residuals)

2. Normalidad

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -16.7045  -5.8705   0.9636   0.0000   4.2955  21.9636
boxplot(empleados$residuals, col="grey")

hist(empleados$residuals, col="skyblue")

qqnorm(empleados$residuals) 
qqline(empleados$residuals)

Test de Shapiro-Wilk

shapiro.test(empleados$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  empleados$residuals
## W = 0.98613, p-value = 0.3892

Como el valor p < 0.05, se concluye que los datos no son normales

3.Homocedasticidad

Los gráficos y descriptivos nos informan si se verifica la igualdad de varianzas en los grupos descritos:

Diagrama de caja

Desviaciones Estandar por grupo

Comparando la desviación máxima con la mínima obtenemos una orientación sobre la falta de homocedasticidad (>2 aproximadamente)

max(desviaciones1) / min(desviaciones1)
## [1] 1.210534
#si este valor es >2 no hay homocedasticidad, la varianza no es igual.

Como el valor obtenido es menor a 2, hay homocedasticidad, conluyendose que las varianzas son iguales.

Test de Bartlett

Ho= Varianzas iguales

H1=Varianzas diferentes

## 
##  Bartlett test of homogeneity of variances
## 
## data:  empleados$residuals by empleados_data$Sexo
## Bartlett's K-squared = 1.6949, df = 1, p-value = 0.193

Como el valor P >0.05, se rechaza la hipotesis nula y se acepta la hipotesis alternativa concluyendose que las varianzas son diferentes, es decir no hay homocedasticidad

Kruskal-Wallis y pruebas post-hoc (Test Multivariante)

Ho: la variable respuesta es la misma en todas las poblaciones valoradas

H1: la variable respuesta es mayor en alguna de las poblaciones

## 
##  Kruskal-Wallis rank sum test
## 
## data:  empleados_data$Altura and empleados_data$Sexo
## Kruskal-Wallis chi-squared = 0.64149, df = 1, p-value = 0.4232
## [1] 3.841459

como 0.4232<3.841459 se acepta la hipostesis nula y se concluye que la variable respuesta es la misma en todas las poblaciones valorada

kruskal.test(log(empleados_data$Altura), empleados_data$Sexo) 
## 
##  Kruskal-Wallis rank sum test
## 
## data:  log(empleados_data$Altura) and empleados_data$Sexo
## Kruskal-Wallis chi-squared = 0.64149, df = 1, p-value = 0.4232

Comparacion

library(PMCMR)  
## Warning: package 'PMCMR' was built under R version 3.4.4
## PMCMR is superseded by PMCMRplus and will be no longer maintained. You may wish to install PMCMRplus instead.
posthoc.kruskal.nemenyi.test(empleados_data$Altura, empleados_data$Sexo, method = "Chisq")
## Warning in posthoc.kruskal.nemenyi.test.default(empleados_data$Altura,
## empleados_data$Sexo, : Ties are present, p-values are not corrected.
## 
##  Pairwise comparisons using Tukey and Kramer (Nemenyi) test  
##                    with Tukey-Dist approximation for independent samples 
## 
## data:  empleados_data$Altura and empleados_data$Sexo 
## 
##       Hombre
## Mujer 0.42  
## 
## P value adjustment method: none

Construcción del modelo y predicción

1. Considerando los cálculos anteriores genere el modelo de regresión lineal múltiple que mejor se ajuste a los datos

Construcción de modelos y predicción

El modelo de regresión lineal general en R:

Train Y Test Data

set.seed(123) 
split <- sample.split(empleados_data,SplitRatio =0.75) 
train <- subset(empleados_data,split==TRUE) 
test <- subset(empleados_data,split==FALSE) 
modelo1 <- lm(formula = Peso ~ Edad, data = empleados_data)
modelo1
## 
## Call:
## lm(formula = Peso ~ Edad, data = empleados_data)
## 
## Coefficients:
## (Intercept)         Edad  
##     58.2563       0.8043
summary(modelo1)
## 
## Call:
## lm(formula = Peso ~ Edad, data = empleados_data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -21.735  -7.648  -1.735   7.548  43.244 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  58.2563     6.4725   9.001 1.93e-14 ***
## Edad          0.8043     0.3093   2.601   0.0108 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.75 on 97 degrees of freedom
## Multiple R-squared:  0.06519,    Adjusted R-squared:  0.05556 
## F-statistic: 6.765 on 1 and 97 DF,  p-value: 0.01075
modelo2 <- lm(formula = Altura ~ Edad, data = empleados_data)
modelo2
## 
## Call:
## lm(formula = Altura ~ Edad, data = empleados_data)
## 
## Coefficients:
## (Intercept)         Edad  
##    173.1958       0.1854
summary(modelo1)
## 
## Call:
## lm(formula = Peso ~ Edad, data = empleados_data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -21.735  -7.648  -1.735   7.548  43.244 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  58.2563     6.4725   9.001 1.93e-14 ***
## Edad          0.8043     0.3093   2.601   0.0108 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.75 on 97 degrees of freedom
## Multiple R-squared:  0.06519,    Adjusted R-squared:  0.05556 
## F-statistic: 6.765 on 1 and 97 DF,  p-value: 0.01075

2. Analice la significancia de las variables y los parámetros individuales

Entrenando nuestro modelo

model <- lm(Peso ~ Edad + Altura , data = train) 
summary(model)
## 
## Call:
## lm(formula = Peso ~ Edad + Altura, data = train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.093  -6.978  -0.963   5.186  40.565 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -62.4182    27.2301  -2.292   0.0248 *  
## Edad          0.6833     0.2808   2.434   0.0174 *  
## Altura        0.6956     0.1520   4.577 1.92e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.78 on 72 degrees of freedom
## Multiple R-squared:  0.2857, Adjusted R-squared:  0.2658 
## F-statistic:  14.4 on 2 and 72 DF,  p-value: 5.499e-06

Ecuacion de modelos y predicción

## [1] "Peso = -62.42 + 0.68 Edad + 0.7 Altura"

Visualizando nuestro modelo

Permite visualizar nuestro modelo de regresión lineal trazando los residuos. La diferencia entre el valor observado de la variable dependiente (y) y el valor predicho (y) se denomina residual (e).

  1. Para que un modelo sea aceptable si las variables son estadÃ?sticamente significativas
  2. \[{R}^2\] (mide la calidad del modelo) ajustado es >=0.5. 3.Los residuos N(0,1) ajusten a una distribucion normal, siendo media=0 y varianza=1, residuos no correlacionados.
  3. No siguen un patrón deben estar dispersos
res1 <- residuals(model)
res1 <- as.data.frame(res1)
ggplot(res1,aes(res1)) +  geom_histogram(fill='blue',alpha=0.5)

Si los residuos siguen una distribucion N(0,1) tienen la forma de la campana de Gauss.

plot(model)

Predicciones

Probemos nuestro modelo prediciendo en nuestro conjunto de datos de prueba.

test$predicted.Altura <- predict(model,test)  
pl1 <-test %>% 
  ggplot(aes(Altura,predicted.Altura)) +
  geom_point(alpha=0.5) + 
  stat_smooth(aes(colour='black')) +
  xlab('Actual value of Altura') +
  ylab('Predicted value of Altura')+
  theme_bw()  
ggplotly(pl1)

La linea roja indica el ajuste de los datos con una posible interpolacion para identificar la tendencia de los datos. La parte sombreado con gris es el intervalo de confianza.

3. Realice un análisis detallado de los residuos

plot(empleados$residuals)

error <- test$Altura-test$predicted.Altura
rmse <- sqrt(mean(error)^2)

4. Incluir los resultados obtenidos y las conclusiones