1 Introducción

El objetivo de esta tarea es realizar una predicción de la nota final del curso (atributo G3 de los datasets) de los alumnos en función del resto de atributos, para las asignaturas de matemáticas y portugués (lengua materna).

La predicción se realizará utilizando dos modelos de aprendizaje supervisado.

Modelo de regresión lineal de la variable numérica G3 entre 0-20

Modelo de regresión logística para G3, aprobado-suspenso.

2 Creando el directorio para el análisis

setwd("C:/Mis documentos Personales/Carlos/2016-Master-Big-Data/Modulo-3/Tarea")

3 Leyendo los ficheros

Se leen los dos ficheros de datos extraidos y se almacenan en dos data.frame, uno para los estudiantes de matemáticas y otro para los de portugués.

# Primero el data frame de matemáticas
con1 <- file("./student-mat.csv","r")
studentmat <- read.csv2(con1)
close(con1)
#head(studentmat[1:5])

# Segundo el data frame de portugués
con2 <- file("./student-por.csv","r")
studentpor <- read.csv2(con1)
close(con2)
#head(studentpor[1:5])
fechaDescarga <- date()
fechaDescarga

[1] “Mon May 23 12:33:46 2016”

4 Analisis exploratorio de los dos datasets

vamos a clasificar la nota final en varios criterios

Por un lado vamos a clasificarla en aprobado-suspenso

Por otro lado vamos a clasificarla en cinco grupos de acuerdo con el siguiente criterio (criterio europeo)

  1. suspenso
  2. suficiente
  3. satisfactorio
  4. bueno
  5. excelente
library(knitr)

# clasificación binaria del atributo G3 de ambos datasets
studentmat$aprobado <- ifelse(studentmat$G3>9,1,0)
table(studentmat$aprobado)

0 1 130 265

studentpor$aprobado <- ifelse(studentpor$G3>9,1,0)
table(studentpor$aprobado)

0 1 100 549

# clasificación europea en cinco niveles del atributo G3
library(Hmisc)
## Loading required package: lattice
## Warning: package 'lattice' was built under R version 3.2.5
## Loading required package: survival
## Loading required package: Formula
## Loading required package: ggplot2
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
## 
##     format.pval, round.POSIXt, trunc.POSIXt, units
studentmat$G3grupo <- cut2(studentmat$G3, c(20,15,13,11,9))
levels(studentmat$G3grupo) <- c("suspenso=1", "suficiente=2", "satisfactorio=3", "bueno=4", "excelente=5")
studentmat$G3grupo <- as.numeric(studentmat$G3grupo)
table(studentmat$G3grupo)

1 2 3 4 5 130 56 78 58 72

studentpor$G3grupo <- cut2(studentpor$G3, c(20,15,13,11,9))
levels(studentpor$G3grupo) <- c("suspenso=1", "suficiente=2", "satisfactorio=3", "bueno=4", "excelente=5")
studentpor$G3grupo <- as.numeric(studentpor$G3grupo)
table(studentpor$G3grupo)

1 2 3 4 5 100 97 176 145 131

Vamos a representar mediante histogramas la nota final (Sólo vamos a mostrar uno de ellos por la limitación en el número de figuras)

En el primer histograma representamos los suspensos y aprobados

En el segundo representamos los cinco grupos

En el tercero representamos las notas de manera contínua

# histograma g3 aprobado-suspenso

library(ggplot2)

#ggplot(studentmat, aes(aprobado)) + geom_bar(colour="black", fill="green", alpha=.5, stat="count") + xlab("suspenso aprobado") + ylab("cantidad") + ggtitle("Matematicas")

#ggplot(studentpor, aes(aprobado)) + geom_bar(colour="black", fill="red", alpha=.5, stat="count") + guides(fill=FALSE)  + xlab("suspenso aprobado") + ylab("cantidad") + ggtitle("Portugués")

# histograma G3 5 grupos

#ggplot(studentmat, aes(G3grupo)) + geom_bar(colour="black", fill="green", alpha=.5, stat="count") + guides(fill=FALSE)  + xlab("grupos") + ylab("cantidad") + ggtitle("Matematicas")

#ggplot(studentpor, aes(G3grupo)) + geom_bar(colour="black", fill="red", alpha=.5, stat="count") + guides(fill=FALSE)  + xlab("grupos") + ylab("cantidad") + ggtitle("Portugués")

# histograma G3 contínuo

ggplot(studentmat, aes(G3)) + geom_bar(colour="black", fill="green", alpha=.5, stat="count") + guides(fill=FALSE)  + xlab("nota") + ylab("cantidad") + ggtitle("Matematicas")

#ggplot(studentpor, aes(G3)) + geom_bar(colour="black", fill="red", alpha=.5, stat="count") + guides(fill=FALSE)  + xlab("nota") + ylab("cantidad") + ggtitle("Portugués")

4.1 Relación entre la nota final y algunas variables predictoras

Vamos a analizar gráficamente la relación de la nota final de matemáticas con algunas variables predictoras. (No vamos a representar todas las figuras por la limitación en el número de figuras)

# Relación entre aprobar o no con las salidas de amigos. Matemáticas
#ggplot(studentmat, aes(x = goout)) + geom_bar(colour="black", fill="blue", alpha=.5, stat="count") +
#facet_grid(aprobado ~ .) +
#ggtitle ("Relación gráfica entre aprobar o no matemáticas y las salidas con amigos") +
#theme(plot.title=element_text(vjust = +1.5, size = 10))

# Relación de la nota final con estar enamorado. Matemáticas
ggplot(studentmat, aes(x = G3)) + geom_bar(colour="black", fill="pink", alpha=.5, stat="count") +
facet_grid(romantic ~ .) +
ggtitle ("relación gráfica entre la nota final de matemáticas y estar enamorado") +
theme(plot.title=element_text(vjust = +1.5, size = 10))

Parece evidente que existe una mayor tendencia a las salidas con amigos entre los alumnos que aprueban. Parece que la sociabilidad de los chicos favorece que saquen mejores notas.

Por el contrario parece que el hecho de estar enamorado entre estos chicos afecta negativamente a que aprueben las matemáticas, aunque no es del todo concluyente.

4.2 Matriz de correlación de variables

Siguiendo con la metodología propuesta, en este apartado vamos a calcular la matriz de correlación de algunas variables predictoras. La correlación entre variables implicaría que alguna de dichas variables deberían ser desechadas como predictoras en los modelos explicativos. No se incluyen los gráficos

# Para incluir estas dos variables tipo factor en la matriz de correlación
studentmat$GP <- ifelse(studentmat$school == "GP", 1, 0)
studentmat$MS <- ifelse(studentmat$school == "MS", 1, 0)
studentpor$GP <- ifelse(studentpor$school == "GP", 1, 0)
studentpor$MS <- ifelse(studentpor$school == "MS", 1, 0)

# Sólo se incluyen algunas variables en la matriz de correlación

matCor <- cor(studentmat[, c("GP","MS","absences","goout","Dalc","Walc","traveltime","G1","G2","G3","aprobado")])
library(corrplot)
matCor[is.na(matCor)] <- 0

porCor <- cor(studentpor[, c("GP","MS","absences","goout","Dalc","Walc","traveltime","G1","G2","G3","aprobado")])
library(corrplot)
porCor[is.na(porCor)] <- 0

# Generamos una paleta de colores más claros
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))

# Dibujamos la matriz de correlación con cuadrados de colores y etiquetas negras
#corrplot(matCor, method = "shade", shade.col = NA, tl.col = "black",
#tl.srt = 40, col = col(200), addCoef.col="black",
#order="AOE",
#mar = c(1,0,2,0), line=-2,
#main = "Matriz de correlación de variables predictoras Matemáticas")

#corrplot(porCor, method = "shade", shade.col = NA, tl.col = "black",
#tl.srt = 40, col = col(200), addCoef.col="black",
#order="AOE",
#mar = c(1,0,2,0), line=-2,
#main = "Matriz de correlación de variables predictoras Portugués")

Como vemos existe gran correlación entre G3, G2 y G1.

5 Análisis exploratorio con modelos de aprendizaje no supervisados

5.1 Clustering jerarquico, para ver cómo pueden ser las posibles agrupaciones

Vamos a buscar grupos de estudiantes formando clusters.

Primero vamos a utilizar el clustering jerárquico porque no conocemos a priori el número de cluster, y así tendremos una idea preliminar.

# cargamos las librerias para hacer el cluster jerárquico
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:Hmisc':
## 
##     combine, src, summarize
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(cluster)

# haciendo el clústering jerárquico
# seleccionamos primero los atributos numéricos y desechamos los de tipo factor
studentmat.select <- studentmat %>% select(-school, -sex, -address, -famsize, -Pstatus, -Mjob, -Fjob, -reason, -guardian, -schoolsup, -famsup, -paid, -activities, -nursery, -higher, -internet, -romantic,-aprobado, -G3grupo, -GP, -MS)

studentpor.select <- studentpor %>% select(-school, -sex, -address, -famsize, -Pstatus, -Mjob, -Fjob, -reason, -guardian, -schoolsup, -famsup, -paid, -activities, -nursery, -higher, -internet, -romantic, -aprobado, -G3grupo, -GP, -MS)

# se realizan los clústering jerárquicos y se representan los dendogramas
studentmatclust <- hclust(dist(studentmat.select), method = "ave")
plot(studentmatclust, hang = -1, main = "Matemáticas")
rect.hclust(studentmatclust, k=8)

studentporclust <- hclust(dist(studentpor.select), method = "ave")
#plot(studentporclust, hang = -1, main = "Portugués")
#rect.hclust(studentporclust, k=8)

# A la vista de los dendogramas se hace un corte en 8 cluster. Si k es menor se pierde mucha información

5.2 Cluster con k-means y k=8 para definir mejor los grupos

# Una vez que tenemos una idea del número de cluster vamos a emplear k-means que nos da mucha información

# Vamos a hacer k-means clustering para k=10
set.seed(1234)

# Matemáticas
studentmatkmeans <- kmeans(studentmat.select, 8)

# Portugués
studentporkmeans <- kmeans(studentpor.select, 8)

# Obtenemos los siguientes data.frame auxiliares para los gráficos y para el análisis

# Matemáticas
studentmatkmeanscenters <- as.data.frame(studentmatkmeans$centers)
studentmatkmeansclusters <- as.data.frame(table(studentmatkmeans$cluster))
studentmatkmeanssummary <- cbind(studentmatkmeanscenters, studentmatkmeansclusters)

# Portugués
studentporkmeanscenters <- as.data.frame(studentporkmeans$centers)
studentporkmeansclusters <- as.data.frame(table(studentporkmeans$cluster))
studentporkmeanssummary <- cbind(studentporkmeanscenters, studentporkmeansclusters)

# Vamos a representar gráficamente los clúster. Sólo mostramos uno.

# Matemáticas
plot(studentmat.select %>% select(G1,G3), col=studentmatkmeans$cluster, main = "Mat- G1-G3")
points(studentmatkmeanscenters %>% select(G1,G3), col="black", pch = 8, cex =2)

#plot(studentmat.select %>% select(G2,G3), col=studentmatkmeans$cluster, main = "Mat- G2-G3")
#points(studentmatkmeanscenters %>% select(G2,G3), col="black", pch = 8, cex =2)

# Portugués
#plot(studentpor.select %>% select(G1,G3), col=studentporkmeans$cluster, main = "Por- G1-G3")
#points(studentporkmeanscenters %>% select(G1,G3), col="black", pch = 8, cex =2)
#plot(studentpor.select %>% select(G2,G3), col=studentporkmeans$cluster, main = "Por- G2-G3")
#points(studentporkmeanscenters %>% select(G2,G3), col="black", pch = 8, cex =2)

5.3 Conclusión del análisis exploratorio

Matemáticas

A continuación se muestran las notas de los centroides y el número de alumnos de cada cluster.

# generamos una tabla con los centroidess y el número de alumnos de los cluster de matemáticas
kable(studentmatkmeanssummary %>% select(G1,G2,G3,Freq))
G1 G2 G3 Freq
10.200000 10.000000 9.400000 5
15.552632 15.631579 15.947368 76
7.560000 7.080000 0.000000 25
7.461538 0.000000 0.000000 13
11.200000 10.400000 10.560000 25
8.096774 8.505376 8.763441 93
11.989583 12.229167 12.239583 96
9.774194 9.548387 9.693548 62

El cluster#1 está formado por 5 alumnos que aprueban la asignatura de manera muy justa pero que habían aprobado los parciales de manera algo más holgada. Este grupo habría que motivarlo un poco para que mejoren.

El cluster#2 está formado por 76 alumnos excelentes, los mejores en matemáticas, que además habían superado los parciales también de manera excelente.

El cluster#3 está formado por 25 alumnos que aunque suspendieron de manera discreta ambos parciales al final han sacado un cero. Este grupo necesita un análisis detallado de las circunstancias y un refuerzo porque están en riesgo de exclusión.

El cluster#4 de 13 alumnos, presenta unas circunstancias parecidas al anterior con el agravante que en el segundo parcial ya habían arrojado la toalla. Este grupo también necesita un análisis detallado y un refuerzo por riesgo de exclusión.

El cluster#5 de 25 alumnos representa un colectivo de chicos que aprueban la asignatura de manera suficiente, algo mejor que el cluster#1 y al igual que aquel necesitan un poco de motivación para que mejoren.

El cluster#6 de 93 alumnos es muy importante porque es muy numeroso, porque han suspendido los parciales y el final de una manera muy justa. Probablemente hayan estudiado matemáticas pero no llegan al mínimo y deberían reforzarse muchísimo para poder alcanzar la asignatura. Este sería el grupo de mejora prioritario.

El cluster#7, que es el más numeroso con 96 alumnos, representa al conjunto de chicos que aprueban la asignetura con buena nota sin ser excelentes, incluso con tendencia positiva entre los parciales y el final.

El cluster#8 es muy parecido al #1, pero mucho más numeroso ya que son 62 alumnos, que aprueban de manera muy justa la asignatura, pero a diferencia de aquel la tendencia es positiva, ya que aunque poco pero mejoran la nota final. La recomendación es la misma que para el cluster#1.

Portugués

A continuación se muestran las notas de los centroides y el número de alumnos de cada cluster.

# generamos una tabla con los centroidess y el número de alumnos de los cluster de portugués
kable(studentporkmeanssummary %>% select(G1,G2,G3,Freq))
G1 G2 G3 Freq
7.117647 4.294118 0.4117647 17
12.189655 12.172414 12.7586207 116
13.478261 13.826087 14.3913043 69
8.980263 9.322368 9.7697368 152
9.258824 9.552941 9.9058824 85
15.471264 15.988506 16.4022989 87
12.075269 12.301075 12.6774194 93
10.400000 10.200000 10.4666667 30

Por resumir tenemos:

El cluster #1 de 17 alumnos que suspenden la asignatura y que deben ser reforzados porque su calificación es pésima, y con tendencia negativa.

Los cluster#4 y #5 que conjuntamente suponen la mitad de la clase aprueban la asignatura de manera justa, y necesitarían una motivación para mejorar.

El resto de cluster aprueban de manera holgada, con especial mención para los 87 alumnos del cluster#6 que son excelentes en portugués.

6 Modelo de regresión lineal para la nota final G3

Vamos a utilizar el paquete Caret de R para la creación y evaluación de los diferentes modelos.

Instalamos los paquetes y librerías necesarios para el preproceso y el modelado.

# Instalamos los paquetes necesarios y las librerías
if (! "mlbench" %in% installed.packages()) install.packages("mlbench", depend = TRUE)
if (! "caret" %in% installed.packages()) install.packages("caret", depend = TRUE)
if (! "ROCR" %in% installed.packages()) install.packages("ROCR", depend = TRUE)
if (! "dplyr" %in% installed.packages()) install.packages("dplyr", depend = TRUE)
library(mlbench)
## Warning: package 'mlbench' was built under R version 3.2.5
library(caret)
## Warning: package 'caret' was built under R version 3.2.5
## 
## Attaching package: 'caret'
## The following object is masked from 'package:survival':
## 
##     cluster
library(ROCR)
## Loading required package: gplots
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
library(dplyr)

Seleccionamos los conjuntos de entrenamiento y de test.

# creamos el conjunto de entrenamiento y test

index.studentmat <- createDataPartition(studentmat$G3, p=0.7, list = F)
index.studentpor <- createDataPartition(studentpor$G3, p=0.7, list = F)

train.studentmat <- studentmat[index.studentmat,]
test.studentmat <- studentmat[-index.studentmat,]

train.studentpor <- studentpor[index.studentpor,]
test.studentpor <- studentpor[-index.studentpor,]

se realiza el preprocesado de las variables, en primer lugar buscando aquellas que tienen la varianza cero o casi cero, y que afectan casi nada al modelo.

Posteriormente se analiza la correlación entre las variables, y se filtran aquellas fuertemente correlacionadas y que serían poco o nada predictoras.

Por último se normalizan las variables predictoras seleccionadas, centrándolas y escalándolas para que unas no influyan más que otras.

# preprocesado de las variables.

# vamos a analizar las variables predictoras con varianza casi nula 
zero.var.train.studentmat <- nearZeroVar(train.studentmat, saveMetrics = T)
#str(zero.var.train.studentmat)
any(zero.var.train.studentmat$zeroVar == T | zero.var.train.studentmat$nzv == T)

[1] TRUE

colnames(train.studentmat)[zero.var.train.studentmat$zeroVar == T | zero.var.train.studentmat$nzv == T]

[1] “higher”

# existe una variable con varianza casi cero que es "higher" y la eliminamos del conjunto de train
train.studentmat$higher <- NULL

# hacemos las mismas operaciones para el dataset de portugués
zero.var.train.studentpor <- nearZeroVar(train.studentpor, saveMetrics = T)
#str(zero.var.train.studentpor)
any(zero.var.train.studentpor$zeroVar == T | zero.var.train.studentpor$nzv == T)

[1] FALSE

# como el resultado es FALSE no existen variables con varianza casi nula o nula

# Vamos a analizar las variables fuertemente correlacionadas

# seleccionamos las variables numéricas para ejecutar cor y descartamos las que lo están por encima del 80%

# Matemáticas
cor.train.studentmat.matrix <- cor(studentmat.select)
cor.train.studentmat.index <- findCorrelation(cor.train.studentmat.matrix, 0.8)
#cor.train.studentmat.index
cor.train.studentmat <- studentmat.select[,-cor.train.studentmat.index]
cor.test.studentmat <- studentmat.select[,-cor.train.studentmat.index]

# Portugés
cor.train.studentpor.matrix <- cor(studentpor.select)
cor.train.studentpor.index <- findCorrelation(cor.train.studentpor.matrix, 0.8)
#cor.train.studentpor.index
# Según este índice tendríamos que eliminar la columna 16 que es G3, que no tiene sentido, por lo que vamos a eliminar las mismas columnas que en matemáticas
cor.train.studentpor <- studentpor.select[,-cor.train.studentmat.index]
cor.test.studentpor <- studentpor.select[,-cor.train.studentmat.index]

# centramos y escalamos las variables mediante la función preProcess de Caret

# Matemáticas
index.cor.train.studentmat <-  preProcess(cor.train.studentmat)
prep.cor.train.studentmat <- predict(index.cor.train.studentmat, cor.train.studentmat)
index.cor.test.studentmat <-  preProcess(cor.test.studentmat)
prep.cor.test.studentmat <- predict(index.cor.test.studentmat, cor.test.studentmat)

# Portugués
index.cor.train.studentpor <-  preProcess(cor.train.studentpor)
prep.cor.train.studentpor <- predict(index.cor.train.studentpor, cor.train.studentpor)
index.cor.test.studentpor <-  preProcess(cor.test.studentpor)
prep.cor.test.studentpor <- predict(index.cor.test.studentpor, cor.test.studentpor)

Una vez seleccionados los conjuntos de entrenamiento y preprocesadas las variables, generamos el modelo de regresión lineal con todas las variables seleccionadas.

# creamos el modelo de regresión lineal

# Matemáticas
lineal.studentmat <- lm(G3 ~ ., data = prep.cor.train.studentmat)
#summary(lineal.studentmat)

# Portugués
lineal.studentpor <- lm(G3 ~ ., data = prep.cor.train.studentpor)
#summary(lineal.studentmat)

Una vez generados los modelos de regresión lineal, vamos a hacer la evaluación de los mismos.

Concretamente la métrica de evaluación que vamos a emplear es R2, así que vamos a calcular dicho valor y analizar los resultados

# la predicción del modelo sobre el conjunto de test

# Matemáticas
pred.test.lineal.studentmat <- predict(lineal.studentmat, newdata=prep.cor.test.studentmat)

# Portugués
pred.test.lineal.studentpor <- predict(lineal.studentpor, newdata=prep.cor.test.studentpor)

# Calculamos RSS, TSS y R2

# Matemáticas
RSSmat = sum((test.studentmat$G3 - pred.test.lineal.studentmat)^2)
## Warning in test.studentmat$G3 - pred.test.lineal.studentmat: longitud de
## objeto mayor no es múltiplo de la longitud de uno menor
TSSmat = sum((test.studentmat$G3 - mean(train.studentmat$G3))^2)
R2mat = 1 - (RSSmat/TSSmat)
R2mat

[1] -20.38408

# Portugués
RSSpor = sum((test.studentpor$G3 - pred.test.lineal.studentpor)^2)
## Warning in test.studentpor$G3 - pred.test.lineal.studentpor: longitud de
## objeto mayor no es múltiplo de la longitud de uno menor
TSSpor = sum((test.studentpor$G3 - mean(train.studentpor$G3))^2)
R2por = 1 - (RSSpor/TSSpor)
R2por

[1] -52.91715

Comentarios del primer modelo de regresión lineal.

A la vista de los resultados, este modelo no tiene sentido, o nos hemos equivocado en la ejecución.

Vamos a crear un nuevo modelo de regresión lineal en el que incorporamos todas las variables predictoras del dataset, sin correlaciones ni preprocesado. Ya veremos.

# Nuevos modelos de regresión, incluyendo todas las variables, sin desechar las correlacionadas, ni normalizarlas. 

lineal.rev.studentmat <- lm(G3 ~ ., data = train.studentmat)
#summary(lineal.rev.studentmat)

lineal.rev.studentpor <- lm(G3 ~ ., data = train.studentpor)
#summary(lineal.rev.studentpor)

vamos a realizar la evaluación de este nuevo modelo

# la predicción del modelo sobre el conjunto de test

pred.test.lineal.rev.studentmat <- predict(lineal.rev.studentmat, newdata=test.studentmat)
## Warning in predict.lm(lineal.rev.studentmat, newdata = test.studentmat):
## prediction from a rank-deficient fit may be misleading
pred.test.lineal.rev.studentpor <- predict(lineal.rev.studentpor, newdata=test.studentpor)
## Warning in predict.lm(lineal.rev.studentpor, newdata = test.studentpor):
## prediction from a rank-deficient fit may be misleading
# Calculamos RSS, TSS y R2

RSSmat = sum((test.studentmat$G3 - pred.test.lineal.rev.studentmat)^2)
TSSmat = sum((test.studentmat$G3 - mean(train.studentmat$G3))^2)
R2mat = 1 - (RSSmat/TSSmat)
R2mat

[1] 0.8232051

RSSpor = sum((test.studentpor$G3 - pred.test.lineal.rev.studentpor)^2)
TSSpor = sum((test.studentpor$G3 - mean(train.studentpor$G3))^2)
R2por = 1 - (RSSpor/TSSpor)
R2por

[1] 0.9036898

Análisis de la evaluación del segundo modelo de regresión lineal

Este nuevo modelo en bruto de regresión lineal incorporando todas las variables predictoras captura más de un 82% de fiabilidad de ellas en matemáticas y algo más de un 90% en portugués, por lo que puede ser considerado un modelo razonable de predicción de la nota final.

7 Modelo de regresión logística para la nota final G3

vamos a crear un modelo de regresión logística para G3. En este modelo lo que vamos a intentar es precedir si un alumno aprobará o no en función de las variables predictoras.

Creación del modelo de regresión logística o clasificación binaria.

# vamos a crear un modelo de regresión logística para G3

log.studentmat = glm(aprobado~ ., data = train.studentmat, family=binomial)
## Warning: glm.fit: algorithm did not converge
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#summary(log.studentmat)

log.studentpor = glm(aprobado~ ., data = train.studentpor, family=binomial)
## Warning: glm.fit: algorithm did not converge

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#summary(log.studentpor)

Vamos a evaluar el modelo.

Para ello generamos primero una predicción sobre el mismo conjunto de entrenamiento para ver con qué precisión nos estamos moviendo.

Una vez hecha la predicción, generamos las matrices de confusión con un umbral del 50%, y sobre éstas calculamos la precisión general del modelo.

# la predicción del modelo sobre el conjunto de train con un umbral del 50% genera las dos siguientes matrices de confusión o de clasificación

pred.train.log.studentmat <- predict(log.studentmat, type="response")

# para arreglar un error ya que este vector tiene un valor menos que la variable aprobado, añadimos un valor adicional de 0.5 a este vector

pred.train.log.studentmat <- c(pred.train.log.studentmat, 0.5)

pred.train.log.studentpor <- predict(log.studentpor, type="response")

table(train.studentmat$aprobado, pred.train.log.studentmat >= 0.5)
FALSE TRUE

0 32 58 1 58 131

table(train.studentpor$aprobado, pred.train.log.studentpor >= 0.5)
FALSE TRUE

0 71 0 1 0 385

# la precisión conseguida sobre el conjunto de entrenamiento parece muy justa para el dataset de matemáticas y sorprendentemente buena para el de portugués

precision.log.mat <- (32+131)/279
precision.log.mat

[1] 0.5842294

precision.log.por <- (385+71)/476
precision.log.por

[1] 0.9579832

Como vemos la estimación no es muy buena para las matemáticas, pero es excelente para el portugués.

A continuación elaboramos la curva ROC y estimamos el área bajo la curva, que es la medida más fina de la precisión del modelo.

# calculo de la curva ROC para matemáticas
ROC.Pred.mat = prediction(pred.train.log.studentmat, train.studentmat$aprobado)
ROC.Perf.mat = performance(ROC.Pred.mat, "tpr", "fpr")
#plot(ROC.Perf.mat)
#plot(ROC.Perf.mat, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(-0.2,1.7), main = "Curva ROC Matemáticas")

# calculo de la curva ROC para portugués
ROC.Pred.por = prediction(pred.train.log.studentpor, train.studentpor$aprobado)
ROC.Perf.por = performance(ROC.Pred.por, "tpr", "fpr")
#plot(ROC.Perf.por)
#plot(ROC.Perf.por, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(-0.2,1.7), main = "Curva ROC Portugués")

# para calcular el área bajo la curva, que nos da una medida de la precisión del modelo 
as.numeric(performance(ROC.Pred.mat, "auc")@y.values)

[1] 0.5443563

as.numeric(performance(ROC.Pred.por, "auc")@y.values)

[1] 1

Demasiado justa es el AUC para el dataset de matemáticas, y demasiado buena es el AUC para el de portugués, pero bueno… ya veremos con el conjunto de test.

A continuación vamos a realizar las mismas operaciones pero sobre el conjunto de Test, y vamos a ver qué es lo que ocurre.

# vamos a ver la precisión del modelo en el conjunto de test

pred.test.log.studentmat <- predict(log.studentmat, newdata=test.studentmat,type="response")
## Warning in predict.lm(object, newdata, se.fit, scale = 1, type =
## ifelse(type == : prediction from a rank-deficient fit may be misleading
pred.test.log.studentpor <- predict(log.studentpor, newdata=test.studentpor,type="response")
## Warning in predict.lm(object, newdata, se.fit, scale = 1, type =
## ifelse(type == : prediction from a rank-deficient fit may be misleading
table(test.studentmat$aprobado, pred.test.log.studentmat >= 0.5)
FALSE TRUE

0 40 0 1 0 76

table(test.studentpor$aprobado, pred.test.log.studentpor >= 0.5)
FALSE TRUE

0 29 0 1 0 164

# la precisión parece demasiado buena

precision.log.mat <- (40+76)/116
precision.log.mat

[1] 1

precision.log.por <- (29+164)/193
precision.log.por

[1] 1

La precisión es extraordinaria, demasiado buena…

# calculo de la curva ROC para matemáticas
ROC.Pred.test.mat = prediction(pred.test.log.studentmat, test.studentmat$aprobado)
ROC.Perf.test.mat = performance(ROC.Pred.test.mat, "tpr", "fpr")
#plot(ROC.Perf.test.mat)
#plot(ROC.Perf.test.mat, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(-0.2,1.7), main = "Curva ROC de Test Matemáticas")

# calculo de la curva ROC para portugués
ROC.Pred.test.por = prediction(pred.test.log.studentpor, test.studentpor$aprobado)
ROC.Perf.test.por = performance(ROC.Pred.test.por, "tpr", "fpr")
#plot(ROC.Perf.test.por)
#plot(ROC.Perf.test.por, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(-0.2,1.7), main = "Curva ROC de Test Portugués")

# para calcular el área bajo la curva, que nos da una medida de la precisión del modelo 
as.numeric(performance(ROC.Pred.test.mat, "auc")@y.values)

[1] 1

as.numeric(performance(ROC.Pred.test.por, "auc")@y.values)

[1] 1

Tanto las curvas ROC como el área son perfectas. El modelo no puede ser tan bueno, algo tiene que haber salido mal, así que ya hablamos.

Tengo previsto sacar una nueva versión de este documento incluyendo un modelo para la clasificación en cinco niveles de la nota final, aplicando árboles de decisión CART con el paquete rpart, y además con randomForest. Lo entregaré cuando esté listo.

He limitado el número de figuras a cuatro como se exige, pero no controlo el número de páginas con Rmarkdown todavía, así que lo mismo me he pasado, en ese caso lo comentamos y reduzco el documento.

En espera de vuestros comentarios, un saludo.

FIN