Proyecto Econometría 1

A continuación se muestra un estudio utilizando regresiones logísticas simples y múltiples para predecir una variable categórtica.

El Estudio pretende encontrar un modelo de regresión logística para predecir si un alumno del curso de Matemáticas puede aprobar o no dicho curso utiliando las notas obtenidas del primer, segundo parcial y examen final como variables explicatorias.

Se mostaran seis modelos, en los primeros tres se pretende predecir si el alumno gana o no la clase con una regresión logística simple, asignando una probabilidad en función de la nota del primer parcial, segundo parcial y el examen final.

Despues se mostrará una regresión logística múltiple, para asignar un valor de probabilidad al par de notas formado por las notas del (primer parcial -segundo parcial), (segundo parcial - examen final) y por último (primer parcial - examen final).

Es importante recalcar que estamos asumiendo que todos los examenes tanto parciales como final, tiene la misma ponderación en el curso:

#Cargamos librerias
library(dplyr)
library(ggplot2)

#Cargamos DataSet.
data_set<- read.csv('Research2filePreng.csv')
#View(data_set)

Primero Limparemos y Ajustaremos la Data

#Personalizamos el data frame
data_set<-data_set %>%
  select(Curso02, Seccion03, Carrera04, Fecha06, Ciclo07, 
    Genero10, PrimerParcial11, SegundoParcial13, ExamenFinal15, NotaFinal17) %>%
  filter(Ciclo07 != "NA") #Eliminamos Filas con NA
#Cambio de Nombres de Columna
colnames(data_set)<-c("Curso", "Sec", "Carrera", "Smst", "Año", "Genero", "EP1",
                      "EP2", "EF", "NF") 

El dataset quedaría de esta manera

head(data_set)

En General Cuantos Alumnos Hombres y Mujeres Han Habido:

gen_summary<- data_set %>%
  select(Genero)%>%
  group_by(Genero) %>%
  summarise(Total=sum(Genero))
gen_summary$Genero[1]="Masculino"
gen_summary$Genero[2]="Femenino"
gen_summary

Graficando tenemos:

gen_summary %>%
  ggplot(aes(x=Genero, y=Total)) +
  geom_bar(stat = "identity", fill=c("pink", "light blue"))

Agregamos columna si el alumno aprobo o no (variable para clasificación)

data_set$Aprob<-ifelse((data_set$NF >= 61), yes=1, no=0)

Ahora extraemos la data del curso de matematica que nos interesa:

#Matemática 1
mate1<-data_set %>%
  filter(Curso == "Matematica I") %>%
  filter(Curso != "NA")

Separaremos la data en 70% para entrenamiento y 30% para pruebas:

#Subsets de datos para entrenamiento y pruebas Matematica 1
train_mate1<-mate1[c(1:round(0.7*nrow(mate1))),]
test_mate1<-mate1[c(round(0.7*nrow(mate1)) + 1: nrow(mate1)),]
test_mate1<- test_mate1 %>%
  filter(Sec != "NA")

Modelo 1: Influencia en la Nota del Primer Parcial en Aprobar el Curso:

#Modelo para Matematica 1:
mod1<-glm(data=train_mate1,  formula = Aprob ~ EP1, family = binomial(link="logit"))
#Agregando el Modelo:
xv<-seq(min(train_mate1$EP1), max(train_mate1$EP1), 0.01)
yv<-predict(object=mod1, list(EP1=xv), type="response")
demo_plot1<-data.frame(xv, yv)
names(demo_plot1)<-c("Nota", "Probabilidad")
logitplot_1<-ggplot(data=demo_plot1, aes(x=Nota, y=Probabilidad)) + geom_line()
plotm1 <- train_mate1 %>%
  arrange(EP1) %>%
  ggplot(aes(x=EP1, y=Aprob)) +
  geom_point() + geom_line(data=demo_plot1, aes(x=Nota, y=Probabilidad), color="blue") +
  labs(x = "Nota Parcial 1") +
  labs(y = "Probabilidad")+
  ggtitle("Probabilidad de Ganar el Curso en función de la Nota de Parcial 1") +
  theme_minimal()
#Graficando tenemos.
plotm1

A continuación se muestra la informaación mas importante del modelo 1:

• Los coeficientes son:
• El intercepto del modelo es -4.4468757.
• El coeficiente del modelo es 0.0765029.
• Podemos decir que ambos coeficientes tienen significacncia en el modelo ya que el valor P de ambos es 210^{-16}.

La ecución del modelo es:

\[ P(\small{EP1})=\frac{1}{1+e^{-[(0.0765)-4.447*(EP1)]}}\]

A continuación mostratemos una predicciones en base al modelo 1 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del primer parcial, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5:

prediccion1<-predict(object=mod1, newdata=test_mate1, type="response")
resultado1<-data.frame(test_mate1$EP1, (as.data.frame(prediccion1))$prediccion1)
resultado1$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado1)<-c("Nota", "Probabilidad", "Aprobo Clase")
resultado1$Prediccion<- ifelse((resultado1$Probabilidad >= 0.5), yes=1, no=0)
resultado1 %>% arrange(Nota)

Calculando efectividad:

a<-0
i<-1
for(i in (1:nrow(resultado1))){
  if(resultado1$`Aprobo Clase`[[i]] == resultado1$Prediccion[[i]]){
    a<-a+1
  } else {
    a<-a
  }
}
ef1<-a/nrow(resultado1)

El modelo 1 tiene un 0.7625418 de efectividad.

Modelo 2: Influencia en la Nota del Segundo Parcial en Aprobar el Curso

#Modelo para Matematica 1:
mod2<-glm(data=train_mate1,  formula = Aprob ~ EP2, family = binomial(link="logit"))
#Agregando el Modelo:
xv<-seq(min(train_mate1$EP2), max(train_mate1$EP2), 0.01)
yv<-predict(object=mod2, list(EP2=xv), type="response")
demo_plot2<-data.frame(xv, yv)
names(demo_plot2)<-c("Nota", "Probabilidad")
logitplot_2<-ggplot(data=demo_plot2, aes(x=Nota, y=Probabilidad)) + geom_line()
plotm2 <- train_mate1 %>%
  arrange(EP2) %>%
  ggplot(aes(x=EP2, y=Aprob)) +
  geom_point() + geom_line(data=demo_plot2, aes(x=Nota, y=Probabilidad), color="red") +
  labs(x = "Nota Parcial 2") +
  labs(y = "Probabilidad")+
  ggtitle("Probabilidad de Ganar el Curso en función de la Nota de Parcial 2") +
  theme_minimal()
#Graficando tenemos.
plotm2

A continuación se muestra la informaación mas importante del modelo 2:

• Los Parametros del modelo son:
• El intercepto del modelo es -5.613524.
• El coeficiente del modelo es 0.1059263.
• Podemos decir que ambos parametros tienen significacncia en el modelo ya que el valor P de ambos es 210^{-16}.

La ecución del modelo es:

\[ P(\small{EP2})=\frac{1}{1+e^{-[(0.1059)-5.6135*(EP2)]}}\]

##### A continuación mostratemos una predicciones en base al modelo 2 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del primer segundo, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5:

prediccion2<-predict(object=mod2, newdata=test_mate1, type="response")
resultado2<-data.frame(test_mate1$EP2, (as.data.frame(prediccion2))$prediccion2)
resultado2$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado2)<-c("Nota", "Probabilidad", "Aprobo Clase")
resultado2$Prediccion<- ifelse((resultado2$Probabilidad >= 0.5), yes=1, no=0)
resultado2 %>% arrange(Nota) ## Ordenamos el arreglo

Calculando efectividad:

a<-0
i<-1
for(i in (1:nrow(resultado2))){
  if(resultado2$`Aprobo Clase`[[i]] == resultado2$Prediccion[[i]]){
    a<-a+1
  } else {
    a<-a
  }
}
ef2<-a/nrow(resultado2)

El modelo 2 tiene un 0.8595318 de efectividad.

Modelo 3: Influencia en la Nota del Examen Final en Aprobar el Curso

#Modelo para Matematica 1:
mod3<-glm(data=train_mate1,  formula = Aprob ~ EF , family = binomial(link="logit"))
#Agregando el Modelo:
xv<-seq(min(train_mate1$EF), max(train_mate1$EF), 0.01)
yv<-predict(object=mod3, list(EF=xv), type="response")
demo_plot3<-data.frame(xv, yv)
names(demo_plot3)<-c("Nota", "Probabilidad")
logitplot_3<-ggplot(data=demo_plot3, aes(x=Nota, y=Probabilidad)) + geom_line()

Graficando Tenemos:

plotm3 <- train_mate1 %>%
  arrange(EF) %>%
  ggplot(aes(x=EF, y=Aprob)) +
  geom_point() + geom_line(data=demo_plot3, aes(x=Nota, y=Probabilidad), color="green") +
  labs(x = "Nota Examen Final") +
  labs(y = "Probabilidad")+
  ggtitle("Probabilidad de Ganar el Curso en función de la Nota del Examen Final") +
  theme_minimal()
plotm3

A continuación se muestra la informaación mas importante del modelo 3:

• Los Parametros del modelo son:
• El intercepto del modelo es -3.9102457.
• El coeficiente del modelo es 0.0933747.
• Podemos decir que ambos parametros tienen significacncia en el modelo ya que el valor P de ambos es 210^{-16}.

La ecución del modelo es:

\[ P(\small{EP2})=\frac{1}{1+e^{-[(0.0934)-3.9102*(EP2)]}}\] ##### ##### A continuación mostratemos una predicciones en base al modelo 3 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del examen final, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5:

prediccion3<-predict(object=mod3, newdata=test_mate1, type="response")
resultado3<-data.frame(test_mate1$EF, (as.data.frame(prediccion3))$prediccion3)
resultado3$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado3)<-c("Nota", "Probabilidad", "Aprobo Clase")
resultado3$Prediccion<- ifelse((resultado3$Probabilidad >= 0.5), yes=1, no=0)
resultado3 %>% arrange(Nota) ## Orgenamos el arreglo

Calculando efectividad:

a<-0
i<-1
for(i in (1:nrow(resultado3))){
  if(resultado3$`Aprobo Clase`[[i]] == resultado3$Prediccion[[i]]){
    a<-a+1
  } else {
    a<-a
  }
}
ef3<-a/nrow(resultado3)

El modelo 3 tiene un 0.8528428 de efectividad.

Gráficas de Probabilidad:

xv<-seq(0, 100, 0.01)
yv1<-predict(object=mod1, list(EP1=xv), type="response")
yv2<-predict(object=mod2, list(EP2=xv), type="response")
yv3<-predict(object=mod3, list(EF=xv), type="response")
demo_plot1<-data.frame(xv, yv1)
demo_plot2<-data.frame(xv, yv2)
demo_plot3<-data.frame(xv, yv3)
names(demo_plot1)<-c("Nota", "Probabilidad")
names(demo_plot2)<-c("Nota", "Probabilidad")
names(demo_plot3)<-c("Nota", "Probabilidad")

 test_mate1 %>% 
  ggplot(aes(x=EF, y=Aprob)) +
  geom_blank() + geom_line(data=demo_plot1, aes(x=Nota, y=Probabilidad,  fill=Probabilidad), color="blue")+
  geom_line(data=demo_plot2, aes(x=Nota, y=Probabilidad), color="red") +
  geom_line(data=demo_plot3, aes(x=Nota, y=Probabilidad), color="green") +
  labs(x = "Nota Examen (0-100)") +
  labs(y = "Probabilidad" )+
  ggtitle("Probabilidad de Ganar el Curso en función de la Nota obtenida") +
  scale_x_continuous(breaks=seq(0,100,by=10)) +
  theme_minimal()

Ignoring unknown aesthetics: fill

En la grafica anterior se muestan la regresión logistica simple de cada modelo obtenido para compararlos, donde la azul es la probabilidad de aprobar el curso en función de la nota del primer parcial, la roja es la probabilidad de ganar el curso en función de la nota del segundo parcial, y la verde es la probabilidad de ganar el curso en función de la nota del examen final.

Ahora mostraremos tres modelos de regresión logistica múltiple, utilizando combinaciones de dos examens para encontrar la probabilidad de que un alumno apreuebe/repruebe la clase.

Modelo 4: Influencia del Primer y Segundo Parcial:

library(plotly)
#Modelo Regresión Logistica Multiple, Examen Parcial 1 y Examen Parcial 2:
mod4<-glm(data=train_mate1,  formula = Aprob ~ EP1 + EP2 , family = binomial(link="logit"))
#Definiendo Dominio:
x4<-seq(0, 100, 1)
y4<-seq(0, 100, 1)
domain<-expand.grid(x4,y4)
names(domain)<-c("EP1", "EP2")
z4<-predict(mod4, domain, type="response")
d<-data.frame(z4)
z4<-d$z4
data_xy=data.frame(domain$EP1, domain$EP2, z4)

Graficando Tenemos:

#plot_ly(z = z4, type = "surface", )
p <- plot_ly(x =domain$EP1, y = domain$EP2, z = z4, type = "heatmap", xaxis=domain$EP1, yaxis=domain$EP2,
  colorbar = list(title = "Probabilidad")) %>%
  layout(title = 'Probabilidad de Ganar el Curso vrs Parcial 1 y Parcial 2', xaxis = list(title = 'Nota Parcial 1') , yaxis = list(title = 'Nota Parcial 2'))
p

A continuación se muestra la informaación mas importante del modelo 4:

• Los Parametros del modelo son:
• El intercepto del modelo es -8.6398793.
• El coeficiente del modelo es 0.0582498.
• El coeficiente del modelo es 0.099308.
• Podemos decir que ambos parametros tienen significacncia en el modelo ya que el valor P de ambos es 210^{-16}.

La ecución del modelo es:

\[ P(\small{EP1, EP2})=\frac{1}{1+e^{-[-8.6398+0.0582*(EP1)+0.09931*(EP2)]}}\] #####A continuación mostratemos una predicciones en base al modelo 4 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del primer parcial, la nota del segundo parcial, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5:

prediccion4<-predict(object=mod4, newdata=test_mate1, type="response")
resultado4<-data.frame(test_mate1$EP1, test_mate1$EP2, (as.data.frame(prediccion4))$prediccion4)
resultado4$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado4)<-c("Nota EP1", "Nota EP2", "Probabilidad", "Aprobo Clase")
resultado4$Prediccion<- ifelse((resultado4$Probabilidad >= 0.5), yes=1, no=0)
resultado4 %>% arrange(`Nota EP1`) ## Orgenamos el arreglo

Calculando efectividad:

b<-0
i<-1
for(i in (1:nrow(resultado4))){
  if(resultado4$`Aprobo Clase`[[i]] == resultado4$Prediccion[[i]]){
    b<-b+1
  } else {
    b<-b
  }
}
ef4<-b/nrow(resultado4)

El modelo 4 tiene un 0.8528428 de efectividad.

Modelo 5: Influencia del Primer Parcial y Examen Final:

#Modelo para Matematica 1:
mod5<-glm(data=train_mate1,  formula = Aprob ~ EP1 + EF , family = binomial(link="logit"))
#Agregando el Modelo:
domain<-expand.grid(x4,y4)
x4<-seq(0, 100, 1)
y4<-seq(0, 100, 1)
names(domain)<-c("EP1", "EF")
z4<-predict(mod5, domain, type="response")
d<-data.frame(z4)
z4<-d$z4
data_xy=data.frame(domain$EP1, domain$EF, z4)

Graficando tenemos:

#plot_ly(z = z4, type = "surface", )
p <- plot_ly(x =domain$EP1, y = domain$EF, z = z4, type = "heatmap", xaxis=domain$EP1, yaxis=domain$EF,
  colorbar = list(title = "Probabilidad")) %>%
  layout(title = 'Probabilidad de Ganar el Curso vrs Parcial 1 y Final', xaxis = list(title = 'Nota Parcial 1') , yaxis = list(title = 'Nota Examen Final'))
p

A continuación se muestra la informaación mas importante del modelo 5:

• Los Parametros del modelo son:
• El intercepto del modelo es -7.9954419.
• El coeficiente del modelo es 0.0682128.
• El coeficiente del modelo es 0.0936558.
• Podemos decir que ambos parametros tienen significacncia en el modelo ya que el valor P de ambos es \(2*10^{-16}\).

La ecución del modelo es:

\[ P(\small{EP1, EF})=\frac{1}{1+e^{-[-7.9954+0.06821*(EP1)+0.0935*(EF)]}}\] ##### A continuación mostratemos una predicciones en base al modelo 5 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del primer parcial, la nota del examen final, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5::

prediccion5<-predict(object=mod5, newdata=test_mate1, type="response")
resultado5<-data.frame(test_mate1$EP1, test_mate1$EF, (as.data.frame(prediccion5))$prediccion5)
resultado5$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado5)<-c("Nota EP1", "Nota EF", "Probabilidad", "Aprobo Clase")
resultado5$Prediccion<- ifelse((resultado5$Probabilidad >= 0.5), yes=1, no=0)
resultado5 %>% arrange(`Nota EP1`) ## Orgenamos el arreglo

Calculando efectividad:

a<-0
i<-1
for(i in (1:nrow(resultado5))){
  if(resultado5$`Aprobo Clase`[[i]] == resultado5$Prediccion[[i]]){
    a<-a+1
  } else {
    a<-a
  }
}
ef5<-a/nrow(resultado5)

El modelo 5 tiene un 0.9565217 de efectividad.

Modelo 6: Influencia del Segundo Parcial y Examen Final:

#Modelo para Matematica 1:
mod6<-glm(data=train_mate1,  formula = Aprob ~ EP2 + EF , family = binomial(link="logit"))
#Agregando el Modelo:
domain<-expand.grid(x4,y4)
x4<-seq(0, 100, 1)
y4<-seq(0, 100, 1)
names(domain)<-c("EP2", "EF")
z4<-predict(mod6, domain, type="response")
d<-data.frame(z4)
z4<-d$z4
data_xy=data.frame(domain$EP2, domain$EF, z4)

Graficando Tenemos:

#plot_ly(z = z4, type = "surface", )
p <- plot_ly(x =domain$EP2, y = domain$EF, z = z4, type = "heatmap", xaxis=domain$EP2, yaxis=domain$EF,
  colorbar = list(title = "Probabilidad")) %>%
  layout(title = 'Probabilidad de Ganar el Curso vrs Parcial 2 y Final', xaxis = list(title = 'Nota Parcial 2') , yaxis = list(title = 'Nota Examen Final'))
p

A continuación se muestra la informaación mas importante del modelo 6:

• Los Parametros del modelo son:
• El intercepto del modelo es -9.8516948.
• El coeficiente del modelo es 0.1098379.
• El coeficiente del modelo es 0.0928167.
• Podemos decir que ambos parametros tienen significacncia en el modelo ya que el valor P de ambos es \(2*10^{-16}\).

La ecución del modelo es:

\[ P(\small{EP2, EF})=\frac{1}{1+e^{-[-9.8516+0.1098*(EP2)+0.09282*(EF)]}}\] #####A continuación mostratemos una predicciones en base al modelo 4 asumiendo que si la probabilidad es mayor a 0.5, entonces el alumno aprobara el curso, el frame de datos esta formado por la nota del segundo parcial, la nota del examen final, la probabilidad obtenida por el modelo, si el alumno aprobo o no el curso y la predicción obtenida con el modelo si la probabilidad es mayor a 0.5::

prediccion6<-predict(object=mod6, newdata=test_mate1, type="response")
resultado6<-data.frame(test_mate1$EP2, test_mate1$EF, (as.data.frame(prediccion6))$prediccion6)
resultado6$Aprobo<- test_mate1$Aprob #Agregamos columna del resultado
names(resultado6)<-c("Nota EP1", "Nota EF", "Probabilidad", "Aprobo Clase")
resultado6$Prediccion<- ifelse((resultado6$Probabilidad >= 0.5), yes=1, no=0)
resultado6 %>% arrange(`Nota EP1`) ## Orgenamos el arreglo

Calculando efectividad:

a<-0
i<-1
for(i in (1:nrow(resultado6))){
  if(resultado6$`Aprobo Clase`[[i]] == resultado6$Prediccion[[i]]){
    a<-a+1
  } else {
    a<-a
  }
}
ef6<-a/nrow(resultado5)

El modelo 1 tiene un 0.9698997 de efectividad.

Conclisiones:

De los modelos mostrados anteriormente, podemos notar que en general todos los examens tiene una influencia importante en aprobar el curso de matematica o no, sin embargo, es interesante ver que la eficiencia de los modelos que involucran al examen final son superiores, por tanto es vital que los alumnos le pongan mas empeño al examen final, según nuestro estudio.