PROYECTO 2

INTEGRANTES:

Changoluisa Alisson, Maldonado Helen, Recalde Mishell

Foto grupal

Somos estudiantes de Ingenieria en Biotecnologia en la ESPE, cursamos quinto semestre, a las tres nos gusta mucho esta carrera porque es muy interesante y tiene como objetivo usar elementos de nuestro entorno lo cual nos ayuda a mejorarlo, hay muchas cosas nuevas que se puede hacer, ademas tiene muchas aplicaciones y requiere amplio conocimiento sobre distintas ramas, por lo que lo que es un reto.

Base de datos:

Talento Humano

Describir la base de datos y las varibles:

La base de datos escogida presenta informacion acerca de la edad, altura, peso y sexo de 99 empleados de una empresa.

Variables continuas: Edad, Altura, Peso

Variable categórica: Sexo

Variable dependiente: Peso

Variables independientes: Edad, Altura, Sexo

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

Lectura de la base de datos:

library(readxl)
empleados <-read_excel("empleados.xls")
View(empleados)

Nombres de las columnas adecuados:

names(empleados)

## [1] "Edad"   "Altura" "Peso"   "Sexo"

Tipo de variables y etiquetas a las tipo factor:

typeof(empleados$Edad)

## [1] "double"

typeof(empleados$Altura)

## [1] "double"

typeof(empleados$Peso)

## [1] "double"

typeof(empleados$Sexo)

## [1] "character"

empleados$Sexo <- as.factor(empleados$Sexo)
levels(empleados$Sexo)

## [1] "Hombre" "Mujer"

Analisis exploratorio de datos

Mostrar la estructura (str) y resumen de la base de datos (summary) (minimo, media, maximo, desviacion estandar, primer cuartil de cada variable numerica y la frecuencia en el caso de variables categoricas)

#ESTRUCTURA STR
str(empleados)

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

#SUMMARY
summary(empleados)

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

#MINIMO
min(empleados$Edad)

## [1] 18

min(empleados$Altura)

## [1] 159

min(empleados$Peso)

## [1] 51

#MEDIA
mean(empleados$Edad)

## [1] 20.51515

mean(empleados$Altura)

## [1] 177

mean(empleados$Peso)

## [1] 74.75758

#MAXIMO
max(empleados$Edad)

## [1] 51

max(empleados$Altura)

## [1] 200

max(empleados$Peso)

## [1] 120

#DESVIACION ESTANDAR
sd(empleados$Edad)

## [1] 4.163406

sd(empleados$Altura)

## [1] 8.213975

sd(empleados$Peso)

## [1] 13.11573

#PRIMER CUARTIL
quantile(empleados$Edad, probs = 0.25)

## 25% 
##  18

quantile(empleados$Altura, probs = 0.25)

## 25% 
## 171

quantile(empleados$Peso, probs = 0.25)

## 25% 
##  67

#FRECUENCIA EN VARIABLE CATEGORICA
table(empleados$Sexo)

## 
## Hombre  Mujer 
##     55     44

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

Diagrama de cajas:

#EDAD-SEXO
boxplot(empleados$Edad ~ empleados$Sexo, col= c("blue","pink"), ylab="Edad de los empleados (años)")

En el diagrama de cajas podemos observar que las medias de edades entre hombres y mujeres no diefieren mucho, ambas se encuentran alrededor de los 20 años, sin embargo los hombres poseen una varanza mayor a las de las mujeres, ademas ambos poseen datos atipicos mayores a la media, 20 anios) cabe destacar que el dato de los hombres se encuentra mas alejado por lo tando es el que mas difiere

#ALTURA-SEXO
boxplot(empleados$Altura ~ empleados$Sexo, col= c("blue","pink"), ylab="Altura de los empleados (cm)")

El diagrama de altura muestra que la media de la altura de hombres y mujeres es la misma sin embargo este diagrama muestra que existe un rango mas amplio de alturas en los hombres, como altura min-q1 es mas corto significa que el 25% de los hombres con menor altura estan mas concentrados que el 25% de los mas altos, al contrario que las mujeres donde el 25% de llas mujeres mas altas estan mas concentrados que el 25% de las pequeñas.

#PESO-SEXO
boxplot(empleados$Peso ~ empleados$Sexo, col= c("blue","pink"), ylab="Peso de los empleados (kg)")

En el diagrama podemos observar que la media de los pesos es diferente en hombres y mujeres, siendo los hombres los que tienen mayor peso, su rango es mas amplio que el de las mujeres, por lo tanto existe mayor varianza,ademas la parte comprendida ente la media y q2 es mayor que la de q1-media; ello quiere decir que los pesos de los hombres comprendidos entre el 25% y el 50% de la poblacion estan mas dispersos que entre el 50% y el 75%. podemos obrservar que hay un dato atipico en cada sexo, el de las mujeres es el que se encuentra mas lejos de la media

barplot(prop.table(table(empleados$Sexo)),col=c("blue","pink"))

Diagrama de barras:

En el presente diagrama de barras podemos observar que la frecuencia de los hombres es visiblemente mayor que el de las mujeres por lo tanto podemos afirmar que hay mas empleados del sexo masculino que del femenino

Calcule la correlacion entre la variable dependiente y cada una de las variables explicativas (numericas).

library(corrplot)

## corrplot 0.84 loaded

library(readr)
library(ggplot2)
library(corrplot) #correlación 
library(mlbench) #coleccion db
library(Amelia) 

## Loading required package: Rcpp

## ## 
## ## Amelia II: Multiple Imputation
## ## (Version 1.7.5, built: 2018-05-07)
## ## Copyright (C) 2005-2018 James Honaker, Gary King and Matthew Blackwell
## ## Refer to http://gking.harvard.edu/amelia/ for more information
## ##

library(plotly) #versión mejor de ggplot2

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(reshape2) 
library(caret) #version mejorada para regr lineal

## Loading required package: lattice

library(caTools) 
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

correlacion <- corrplot(cor(select(empleados, -Sexo)))

La correlacion entre variables conciste en una tecnica para determinar la relacion entre dos o mas variables, en el siguiente grafico podemos observar el nombre de las 3 variables, tanto en el eje de las X como en el eje de las Y y sus relaciones entre si mostrando que el peso y la altura son las variables continuas con mayor correlacion, le sigue el peso y la edad, y las variables con menor correlacion son la altura y la edad

Efecto de las variables

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

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

En el siguiente grafico podemos observar claramente el efeco de las variables de estudio, es decir la relacion que posee las diferentes variables dependientes con la variable independiente, en este caso la altura y la edad (variables dependientes) con el peso (variable independiente), se observa que existe una gran dispersión de los datos por lo que no se puede apreciar tan bien el modelo.

Analisis ANOVA

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

u1 = Media edad Hombres

u2 = Media edad Mujeres

Ho: u1=u2

H1: ¬Ho

alpha: 0.05

anov1 = aov(lm(empleados$Edad ~ empleados$Sexo))
anov1

## Call:
##    aov(formula = lm(empleados$Edad ~ empleados$Sexo))
## 
## Terms:
##                 empleados$Sexo Residuals
## Sum of Squares          26.950  1671.777
## Deg. of Freedom              1        97
## 
## Residual standard error: 4.151484
## Estimated effects may be unbalanced

summary(anov1)

##                Df Sum Sq Mean Sq F value Pr(>F)
## empleados$Sexo  1   26.9   26.95   1.564  0.214
## Residuals      97 1671.8   17.23

*Ho se rechaza si pF) ## empleados$Sexo 1 133 132.91 1.99 0.162 ## Residuals 97 6479 66.79 ```

*Ho se rechaza si pF)
## empleados$Sexo 1 592 592.4 3.533 0.0632 . ## Residuals 97 16266 167.7
## — ## Signif. codes: 0 ‘’ 0.001 ’’ 0.01 ’’ 0.05 ‘.’ 0.1 ‘’ 1 ```

Ho se rechaza si p 3.889341 estaran incluidos en la region de rechazo. En nuetro caso 3.533 es menor que el valor critico obtenido.Se acepta Ho

Nota: Para las siguientes pruebas hemos usado el anova 3, que compara las medias de los pesos entre hombres (u1) y mujeres(u2).

Ho: u1=u2

H1: ¬Ho

alpha: 0.05

media <- mean(empleados$Peso[empleados$Sexo =="Hombre"]) 
valor_t <- pt(0.05/2, 18 - 3) #prueba t (nivel de confianza.. como tiene dos colas dividimos para dos, y el grado de libertad)
sp <- sqrt(167.7)  #desviación t�pica de la varianza muestral común #46 media
ee  <- valor_t * (sp/ sqrt(99))  #error de estimación #6 es el n de cada grupo
media

## [1] 76.94545

#limite superior del intervalo
media + ee 

## [1] 77.60898

#limite inferior del intervalo
media - ee 

## [1] 76.28193

Grupos que generan diferencias significativas

intervals = TukeyHSD(anov3) 
intervals

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = lm(empleados$Peso ~ empleados$Sexo))
## 
## $`empleados$Sexo`
##                   diff       lwr       upr    p adj
## Mujer-Hombre -4.922727 -10.12103 0.2755793 0.063177

Esta prueba no es muy util porque dentro de la variable categorica sexo solo hay dos niveles, sin embargo podemos observar que el valor de p adj = 0.063177 es muy lejano a 1 por lo tanto podemos afirmar que la media de pesos entre hombres y mujeres es diferente, es decir se rechaza Ho del anova 3

plot(intervals)

Si son diferentes porque en el grafico se observa que la unica combinacion posible, es decir, Mujer-Hombre, incluye al cero, por lo tanto la media de pesos entre hombres y mujeres No son estadisticamente iguales.

Validacion del modelo ANOVA

Independencia

plot(anov3$residuals)

En el grafico podemos observar que los datos se encuentran dispersos, por lo tanto, si cumple el criterio de independencia

Normalidad

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

summary(anov3$residuals)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -25.945  -7.523  -1.945   0.000   6.516  47.977

boxplot(anov3$residuals)

hist(anov3$residuals)#para ver si se paproxima a la campana ed gauuss

qqnorm(anov3$residuals) 
qqline(anov3$residuals)

En las graficas anteriores hemos podido observar que los datos Si cumplen con el criterio de normalidad, debido a que el histograma se aproxima a la curva de gauss y tambien siguen una linea mas o menos recta en el plot de normalidad, excepto por unos cuantos datos atipicos

Shapiro Test

shapiro.test(anov3$residuals)  

## 
##  Shapiro-Wilk normality test
## 
## data:  anov3$residuals
## W = 0.95253, p-value = 0.001306

El Test de Shapiro nos indica que p-value = 0.001306, entonces p-value = 0.001306<0.05 (V), se rechaza Ho y se acepta H1, es decir, las medias de pesos entre hombres y mujeres es distinta

Homocedasticidad

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

boxplot(anov3$residuals~empleados$Sexo, col = c("blue", "pink"))  

desviaciones <- tapply(anov3$residuals, empleados$Sexo, sd)
max(desviaciones) / min(desviaciones)    

## [1] 1.140433

ans=1.140433<2 entonces Si se cumple el criterio de homocesdasticidad; las varianzas en los pesos entre hombres y mujeres son estadisticamente iguales

Test de Barlett

bartlett.test(anov3$residuals ~ empleados$Sexo)  

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

p_vaule=0.3688>0.05, acepto H1 las medias de pesos son diferentes

Kruskal-Wallis y pruebas post-hoc

kruskal.test(empleados$Peso, empleados$Sexo)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  empleados$Peso and empleados$Sexo
## Kruskal-Wallis chi-squared = 3.5706, df = 1, p-value = 0.05881

El valor p es mayor que el nivel de significancia, no se cuenta con suficiente evidencia para rechazar la hipótesis nula de que las medianas de población son todas diferentes.

qchisq(0.05, 2-1, lower.tail = F)

## [1] 3.841459

Valores del estadístico > 3.841459 estarán incluidos en la región de rechazo. En nuetro caso 3.5706 es menor que el valor crítico obtenido. Se acepta la Ho

library(PMCMR)

## PMCMR is superseded by PMCMRplus and will be no longer maintained. You may wish to install PMCMRplus instead.

posthoc.kruskal.nemenyi.test(empleados$Peso, empleados$Sexo, method = "Chisq")

## Warning in posthoc.kruskal.nemenyi.test.default(empleados$Peso, empleados
## $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$Peso and empleados$Sexo 
## 
##       Hombre
## Mujer 0.059 
## 
## P value adjustment method: none

Construccion del modelo y prediccion

Considerando los calculos anteriores genere el modelo de regresion lineal multiple que mejor se ajuste a los datos.

modelo_multiple <- lm(formula = Peso ~ Edad, data = empleados)
modelo_multiple

## 
## Call:
## lm(formula = Peso ~ Edad, data = empleados)
## 
## Coefficients:
## (Intercept)         Edad  
##     58.2563       0.8043

summary(modelo_multiple)

## 
## Call:
## lm(formula = Peso ~ Edad, data = empleados)
## 
## 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

modelo_multiple <- lm(formula = Peso ~ Altura, data = empleados)
modelo_multiple

## 
## Call:
## lm(formula = Peso ~ Altura, data = empleados)
## 
## Coefficients:
## (Intercept)       Altura  
##    -78.9797       0.8686

summary(modelo_multiple)

## 
## Call:
## lm(formula = Peso ~ Altura, data = empleados)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -24.363  -6.546  -1.678   4.557  41.374 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -78.9797    24.1051  -3.276  0.00146 ** 
## Altura        0.8686     0.1360   6.385 5.92e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.06 on 97 degrees of freedom
## Multiple R-squared:  0.2959, Adjusted R-squared:  0.2886 
## F-statistic: 40.76 on 1 and 97 DF,  p-value: 5.922e-09

# establecer una semilla
set.seed(123) # para generar num aleatorios , dos decimales seteo dos decimales .. ->ajustar datos

#Seccionar los datos , `split ()` asigna un booleano a una nueva columna basada en el SplitRatio especificado.

split <- sample.split(empleados,SplitRatio =0.1)
length(empleados)

## [1] 4

dim(empleados)

## [1] 99  4

train <- subset(empleados,split==TRUE)#extrae secciones de db empleados
test <- subset(empleados,split==FALSE)

Analice la significancia de las variables y los parametros individuales.

model <- lm(Peso ~ Edad + Altura , data = train) 
summary(model)

## 
## Call:
## lm(formula = Peso ~ Edad + Altura, data = train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -18.983  -4.590  -1.447   5.100  30.410 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)   
## (Intercept) -101.6931    49.4466  -2.057  0.05177 . 
## Edad           1.7502     0.9432   1.856  0.07697 . 
## Altura         0.7976     0.2579   3.093  0.00531 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.702 on 22 degrees of freedom
## Multiple R-squared:  0.3806, Adjusted R-squared:  0.3243 
## F-statistic:  6.76 on 2 and 22 DF,  p-value: 0.005144

Las variables que tienen un menor Pr(>|t|) son significativas, podemos observar que la altura es la variable continua que presenta mas significancia debido a que el Pr(>|t|)=1.92e-05.

model <- lm(Peso ~ Edad + Altura , data = train) 
summary(model)

## 
## Call:
## lm(formula = Peso ~ Edad + Altura, data = train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -18.983  -4.590  -1.447   5.100  30.410 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)   
## (Intercept) -101.6931    49.4466  -2.057  0.05177 . 
## Edad           1.7502     0.9432   1.856  0.07697 . 
## Altura         0.7976     0.2579   3.093  0.00531 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.702 on 22 degrees of freedom
## Multiple R-squared:  0.3806, Adjusted R-squared:  0.3243 
## F-statistic:  6.76 on 2 and 22 DF,  p-value: 0.005144

Ecuacion del modelo encontrado

paste("Peso =",round(model$coefficients[1],2),round(model$coefficients[2], 2), names(model$coefficients[2]), "+", round(model$coefficients[3], 2), names(model$coefficients[3]), round(model$coefficients[4], 2), names(model$coefficients[4]))

## [1] "Peso = -101.69 1.75 Edad + 0.8 Altura NA NA"

Visualizando nuestro modelo

res <- residuals(model) 
res <- as.data.frame(res)

library(ggplot2)
ggplot(res,aes(res)) +  geom_histogram(fill='blue',alpha=0.5)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

plot(model)

test$predicted.Peso <- predict(model,test)

pl1 <-test %>% 
  ggplot(aes(Peso,predicted.Peso)) +
  geom_point(alpha=0.5) + 
  stat_smooth(aes(colour='Rojo')) +
  xlab('Actual value of Peso') +
  ylab('Predicted value of Peso')+
  theme_bw()

library(plotly)
ggplotly(pl1)

Realice un analisis detallado de los residuos

plot(anov1$residuals)

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

Incuir los resultados obtenidos y las conclusiones.

Analisis exploratorio de datos

En conclusion a todos los diagramas observados podemos decir que los hombres tienen un rango mas amplio en edad, altura y peso que las mujeres, ademas de que existen mas empleados del sexo masculino. Esto nos puede sugerir que en la empresa la mayoria de los 99 empleados; casi todos los hombres tienen entre 20-30 años y las todas mujeres no pasan de los 25 excepto una (dato atipico)

Existe una mayor correlacion entre las variables peso y la altura, mientras que las variables altura y la edad poseen menor correlacion.

Al realizar los anovas respectivos se pudo concluir que las medias de altura y edad entre hombres y mujeres son estadisticamente iguales, sin embargo las medias de los pesos difiere entre hombres y mujeres, tambien cabe recalcar que el anova es valido (cumple con el criterio de Independencia, Normalidad y Homocedasticidad)

Conla prueba no parametrica de Kruskall Wallis llegamos a la conclusion de que las medianas no son estadisticamente signficaticas