Objetivo

El objetivo de este ejercicio será examinar como influyen los factores en el rendimiento académico de los estudiantes, proveer insights de la relación entre las variables predictoras y el índice de performance y plantear un modelo de regresión lineal múltiple que sea capaz de predecir dicho índice.

Carga y Limpieza del dataset

El dataset consta de 10 mil registros de estudiantes, cada uno de ellos contiene información sobre 5 variables predictoras y su correspondiente índice de performance (el cual puede tomar valores que van desde 10 hasta 100, siendo los valores más altos los que indiquen un mejor rendimiento)

  • Cargamos las librerías necesarias
library(moments)
library(gplots)
library(ggplot2)
library(DescTools)
library(dplyr)
library(corrplot)
library(car)
  • Importamos el archivo
performance =  read.csv("Student_Performance.csv", header=TRUE, sep=",")
head(performance, n=10)
  • Validamos importación
class(performance) # validamos clase del objeto
## [1] "data.frame"
str(performance) #validamos estructura
## 'data.frame':    10000 obs. of  6 variables:
##  $ Hours.Studied                   : int  7 4 8 5 7 3 7 8 5 4 ...
##  $ Previous.Scores                 : int  99 82 51 52 75 78 73 45 77 89 ...
##  $ Extracurricular.Activities      : chr  "Yes" "No" "Yes" "Yes" ...
##  $ Sleep.Hours                     : int  9 4 7 5 8 9 5 4 8 4 ...
##  $ Sample.Question.Papers.Practiced: int  1 2 2 2 5 6 6 6 2 0 ...
##  $ Performance.Index               : num  91 65 45 36 66 61 63 42 61 69 ...
head(performance, n=5) #mostramos los 5 primeros registros
tail(performance,n=5) #mostramos los 5 últimos registros
summary(performance) #mostramos resumen de variables
##  Hours.Studied   Previous.Scores Extracurricular.Activities  Sleep.Hours   
##  Min.   :1.000   Min.   :40.00   Length:10000               Min.   :4.000  
##  1st Qu.:3.000   1st Qu.:54.00   Class :character           1st Qu.:5.000  
##  Median :5.000   Median :69.00   Mode  :character           Median :7.000  
##  Mean   :4.993   Mean   :69.45                              Mean   :6.531  
##  3rd Qu.:7.000   3rd Qu.:85.00                              3rd Qu.:8.000  
##  Max.   :9.000   Max.   :99.00                              Max.   :9.000  
##  Sample.Question.Papers.Practiced Performance.Index
##  Min.   :0.000                    Min.   : 10.00   
##  1st Qu.:2.000                    1st Qu.: 40.00   
##  Median :5.000                    Median : 55.00   
##  Mean   :4.583                    Mean   : 55.22   
##  3rd Qu.:7.000                    3rd Qu.: 71.00   
##  Max.   :9.000                    Max.   :100.00
  • Validamos existencia de valores nulos.
sum(complete.cases(performance)) #no se cuenta con  valores nulos
## [1] 10000
  • Renombramos variables para mayor entendimiento
performance.clean=rename(performance, "horas_sueno"=Sleep.Hours,
                                      "horas_estudio"=Hours.Studied,
                                      "score_previo"=Previous.Scores,
                                      "actividad_extra"=Extracurricular.Activities,
                                      "material_practica"=Sample.Question.Papers.Practiced,
                                      "indice_performance"=Performance.Index)

str(performance.clean)
## 'data.frame':    10000 obs. of  6 variables:
##  $ horas_estudio     : int  7 4 8 5 7 3 7 8 5 4 ...
##  $ score_previo      : int  99 82 51 52 75 78 73 45 77 89 ...
##  $ actividad_extra   : chr  "Yes" "No" "Yes" "Yes" ...
##  $ horas_sueno       : int  9 4 7 5 8 9 5 4 8 4 ...
##  $ material_practica : int  1 2 2 2 5 6 6 6 2 0 ...
##  $ indice_performance: num  91 65 45 36 66 61 63 42 61 69 ...
  • Transformamos variable actividad_extra a factor
performance.clean$actividad_extra <- factor(performance.clean$actividad_extra)
summary(performance.clean) #validamos cambio en resumen donde se observa ya el conteo por categoría
##  horas_estudio    score_previo   actividad_extra  horas_sueno   
##  Min.   :1.000   Min.   :40.00   No :5052        Min.   :4.000  
##  1st Qu.:3.000   1st Qu.:54.00   Yes:4948        1st Qu.:5.000  
##  Median :5.000   Median :69.00                   Median :7.000  
##  Mean   :4.993   Mean   :69.45                   Mean   :6.531  
##  3rd Qu.:7.000   3rd Qu.:85.00                   3rd Qu.:8.000  
##  Max.   :9.000   Max.   :99.00                   Max.   :9.000  
##  material_practica indice_performance
##  Min.   :0.000     Min.   : 10.00    
##  1st Qu.:2.000     1st Qu.: 40.00    
##  Median :5.000     Median : 55.00    
##  Mean   :4.583     Mean   : 55.22    
##  3rd Qu.:7.000     3rd Qu.: 71.00    
##  Max.   :9.000     Max.   :100.00

Análisis descriptivo

Variables cualitativas

Tabla de frecuencias variable actividad_extra

freq_activ_extra <- table(performance.clean$actividad_extra)
freq_activ_extra
## 
##   No  Yes 
## 5052 4948
transform(freq_activ_extra, 
          rel.freq=prop.table(Freq))
pie(freq_activ_extra,col = c("darkblue","green"),main = "Gráfico proporción actividad extra")

Para esta muestra el balanceo entre los estudiantes que realizan una actividad extracurricular y los que no es casi el mismo alrededor del 50% para cada categoría.

Revisemos la relación entre el performance y esta variable de forma gráfica

ggplot(performance.clean, aes(y= indice_performance, color = actividad_extra)) + 
  geom_boxplot()

plotmeans (indice_performance ~ actividad_extra, performance.clean)

Se identifica una variación mínima en el performance de los estudiantes que realizan alguna actividad extra y los que no.

Confirmemos lo anterior utilizando la prueba t de student

Para ello planteamos

H0 = M1 = M2, son independientes
H1 = M1 =! M2, son dependientes 

t.test(indice_performance~actividad_extra, performance.clean)
## 
##  Welch Two Sample t-test
## 
## data:  indice_performance by actividad_extra
## t = -2.4528, df = 9990.9, p-value = 0.01419
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
##  -1.6954851 -0.1892704
## sample estimates:
##  mean in group No mean in group Yes 
##          54.75851          55.70089

El p-value obtenido 0.01419 < .05 y por tanto se rechaza Ho, es decir, se trata de variables dependientes, no obstante, es importante reiterar que la variación no es significativa.

Revisaremos nuevamente el comportamiento de esta variable en el modelo de regresión.

Variables cuantitativas

Empecemos con la variable a predecir índice_performance

  • Tabla de distribución de frecuencias

Número de clases

k =nclass.Sturges(performance.clean$indice_performance)
k
## [1] 15

Ahora calculamos el ancho

ac = (max(performance.clean$indice_performance)-min(performance.clean$indice_performance))/k
ac
## [1] 6

Creamos los cortes con las clases correspondientes:

bins <- seq(min(performance.clean$indice_performance), max(performance.clean$indice_performance), by = ac)
bins
##  [1]  10  16  22  28  34  40  46  52  58  64  70  76  82  88  94 100
indice.clases <- cut(performance.clean$indice_performance, breaks = bins, include.lowest=TRUE, dig.lab = 8)

Con esto, ya podemos crear nuestra tabla de distribución de frecuencias:

dist.freq <- table(indice.clases)
dist.freq
## indice.clases
##  [10,16]  (16,22]  (22,28]  (28,34]  (34,40]  (40,46]  (46,52]  (52,58] 
##       90      275      541      728      928     1017      982      976 
##  (58,64]  (64,70]  (70,76]  (76,82]  (82,88]  (88,94] (94,100] 
##      996      962      920      752      499      262       72
transform(dist.freq, 
          rel.freq=prop.table(Freq),
          cum.freq=cumsum(Freq),
          cum.rel.freq=cumsum(prop.table(Freq)))
  1. Medidas de tendencia central
mean(performance.clean$indice_performance)
## [1] 55.2248
median(performance.clean$indice_performance)
## [1] 55
Mode(performance.clean$indice_performance)
## [1] 67
## attr(,"freq")
## [1] 187

Dado que la moda es mayor a la media y la mediana (que son casi iguales), esto ya nos habla de un sesgo a la izquierda en la distribución de esta variable.

2.Medidas de dispersión

var(performance.clean$indice_performance) 
## [1] 369.1224
sd(performance.clean$indice_performance) 
## [1] 19.21256
IQR(performance.clean$indice_performance) 
## [1] 31
range(performance.clean$indice_performance)
## [1]  10 100

3.Medidas de posición

quantile(performance.clean$indice_performance)
##   0%  25%  50%  75% 100% 
##   10   40   55   71  100

El 50% de nuestros datos se encuentran entre 40 y 71 de índice de performance, cuya diferencia corresponde al IQR de 31.

4.Medidas de forma

skewness(performance.clean$indice_performance)
## [1] -0.001739766

<0 ligeramente sesgada a la izquierda

kurtosis(performance.clean$indice_performance)
## [1] 2.139307

2.139307 <3, por lo tanto es platocúrtica

Revisemos lo anterior de forma gráfica

Histograma

hist(performance.clean$indice_performance, 
     freq = F,
     main = "Histograma Precio",
     xlab = "Precio",
     col ="bisque2")
lines(density(performance.clean$indice_performance), col="chocolate4")

Boxplot

boxplot(performance.clean$indice_performance, horizontal = FALSE, col = "white",border=4)
points(mean(performance.clean$indice_performance), col = 3, pch = 19)

No se identifican outliers de importancia, le media es muy próxima a la mediana siendo casi simétrica, de ahi que el valor de skewness fuese muy cercano a 3.

Relación entre variables

Generemos los gráficos par validar la relación entre las variables restantes

Performance vs horas de estudio

boxplot(indice_performance~horas_estudio, data=performance.clean,col=cm.colors(9))

cor(performance.clean$indice_performance,performance.clean$horas_estudio)
## [1] 0.3737304

El gráfico demuestra una variación importante en el performance de los estudiantes que tiene más horas de estudo vs aquellos con menor número de horas.

Performance vs horas de sueño

boxplot(indice_performance~horas_sueno, data=performance.clean,col=cm.colors(9))

El gráfico no muestra una mejora significativa en el performance de los niños con mayor número de horas de sueño vs aquellos con pocas horas.

str(performance.clean)

Performance vs score previo

plot(indice_performance~score_previo, data = performance.clean)

cor(performance.clean$indice_performance,performance.clean$score_previo)
## [1] 0.9151891

Hasta este momento Score Previo es la variable con la correlación o dependencia más fuerte con la variable a predecir, alcanzando una correlación de .9151

Regresión lineal múltiple

Primer modelo considerando todas las variables

modelo1= lm(indice_performance ~ ., data=performance.clean)
summary(modelo1)
## 
## Call:
## lm(formula = indice_performance ~ ., data = performance.clean)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.6333 -1.3684 -0.0311  1.3556  8.7932 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        -34.075588   0.127143 -268.01   <2e-16 ***
## horas_estudio        2.852982   0.007873  362.35   <2e-16 ***
## score_previo         1.018434   0.001175  866.45   <2e-16 ***
## actividad_extraYes   0.612898   0.040781   15.03   <2e-16 ***
## horas_sueno          0.480560   0.012022   39.97   <2e-16 ***
## material_practica    0.193802   0.007110   27.26   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.038 on 9994 degrees of freedom
## Multiple R-squared:  0.9888, Adjusted R-squared:  0.9887 
## F-statistic: 1.757e+05 on 5 and 9994 DF,  p-value: < 2.2e-16

El modelo alcanza una R2 de .98, es decir, que estas variables logran explicar la variación del performance en un 98% y todas las variables son significativas de acuerdo a su p-value y la significancia del 5%.

Las variables más significativas son horas de estudio y score previo, siendo estos factores los que determinan en mayor proporción el performance de un estudiante.

Validamos colinealidad

vif(modelo1)
##     horas_estudio      score_previo   actividad_extra       horas_sueno 
##          1.000478          1.000326          1.000802          1.000600 
## material_practica 
##          1.000557

No existe colinealidad en el modelo.

Análisis de residuos

residuos = rstandard(modelo1)
ks.test(residuos,"pnorm")
## Warning in ks.test.default(residuos, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  residuos
## D = 0.0065975, p-value = 0.7768
## alternative hypothesis: two-sided

H0: la variable se distribuya como una normal
H1: la variable no se distribuya como una normal

El p-value corresponde a .77 el cual es mayor a .05, por lo tanto, se acepta H0, es decir, los residuos se distribuyen como una normal

Predicción

Una vez validado el modelo podemos utilizarlo para hacer predicciones y encontrar sus intervalos de confianza

data <- data.frame(
  horas_estudio= c(7,3,5,2),
  score_previo= c(99,78,60,78),
  actividad_extra= c("Yes","No","No","No"),
  horas_sueno=c(9,9,1,1),
  material_practica=c(1,6,8,4))
  

predict(modelo1,newdata= data, interval= "confidence", level=0.95)
##        fit      lwr      upr
## 1 91.85201 91.72977 91.97425
## 2 59.40908 59.31869 59.49946
## 3 43.32635 43.17404 43.47866
## 4 52.32401 52.17255 52.47547

Conclusiones

  1. El modelo lográ explicar la variación en el performance en un 98%, lo cual, es muy bueno, siendo todas las variables significativas para el mismo.
  2. El performance en un estudiante se verá mayormente afectado por las horas de estudio y score previo
  3. Las horas de sueño así como actividades extra y material de practica no tiene una afectación de importancia en el performance