Autores: Skarleht Sánchez, Elizabeth Cruz
Etapa 1: Comprensión del proyecto.
Planteamiento del problema
El bajo rendimiento escolar es una problemática que afecta principalmente a los estudiantes, existes varias situaciones que influyen, como lo son: la vida emocional del adolescente, la falta de comunicación con los integrantes de la familia, la inestabilidad del desarrollo físico y emocional, dando como resultado, el bajo desempeño, la reprobación de materias, e incluso la deserción escolar.
Para identificar los factores que influyen, se midió el rendimiento de los estudiantes en educación secundaria de dos escuelas portuguesas.
Objetivos
1. Evaluar el rendimiento académico de los estudiantes.
2. Identificar los factores que causan el bajo rendimiento de los estudiantes.
3. Proponer soluciones para mejorar el rendimiento de los estudiantes.
Etapa 2: Enfoque analítico
Se propone utilizar técnicas estadísticas, regresión y clasificación binaria. Mediante el uso de el software R Project en su versión 4.0.5.
Información del conjunto de datos:
Estos datos representan el rendimiento de los estudiantes en la educación secundaria de dos escuelas portuguesas. Los atributos de los datos incluyen calificaciones de los estudiantes, características demográficas, sociales y relacionadas con la escuela y se recopilaron mediante el uso de informes y cuestionarios escolares. Se proporcionan conjuntos de datos sobre el desempeño en la materia de Matemáticas (mat).
Información de las variables:
La base de datos cuenta con 33 variables y 395 casos que contienen la información de cada uno de los estudiantes.
Las variables se describen a continuación:
Escuela - Escuela del estudiante ('GP' - Gabriel Pereira o 'MS' - Mousinho da Silveira)
Sexo - Sexo del estudiante ('F' - femenino o 'M' - masculino)
Edad - Edad del estudiante (De 15 a 22 años)
Área - Tipo de dirección del hogar del estudiante ('U' - urbano o 'R '- rural)
Tamaño - Tamaño de la familia (Menor o igual a 3 o Mayor que 3)
Estado civil - Estado de convivencia de los padres (Viviendo juntos o Separados)
Educación madre - Grado de educación de la madre
Educación padre - Grado de educación del padre
Trabajo madre - Ocupación de la madre
Trabajo padre - Ocupación del padre
Razón - Razón por la que el estudiante eligió la escuela
Tutor - Tutor del estudiante ('madre', 'padre' u 'otro' )
Tiempo recorrido - Tiempo de recorrido de la casa a la escuela
Tiempo de estudio - Tiempo de estudio semanal
Faltas - Número de faltas en clases anteriores
Apoyo adicional - Apoyo educativo adicional
Apoyo familiar - Apoyo educativo familiar
Clases pagadas - Clases pagas adicionales dentro de la asignatura del curso
Actividades - Actividades extracurriculares
Guardería - Asistió a la guardería
Estudio superior - Quiere cursar estudios superiores
Internet - Acceso a Internet en casa
Relación - Con una relación romántica
Familia - Calidad en las relaciones familiares
Tiempo libre - Tiempo libre después de la escuela
Salidas - Salidas con amigos
Consumo alcohol - Consumo de alcohol en la jornada laboral
Consumo alcohol F - Consumo de alcohol en los fines de semana
Salud - Estado de salud actual
Ausencias - Número de ausencias escolares
G1 - Primera calificación del primer período
G2 - Segunda calificación del segundo período
G3 - Calificación final
Análisis exploratorio
A continuación se muestran una serie de imágenes que describen a nivel general las variables de interés.
En la imagen se muestra que los estudiantes tienen entre 16 y 17 años, que la educación de la madre es en su mayoría es de nivel superior mientras que el padre solo estudió hasta quinto y sexto de primaria. El 90% de los padres de los estudiantes están separados y el 71% de las familias de los estudiantes son conformadas por mas de tres personas.
El tiempo que tardan para llegar a la escuela en su mayoría es de 15 minutos. La mayoría de estudiantes catalogan como buena su calidad familiar, mientras que al rededor de 25 alumnos la catalogan como excelente. El consumo de alcohol en los estudiantes es muy bajo en la semana, pero los fines de semana algunos de estos estudiantes tienen un consumo alto de alcohol. En un rango de 0 a 20 de la primer calificación, la mayoría de los estudiantes tuvieron entre 5 y 15 de rendimiento, en la segunda calificación se mantuvo, pero algunos estudiantes sacaron 0. La mayoría de los estudiantes tuvo de 0 a 10 faltas.
Para calificaciones finales en cuanto a rendimiento, cerca de 40 alumnos sacaron de 0 a 2, mientras que la mayoría se clasificó entre 8 y 15 de calificación en rendimiento. La mayoría de los estudiantes dedicaron de 2-5 horas de estudio diario. El 43% de los estudiantes cuentan con internet en sus casas, el 87% cuenta con apoyo educativo, al 54% les pagan clases, el 51% tienen actividades extracurriculares y el 95% de los estudiantes quieren estudiar la universidad.
Aplicación de modelo de clasificación
Se aplicó un modelo de clasificación por medio de árboles de clasificación, ya que nuestra variable respuesta es de tipo categórico.
El árbol tiene un buen ajuste ya que tiene una deviance = 0.3104 y recordamos que entre menor es la deviance, mejor será el ajuste del árbol a las observaciones.
Error del modelo
Ya que el árbol solo tiene un nodo, el error no se pudo reducir y tenemos un porcentaje de acierto del 77%. Para este caso, se tendría que cambiar la semilla para aumentar el número de nodos y disminuir el error.
Código en R para el análisis exploratorio
library(ggplot2)
library(plyr)
library(ROCR)
library(corrplot)
library(lattice)
library(caret)
library(rworldmap)
library(data.table)
############ Analisis descriptivo #
# Análisis exploratorio
#con parámetros gráficos
par(mfrow=c(2,5))
# Layout
m=matrix(c(1,2,3,4,5,6,7,8,9,10), byrow=TRUE, ncol =5)
m
layout(m)
# Muestra las 10 particiones
layout.show(10)
# 1 Gráficos
# g1 Histograma para Edad
par(mar=rep(2,4))
hist(x=calif$Edad,xlab='Edad',las=2,xedad='Edad',main='Edad',cex.main=1.1,cex.axis=1,col=rainbow(14))
# g4 Barras para Educacion de la madre
tdatosne<-prop.table(table(calif$Educacion_Madre))*100
tdatosne
g4=barplot(tdatosne,las=2,main='Educacion madre',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(17))
# g5 Barras para Educacion del padre
tdatosne<-prop.table(table(calif$Educacion_Padre))*100
tdatosne
g5=barplot(tdatosne,las=2,main='Educacion padre',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(17))
# g6 Barras para Trabajo de la madre
tdatosne<-prop.table(table(calif$Trabajo_Madre))*100
tdatosne
g6=barplot(tdatosne,las=2,main='Trabajo madre',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g7 Barras para Trabajo del Padre
tdatosne<-prop.table(table(calif$Trabo_Padre))*100
tdatosne
g7=barplot(tdatosne,las=2,main='Trabajo Padre',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g2 Pastel para Sexo
tdatoss<-prop.table(table(calif$Sexo))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Sexo',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Femenino','Masculino'),cex=0.5,fill=color)
# g3 Pastel para Escuela
tdatoss<-prop.table(table(calif$Escuela))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Escuela',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Gabriel Pereira','Mousinho da Silveira'),cex=0.5,fill=color)
# g8 Pastel para Estado civil
tdatoss<-prop.table(table(calif$Estado.civil_padres))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Estado civil',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Separados','Juntos'),cex=0.5,fill=color)
# g9 Pastel para Tamaño de la familia
tdatoss<-prop.table(table(calif$Tamaño_Familia))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Tamaño de la familia',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Mayor que 3','Menor o igual a 3'),cex=0.5,fill=color)
# g10 Pastel para Direccion -Region
tdatoss<-prop.table(table(calif$Dirección))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Region',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Rural','Urbano'),cex=0.5,fill=color)
par(mfrow=c(2,5))
# g11 Barras para Tiempo de transcurso
tdatosne<-prop.table(table(calif$Transcurso_Recorrido))*100
tdatosne
g11=barplot(tdatosne,las=2,main='Tiempo recorrido',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g12 Barras para Calidad familiar
tdatosne<-prop.table(table(calif$Calidad_Familiar))*100
tdatosne
g12=barplot(tdatosne,las=2,main='Calidad Familiar',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g13 Barras para Tiempo libre
tdatosne<-prop.table(table(calif$Tiempo_Libre))*100
tdatosne
g13=barplot(tdatosne,las=2,main='Tiempo Libre',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g14 Barras para Salidas
tdatosne<-prop.table(table(calif$Salidas))*100
tdatosne
g14=barplot(tdatosne,las=2,main='Salidas',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g15 Barras para Consumo de alcocol
tdatosne<-prop.table(table(calif$Consumo_Alcohol))*100
tdatosne
g15=barplot(tdatosne,las=2,main='Consumo de alcohol',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g16 Barras para Consumo de alcocol en fin de semana
tdatosne<-prop.table(table(calif$Consumo_Alc_Fsemana))*100
tdatosne
g16=barplot(tdatosne,las=2,main='Consumo alcohol-fin de semana',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g17 Barras para Estado de salud
tdatosne<-prop.table(table(calif$Estado_Salud))*100
tdatosne
g17=barplot(tdatosne,las=2,main='Estado de salud',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g18 Histograma para Número de faltas totales
hist(x=calif$Faltas,xlab='Faltas totales',las=2,xfaltas='Faltas',main='Total de faltas',cex.main=1.1,cex.axis=1,col=rainbow(16))
# g19 Histograma para calificacion primera
hist(x=calif$Calificacion_Primera,xlab='1ra. Calificacion',las=2,xcalificacion='Calificacion',main='Primera calificacion',cex.main=1.1,cex.axis=1,col=rainbow(16))
# g20 Histograma para Segunda calificacion
hist(x=calif$Calificacion_Segunda,xlab='2da. Calificacion',las=2,xfal='calificacion',main='Segunda calificacion',cex.main=1.1,cex.axis=1,col=rainbow(16))
par(mfrow=c(2,5))
# g21 Histograma para Calificacion final
hist(x=calif$Calificacion_Final,xlab='Calificacion final',las=2,xfal='calificacion',main='Calificacion final',cex.main=1.1,cex.axis=1,col=rainbow(16))
# g24 Barras para tiempo de estudio
tdatosne<-prop.table(table(calif$Tiempo_Estudio))*100
tdatosne
g24=barplot(tdatosne,las=2,main='Tiempo de estudio',cex.main=1,cex.axis=1,cex.names=0.9,col=rainbow(14))
# g25 Histograma para Número faltas anteriores
hist(x=calif$Faltas_Anteriores,xlab='Faltas anteriores',las=2,xnumE='NumE',main='Numero de faltas anteriores',cex.main=1.1,cex.axis=1,col=rainbow(16))
# g31 Pastel para internet
tdatoss<-prop.table(table(calif$Internet))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Cuenta con internet',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
# g23 Pastel para Tutor
tdatoss<-prop.table(table(calif$Tutor_Estudiante))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue','green')
pie(x=pct,main='Tutor del estudiante',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('Madre','Padre','Otro'),cex=0.5,fill=color)
# g26 Pastel para Apoyo educativo
tdatoss<-prop.table(table(calif$Apoyo_Educativo))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Apoyo educativo',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
# g27 Pastel para Apoyo educativo familiar
tdatoss<-prop.table(table(calif$Apoyo_Edu_Familiar))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Apoyo educativo familiar',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
# g28 Pastel para Clases pagadas
tdatoss<-prop.table(table(calif$Clases_Pagadas))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Clases Pagadas',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
# g29 Pastel para Actividades extras
tdatoss<-prop.table(table(calif$ Actividades_Extra))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Actividades extracurriculares',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
# g30 Pastel para Estudio superior
tdatoss<-prop.table(table(calif$Estudio_superior))*100
pct=round(tdatoss,digits=0)
pct
lbls=paste(pct,'%',sep='')
color<-c('red','blue')
pie(x=pct,main='Quiere cursar estudio superior',cex.main=1,line=0.25,labels=lbls,cex=1,
col=color)
legend('topright',c('No','Si'),cex=0.5,fill=color)
Código de modelo
# Tratamiento de datos
# ==============================================================================
library(dplyr)
library(tidyr)
library(skimr)
library(ISLR)
# Gráficos
# ==============================================================================
library(ggplot2)
library(ggpubr)
# Preprocesado y modelado
# ==============================================================================
library(tree)
datos <- read.delim("C:\\Users\\ely_m\\Documents\\Octavo\\Big Data\\calificaciones1.txt",header=T)
head(datos)
str(datos)
summary(datos)
# Conversión de la variable respuesta a tipo factor
datos$Apoyo_Educativo <- as.factor(datos$Apoyo_Educativo)
## AJUSTE DE MODELO
# División de los datos en train y test
# ==============================================================================
set.seed(123)
train <- sample(1:nrow(datos), nrow(datos) / 2, replace = FALSE)
datos_train <- datos[train,]
datos_test <- datos[-train,]
# Entrenamiento del modelo
# ==============================================================================
set.seed(123)
arbol_clasificacion <- tree(
formula = Apoyo_Educativo ~ .,
data = datos_train,
minsize = 10
)
summary(arbol_clasificacion)
# Estructura del árbol creado
# ==============================================================================
par(mar = c(1,1,1,1))
plot(x = arbol_clasificacion, type = "proportional")
text(x = arbol_clasificacion, splits = TRUE, pretty = 0, cex = 0.7, col = "firebrick")
## PREDICCION DEL MODELO
# Error de test del modelo
# ==============================================================================
predicciones <- predict(
arbol_clasificacion,
newdata = datos_test,
type = "class"
)
table(predicciones, datos_test$Apoyo_Educativo)
### PODADO DEL ARBOL
# Pruning (const complexity pruning) por validación cruzada
# ==============================================================================
# El árbol se crece al máximo posible para luego aplicar el pruning
arbol_clasificacion <- tree(
formula = Apoyo_Educativo ~ .,
data = datos_train,
mincut = 1,
minsize = 2,
mindev = 0
)
# Búsqueda por validación cruzada
set.seed(123)
cv_arbol <- cv.tree(arbol_clasificacion, FUN = prune.misclass, K = 5)
# Tamaño óptimo encontrado
# ==============================================================================
size_optimo <- rev(cv_arbol$size)[which.min(rev(cv_arbol$dev))]
size_optimo
resultados_cv <- data.frame(n_nodos = cv_arbol$size, clas_error = cv_arbol$dev,
alpha = cv_arbol$k)
p1 <- ggplot(data = resultados_cv, aes(x = n_nodos, y = clas_error)) +
geom_line() +
geom_point() +
geom_vline(xintercept = size_optimo, color = "red") +
labs(title = " Error de clasificación vs \n tamaño del árbol") +
theme_bw()
p2 <- ggplot(data = resultados_cv, aes(x = alpha, y = clas_error)) +
geom_line() +
geom_point() +
labs(title = " Error de clasificación vs \n penalización alpha") +
theme_bw()
ggarrange(p1, p2)
arbol_final <- prune.misclass(
tree = arbol_clasificacion,
best = size_optimo
)
# Error de test del modelo final
#-------------------------------------------------------------------------------
predicciones <- predict(arbol_clasificacion, newdata = datos_test, type = "class")
table(predicciones, datos_test$Apoyo_Educativo)
paste("El porcentaje de acierto es de",
100 * ((149 + 3) / (149 + 3 + 29 + 17)), "%")
Comments