Problema de Deserción Universitaria
Erickson Abismel Sierra García
26/10/2020
Explicación del Problema
En esta ocasión atenderemos el problema de deserción escolar universidad, la idea es que partiendo de la Data proporcionada podamos identificar los alumnos con riesgo de deserción, para ello lo primero que nos disponemos es emplear un método de Agrupación para nuestro caso usaremos los K vecinos mas cercanos o mejor conocido como kmeans.
Luego nos dispondremos a crear modelo predictivo basado en red neuronal, para ello dividiremos la Data en predicción 20% y entrenamiento 80%, este nos servirá para evaluar nuestro modelo.
Por ultimo proporcionaremos una herramienta para uso del usuario final basado en Shiny, donde el podrá constatar los resultados encontrados e interactuar con la información.
La Data
Todo problema de analitica que anfrontamos sin importar su naturaleza parte de los datos, es por eso que antes de prantear caminos de solucion al problema planteado es necesario y fundamental conocer los datos a fondo y el significado que ellos conlleban.
es porque en los siguiente apartado nos detendremos a cococer la data proporcionada, la integraremos en un solo congunto de datos y por ultimo exporaremos para determinar varias cosas como, la calidad de los datos, caracteristica de la data, relaciones y correlaciones.
Cargamos los Datos:
AsistenciasTotales:
Nombre de la Variable: asistencias.totales, esta lista que contiene 32 observaciones de asistencias de 1000 estudiantes para 54 materias, de las cuales las 6 primeras corresponden al primer semestre, cada observacion puede tener 3 estados:
- 0 <- “No asistio”
- 1 <- “Llego despues de pasar lista”
- 2 <- “Asistio a tiempo”
setwd("D:/Analitica de Datos/Proyecto/Data")
#### asistencias.totales
load("AsistenciasTotales.R")perfilAlumnos:
Nombre de la Variable perfil.alumnos es el hombre de esta dataframe que contiene informacion de perfil del estudiante, esta data se obtiene del estudiante antes de entrar a la carrera contiene la siguiente informacion:
- genero: es un numero entero que representa el sexo 1 hombre 2 mujer
- admision.letras: un valor numerico hasta 100 que indica el puntaje en la prueba de admision letras
- admision.numeros: un valor numerico hasta 100 que indica el puntaje en la prueba de admision numeros
- promedio.preparatoria: un valor numerico hasta 100 que indica el promedio en la preparatoria
- edad.ingreso: edad con la ingreso a la universidad
- evalucion.socioeconomica: un numero entero que indica el estrato
- nota.conducta: un valor numerico hasta 20 que indicala nota de conducta en la preparatoria.
#### perfil.alumnos
setwd("D:/Analitica de Datos/Proyecto/Data")
load("perfilAlumnos.R")
summary(perfil.alumnos)## genero admision.letras admision.numeros promedio.preparatoria
## Min. :1.000 Min. :44.94 Min. : 4.878 Min. : 60.00
## 1st Qu.:1.000 1st Qu.:56.61 1st Qu.:28.226 1st Qu.: 60.00
## Median :2.000 Median :59.98 Median :34.970 Median : 69.95
## Mean :1.595 Mean :60.06 Mean :35.114 Mean : 72.25
## 3rd Qu.:2.000 3rd Qu.:63.64 3rd Qu.:42.275 3rd Qu.: 80.91
## Max. :2.000 Max. :77.71 Max. :70.411 Max. :100.00
## edad.ingreso evalucion.socioeconomica nota.conducta
## Min. :11.00 Min. :1.000 Min. : 9.00
## 1st Qu.:16.00 1st Qu.:3.000 1st Qu.:14.00
## Median :17.00 Median :4.000 Median :15.00
## Mean :17.53 Mean :3.466 Mean :15.53
## 3rd Qu.:19.00 3rd Qu.:4.000 3rd Qu.:17.00
## Max. :25.00 Max. :4.000 Max. :20.00HistorialPagos:
registro.pagos es el nombre de la variable y es una lista que contiene el historial de pago del estudiante por cada semestre, en cada uno de los cuales realiza 4 pagos cada registro puede contener uno de los siguientes valores:
- 0 <- “un pago muy tarde”
- 1 <- “pago tarde”
- 2 <- “pago a tiempo”
#### perfil.alumnos
setwd("D:/Analitica de Datos/Proyecto/Data")
#### registro.pagos
load("HistorialPagos.R")
registro.pagos[[1]]## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 2 2 2 2 2 1 0 2 2
## [2,] 2 2 2 2 2 0 2 2 2
## [3,] 2 2 2 2 2 2 2 2 2
## [4,] 2 2 2 2 2 2 2 2 2ResultadosExamenes
resultados.examenes.totales es el nombre de la variable, la cual se trata de una lista que contiene 1000 alumnos en 54 materias de las cuales las 6 primeras corresponden al primer semestre, por cada materia se tomaron 2 notas con un rango de valores de 0-20
setwd("D:/Analitica de Datos/Proyecto/Data")
#### resultados.examenes.totales
load("ResultadosExamenes.R")ResultadoTrabajos
resultados.trabajos.totales es el nombre de la variable, la cual se trata de una lista que contiene 1000 alumnos en 54 materias de las cuales las 6 primeras corresponden al primer semestre, por cada materia se tomaron 4 notas con un rango de valores de 0-20
setwd("D:/Analitica de Datos/Proyecto/Data")
#### resultados.trabajos.totales
load("ResultadoTrabajos.R")UsoBiblioteca
uso.biblioteca.totales es el nombre de la variable, la cual se trata de una lista que contiene 1000 alumnos en 54 materias de las cuales las 6 primeras corresponden al primer semestre, se registra en cada variable el numero de horas que el estudiante uso la boiblioteca
setwd("D:/Analitica de Datos/Proyecto/Data")
#### uso.biblioteca.totales
load("UsoBiblioteca.R")
uso.biblioteca.totales[[1]]## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 12.65509 11.84882 11.68042 33.787 12.00214 34.09402 2.977819 14.66295
## [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]
## [1,] 12.21601 15.07478 12.7725 10.69361 35.65484 12.54034 34.03171 16.8311
## [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
## [1,] 27.32576 68.22896 11.17131 38.16282 2.57223 13.04277 15.76604 12.92574
## [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32]
## [1,] 14.16118 10.16592 19.7175 10.28575 26.49522 10.98783 15.22158 15.05841
## [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40]
## [1,] 14.4594 14.44769 37.84886 16.22378 33.24461 13.99906 31.39589 16.83582
## [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48]
## [1,] 28.20236 19.14806 32.27557 17.43418 16.33373 27.76523 19.76962 15.79166
## [,49] [,50] [,51] [,52] [,53] [,54]
## [1,] 30.48549 35.63091 17.75975 27.4303 15.79189 19.70203UsoPlataforma
uso.plataforma.totales es el nombre de la variable, la cual se trata de una lista que contiene 1000 alumnos en 54 materias de las cuales las 6 primeras corresponden al primer semestre, se registra en cada variable el numero de horas que el estudiante uso la plataforma
setwd("D:/Analitica de Datos/Proyecto/Data")
#### uso.plataforma.totales
load("UsoPlataforma.R")
uso.plataforma.totales[[1]]## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 32.79653 32.55465 32.50412 79.29002 32.60064 80.31341 5.944546 33.39889
## [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]
## [1,] 32.6648 33.52243 32.83175 32.20808 85.51612 32.7621 80.1057 34.04933
## [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
## [1,] 57.75254 191.1448 32.35139 93.87607 4.930575 32.91283 33.72981 32.87772
## [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32]
## [1,] 33.24836 32.04978 34.91525 32.08573 54.98405 32.29635 33.56647 33.51752
## [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40]
## [1,] 33.33782 33.33431 92.82952 33.86713 77.48204 33.19972 71.31963 34.05075
## [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48]
## [1,] 60.67453 34.74442 74.25188 34.23025 33.90012 59.21743 34.93089 33.7375
## [,49] [,50] [,51] [,52] [,53] [,54]
## [1,] 68.28495 85.43635 34.32793 58.10099 33.73757 34.91061ApartadoDeLibros
separacion.libros.totales es el nombre de la variable, la cual se trata de una lista que contiene 1000 alumnos en 54 materias de las cuales las 6 primeras corresponden al primer semestre, se registra en cada variable el numero de libros que por materia reverba el estudiante.
setwd("D:/Analitica de Datos/Proyecto/Data")
#separacion.libros.totales
load("ApartadoDeLibros.R")
separacion.libros.totales[[1]]## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,] 1 1 1 3 1 3 0 1 1 1 1 1 3 1
## [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]
## [1,] 3 1 2 5 1 3 0 1 1 1 1 1
## [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38]
## [1,] 1 1 2 1 1 1 1 1 3 1 3 1
## [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49] [,50]
## [1,] 2 1 2 1 2 1 1 2 1 1 2 3
## [,51] [,52] [,53] [,54]
## [1,] 1 2 1 1Integración de datos
Los datos que hemos cargados contienen informacion de orden Academico, Financiero y compartamental de 1000 estudiante en el transcurso de 9 semestre, en cada semestre tiene 6 materias, nosotros pondremos nuestra atencion en el primer año en curso es decir solo dos semestres.
En este apartados recogeremos la información de los periodos mencionados y lo pondremos en una métrica 0-100.
integraremos en el siguiente codigo toda la data en un solo conjunto de datos, procederemos a integrar la informacion de perfil de alumno con tres variables que vamos a crear a partir de la informacion que tenemos hasta ahora estas son:
Esfuerzo: es una variable que mide que tanto se ha esmerado un estudiante academicamente esta se calcula a partir de uso.plataforma.totales, uso.biblioteca.totales y separacion.libros.totales.
Promedio: se calcula el promedio ponderado asignado los siguientes pesos 10% asistencia, 50% Examenes, 40% Trabajos
pagos: esta simplemente promedia los pagos de los semestres seleccionados
notaExamenesMatrix <- matrix(,nrow=0,ncol=12)
notaTrabajoMatrix <- matrix(,nrow=0,ncol=12)
notaAsistenciaMatrix <- matrix(,nrow=0,ncol=12)
pagoMatrix<- matrix(,nrow=0,ncol=2)
bibliotecaMatrix<- matrix(,nrow=0,ncol=12)
plataformaMatrix<- matrix(,nrow=0,ncol=12)
librosMatrix<- matrix(,nrow=0,ncol=12)
for (i in 1:1000) {
#Informacion Academica
notaAsistencia <- 100*colMeans(asistencias.totales[[i]])/2
notaAsistenciaMatrix <- rbind(notaAsistenciaMatrix,
notaAsistencia[1:12])
notaTrabajo <- 100 * colMeans(resultados.trabajos.totales[[i]])/20
notaTrabajoMatrix <- rbind(notaTrabajoMatrix,
notaTrabajo[1:12])
notaExamenes <- 100*colMeans(resultados.examenes.totales[[i]])/20
notaExamenesMatrix <- rbind(notaExamenesMatrix,
notaExamenes[1:12])
#Informacion Financiera
pagos <- 100*colMeans(registro.pagos[[i]])/2
pagoMatrix <- rbind(pagoMatrix,pagos[1:2])
#Esfuerzo
biblioteca <- uso.biblioteca.totales[[i]]
bibliotecaMatrix<- rbind(bibliotecaMatrix,biblioteca[1:12])
plataforma <- uso.plataforma.totales[[i]]
plataformaMatrix<- rbind(plataformaMatrix,plataforma[1:12])
libros<- separacion.libros.totales[[i]]
librosMatrix<- rbind(librosMatrix,libros[1:12])
}
# calculamos la nota final
# 10% asistencia, 50% Examenes, 40% Trabajos
notaFinal <- notaExamenesMatrix*0.5 + notaTrabajoMatrix*0.4 + notaAsistenciaMatrix*0.1
# calculamos el esfuerzo
# calculamos primero el maximo por materia en (numero de libros reservados, uso de la plataforma y uso de la biblioteca )
maxLibro <- apply(librosMatrix,2, max)
maxPlataforma <- apply(plataformaMatrix,2, max)
maxBiblioteca <- apply(bibliotecaMatrix,2, max)
EsfuerzoLibro <- matrix(,nrow=1000,ncol=0)
EsfuerzoBiblioteca<- matrix(,nrow=1000,ncol=0)
EsfuerzoPlataforma <- matrix(,nrow=1000,ncol=0)
# calculamos la puntacion de cada estudiante para ellos lo comparamos con el estudiante es cada materia que saco mas libros, estubo mas tiempo en la biblioteca y mas tiempo en la plataforma
for (i in 1:12){
L <- librosMatrix[,i]/maxLibro[i]
B <- bibliotecaMatrix[,i]/maxBiblioteca[i]
P <- plataformaMatrix[,i]/maxPlataforma[i]
EsfuerzoLibro<-cbind(EsfuerzoLibro,L)
EsfuerzoBiblioteca<- cbind(EsfuerzoBiblioteca,B)
EsfuerzoPlataforma <- cbind(EsfuerzoPlataforma,P)
}
#creamos la variable ezfuerzo que promediando la notas tres notas anteriores
Esfuerzo <- (EsfuerzoBiblioteca+EsfuerzoLibro+EsfuerzoPlataforma)/3
perfil.alumnos$nota.conducta <- 100*perfil.alumnos$nota.conducta/20
dataAlumnos <- perfil.alumnos
dataAlumnos$Esfuerzo <- rowMeans(Esfuerzo[,1:12])*100
dataAlumnos$Pago <- rowMeans(pagoMatrix[,1:2])
dataAlumnos$Promedio<- rowMeans(notaFinal[,1:12])
dataAlumnos$genero <- factor(dataAlumnos$genero,
levels = c(1,2),
labels = c("F", "M"))
dataAlumnos$evalucion.socioeconomica <- factor(dataAlumnos$evalucion.socioeconomica,
levels = c(1,2,3,4),
labels = c("Estrato 1","Estrato 2","Estrato 3", "Estrato 4"),
ordered = TRUE)
summary(dataAlumnos)## genero admision.letras admision.numeros promedio.preparatoria edad.ingreso
## F:405 Min. :44.94 Min. : 4.878 Min. : 60.00 Min. :11.00
## M:595 1st Qu.:56.61 1st Qu.:28.226 1st Qu.: 60.00 1st Qu.:16.00
## Median :59.98 Median :34.970 Median : 69.95 Median :17.00
## Mean :60.06 Mean :35.114 Mean : 72.25 Mean :17.53
## 3rd Qu.:63.64 3rd Qu.:42.275 3rd Qu.: 80.91 3rd Qu.:19.00
## Max. :77.71 Max. :70.411 Max. :100.00 Max. :25.00
## evalucion.socioeconomica nota.conducta Esfuerzo Pago
## Estrato 1: 56 Min. : 45.00 Min. :18.11 Min. : 81.25
## Estrato 2:107 1st Qu.: 70.00 1st Qu.:25.97 1st Qu.: 87.50
## Estrato 3:152 Median : 75.00 Median :32.05 Median : 93.75
## Estrato 4:685 Mean : 77.63 Mean :33.38 Mean : 94.80
## 3rd Qu.: 85.00 3rd Qu.:39.57 3rd Qu.:100.00
## Max. :100.00 Max. :61.58 Max. :100.00
## Promedio
## Min. :60.57
## 1st Qu.:65.58
## Median :69.03
## Mean :69.47
## 3rd Qu.:72.70
## Max. :82.48Analisis Exploratorio de Datos
EDA(dataAlumnos$admision.letras)## [1] "dataAlumnos$admision.letras"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 44.939 56.612 60.057 59.985 60.052 63.648
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 77.706 4.959 24.594 0.157 7.036 32.767 -0.115 -0.009
## SW p-val
## 0.254EDA(dataAlumnos$admision.numeros)## [1] "dataAlumnos$admision.numeros"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 4.878 28.225 35.114 34.970 35.104 42.296
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 70.411 9.918 98.375 0.314 14.071 65.533 -0.115 -0.009
## SW p-val
## 0.254EDA(dataAlumnos$promedio.preparatoria)## [1] "dataAlumnos$promedio.preparatoria"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 60.000 60.000 72.249 69.955 71.506 80.944
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 100.000 11.417 130.338 0.361 20.944 40.000 -0.676 0.609
## SW p-val
## 0.000EDA(dataAlumnos$edad.ingreso)## [1] "dataAlumnos$edad.ingreso"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 11.000 16.000 17.534 17.000 17.528 19.000
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 25.000 2.013 4.051 0.064 3.000 14.000 -0.025 0.004
## SW p-val
## 0.000EDA(dataAlumnos$nota.conducta)## [1] "dataAlumnos$nota.conducta"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 45.000 70.000 77.630 75.000 77.639 85.000
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 100.000 9.954 99.082 0.315 15.000 55.000 -0.247 -0.076
## SW p-val
## 0.000EDA(dataAlumnos$Esfuerzo)## [1] "dataAlumnos$Esfuerzo"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 18.114 25.958 33.377 32.052 32.932 39.594
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 61.577 9.085 82.539 0.287 13.636 43.463 -0.395 0.578
## SW p-val
## 0.000EDA(dataAlumnos$Pago)## [1] "dataAlumnos$Pago"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 81.250 87.500 94.800 93.750 95.222 100.000
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 100.000 5.838 34.088 0.185 12.500 18.750 -0.843 -0.663
## SW p-val
## 0.000EDA(dataAlumnos$Promedio)## [1] "dataAlumnos$Promedio"
## Size (n) Missing Minimum 1st Qu Mean Median TrMean 3rd Qu
## 1000.000 0.000 60.572 65.575 69.467 69.026 69.304 72.704
## Max. Stdev. Var. SE Mean I.Q.R. Range Kurtosis Skewness
## 82.479 4.712 22.200 0.149 7.129 21.907 -0.596 0.422
## SW p-val
## 0.000 upper.panel<-function(x, y){
points(x,y, pch=19, col=c("#00AFBB", "#FC4E07")[dataAlumnos$genero])
r <- round(cor(x, y), digits=2)
txt <- paste0("R = ", r)
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
text(0.5, 0.9, txt)
}
panel.hist <- function(x, ...)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5) )
h <- hist(x, plot = FALSE)
breaks <- h$breaks; nB <- length(breaks)
y <- h$counts; y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...)
}
pairs(dataAlumnos[,-1], lower.panel = NULL,
upper.panel = upper.panel, diag.panel = panel.hist, cex.labels =1, font.labels = 1,
main = "Variables Continuas según el Genero")
ggplot(dataAlumnos, aes(evalucion.socioeconomica, admision.numeros)) +
geom_boxplot(aes(colour = genero))
Al observar la data no se evidencias valores a típicos, ni valores faltantes la data es consistente con la información que contiene, se resalta que existen cuatro niveles de pago, se evidencia una lata correlación entre las variables (Admisión de letras, edad.ingreso, admision.numeros, Admisión de letras, promedio.preparatoria), también se nota una correlación alta entre la variable Promedio y Ezfuerzo.
No se evidencian patrones evidentes, llama la atención que los hombres pertenecen solo al estrato cuatro a pesar que tienen una representación mayoritaria de la población representado casi un 60%.
El hecho que no existan valores atípicos y valores faltantes hace dudar de la veracidad de los datos, porque en situación normal una vez un estudiante se retira se supone que se detiene el registro de información porque seria imposible tomar asistencias, notas y normalmente registro de pagos a estudiantes que muchas veces se retiran hasta normalmente dejando una deuda; para nuestro cos de estudio el no contar con valores faltantes significa una gran perdida porque al contar con ellos podríamos detectar si son casos aislados o un patrón que nos podría llevar a construir una variable de supervisión, por ejemplo podríamos detectar hasta qué punto se dejó de percibir notas, asistencias y pagos, también podríamos detectar si el estudiante dejo una deuda o no y esto seria de gran utilidad al momento de construir nuestros modelos, porque nos abre la posibilidad de detectar no solo los desertores sino posibles malos clientes, porque no es lo mismo no seguir estudiando porque no tengo para pagar el siguiente semestres “es decir terminar un semestre y no inscribirse para el próximo” que abandonar a medio semestre, este tipo de información es imposible obtenerla de la presente data.
Clustering
Escoger el Numero de Centroides
dataKmeans<-dataAlumnos
dataKmeans$genero<-as.numeric(dataKmeans$genero)
dataKmeans$edad.ingreso<-as.numeric(dataKmeans$edad.ingreso)
dataKmeans$evalucion.socioeconomica<-as.numeric(dataKmeans$evalucion.socioeconomica)
wss <- (nrow(dataKmeans)-1)*sum(apply(dataKmeans,2,var))
for (i in 2:7) wss[i] <- sum(kmeans(dataKmeans,
centers=i)$withinss)
plot(1:7, wss, type="b", xlab="Cantidad de Clusters/grupos",
ylab="Suma de Cuadrados entre Grupos")
Para determinar el numero de centroides utilizamos la tecnica del codo, donde medimos la suma de error cuadraso entre los grupos, segun podemos observar los mejores candidatos son 3 y dos los que pondremos a prueba mas adelante.
Escoger la variables
kmeans.1<-kmeans(dataAlumnos[,c(7:10)], centers= 3)
pairs(dataAlumnos, pch = 19, cex = 0.5,
col = kmeans.1$cluster,
lower.panel=NULL)
summary(factor(kmeans.1$cluster))## 1 2 3
## 369 269 362kmeans.1$centers## nota.conducta Esfuerzo Pago Promedio
## 1 86.12466 28.99759 96.49390 67.38337
## 2 77.56506 45.13658 89.91636 75.16450
## 3 69.01934 29.10255 96.70235 67.35777kmeans.2<-kmeans(dataKmeans, centers= 3)
pairs(dataAlumnos, pch = 19, cex = 0.5,
col = kmeans.2$cluster,
lower.panel=NULL)
summary(factor(kmeans.2$cluster))## 1 2 3
## 364 428 208kmeans.2$centers## genero admision.letras admision.numeros promedio.preparatoria edad.ingreso
## 1 1.593407 56.01098 27.02196 62.74805 15.90934
## 2 1.584112 64.60972 44.21944 83.51324 19.36215
## 3 1.620192 57.76883 30.53766 65.69724 16.61538
## evalucion.socioeconomica nota.conducta Esfuerzo Pago Promedio
## 1 3.456044 69.54670 28.43263 96.82349 67.01742
## 2 3.483645 86.71729 32.21019 95.26869 68.96196
## 3 3.447115 73.07692 44.43046 90.29447 74.79407kmeans.3<-kmeans(dataKmeans[, c(4, 7:10)], centers= 3)
pairs(dataAlumnos, pch = 19, cex = 0.5,
col = kmeans.3$cluster,
lower.panel=NULL)
summary(factor(kmeans.3$cluster))## 1 2 3
## 225 405 370kmeans.3$centers## promedio.preparatoria nota.conducta Esfuerzo Pago Promedio
## 1 65.00885 71.66667 44.33259 90.75000 74.84324
## 2 64.60089 71.71605 27.67624 96.80556 66.59944
## 3 85.02333 87.72973 32.95477 95.06757 69.33709kmeans.4<-kmeans(dataKmeans[, c(1,4, 6:10)], centers= 3)
pairs(dataAlumnos, pch = 19, cex = 0.5,
col = kmeans.4$cluster,
lower.panel=NULL)
summary(factor(kmeans.4$cluster))## 1 2 3
## 405 370 225kmeans.4$centers## genero promedio.preparatoria evalucion.socioeconomica nota.conducta
## 1 1.602469 64.56157 3.454321 71.65432
## 2 1.564865 85.02251 3.462162 87.72973
## 3 1.631111 65.08098 3.493333 71.77778
## Esfuerzo Pago Promedio
## 1 27.70671 96.82099 66.61438
## 2 32.90144 95.03378 69.31576
## 3 44.36544 90.77778 74.85143#con el siguiente codigo se puede agregar la variable desercion al dataframe y se gauardar
#se muestra comentado porque el modelo kmeans asigna sus centroides y cluster de forma aleatoria
#dataAlumnos$desercion <- as.numeric(kmeans.4$cluster==3)
#save(dataAlumnos, file = "Data.Integrada.R")Al ser kmeans un metodo que cada vez que se ejecuta asigna valores aleatoria a los grupos que crea, no limitalesmos a indicar que metodo de seleccion se utilizo para determinar las variables de entrenamiento del modelo, kmeans.2 se entreno con toda la data y el resultadi tipícamente era un modelo que se basaba esencialmente clasificar las variables de entrada que pertenecen al perfil de estudiante, esto en nuestro caso no es muy util ya que el estas variables no describen su comportamiento dentro de la universidad, por otro lado como ya lo habiasmos mensionado estas variables tienen una coorelacion muy alta entre ellas, por lo que si le proporcionamos muchas veces la misma informacion el modelo tiende a dar prioridad a dichas variable como se evedencia en el modelo antes mencionado, por otro lado las variables que denominaremos de salida nos proporcionan una informacion mas detallada del comportamiento del estuudiante en la carrera y dependiendo de su comportamiento podriamos estinar cual de ellos efectivamente deserto, es por eso que se escogio el modelo kmeans.4 porque fue construido a partir de dos varible con una alta correlacion tanto en las variables de entrada como las de salida y se le suministro tambien dos variables con bajo correlacion como son genero y evalucion.socioeconomica que sirben para nutrir nuestro modelo.
por ultimo vale la pena señalar que este modelo tambien fue el que mayor numero de decertados detecto y esto es relevante ya que para nuestro caso tendra mayor coste detectar un no decertado y que finalmente termine decertando que el caso anterior, lo que no significa que sea irrelevante ya que por ejemplo la universidad podria negar el acceso a un estudiante que considere como desertor pero no termine ciendolo.
load("Data.Integrada.R")
ggplot(dataAlumnos, aes(x=Esfuerzo, fill=factor(kmeans.4$cluste)))+
geom_histogram(binwidth = 1, col='black', alpha=0.5)+
labs(title='Histograma de frecuencias Esfuerzo por kmeans.4') 
ggplot(dataAlumnos, aes(x=Esfuerzo, fill=factor(desercion)))+
geom_histogram(binwidth = 1, col='black', alpha=0.5)+
labs(title='Histograma de frecuencias Esfuerzo por desercion') 
Modelo Predictivo
#load("Data.Integrada.R")
dataRed<-dataAlumnos
dataRed$genero<- as.numeric(dataRed$genero)
dataRed$evalucion.socioeconomica<-as.numeric(dataRed$evalucion.socioeconomica)
#
training.id <- createDataPartition(dataRed$desercion,p=0.8, list=F)
#
data.training <- dataRed[training.id,]
#
data.testing <- dataRed[-training.id,]
#
#
#
#
# formula1 <- desercion ~ (genero+
# nota.conducta+
# admision.letras+
# admision.numeros+
# promedio.preparatoria+
# edad.ingreso+
# evalucion.socioeconomica)
# neural.net.2 <- neuralnet(formula=formula1,
# data=data.training,
# hidden=8,
# threshold=0.1,
# #stepmax = 1e+05,
# lifesign="full",
# linear.output = FALSE)
load("Red.Neuronal.R")
nn.result.1 <- neuralnet::compute(neural.net.2, data.testing[,-11])
results.1 <-
data.frame(prediction=round(nn.result.1$net.result),
actual=data.testing$desercion)
table(results.1)## actual
## prediction 0 1
## 0 80 0
## 1 42 78plot(neural.net.2)Algunas Concluciones y consideraciones
nuestra red tiene un error de 56.81% se necesito 19347 pasos para entrenarla y podemos ver en la grafica su arquitedtura, la cual consta de una sola capa de 8 neuronas, al comprobar cual es su exactitus vemos que es de 78%, y una sencibilidad de 97%, es decir aunque nuestro modelo no es tan exacto podemos detectar casi la totalidad de los desertores, lo que le permite a la institucion tomar medidas para poder prevenir los caso de desercion.
cabe resaltar que al ser este un modelo hecho con datos modelados con las implicasiones señaladas en la parte superior y ante la imposilidad de constatar nuestro ayasgos con los expertos y las personas que interactuan con ellos, estos factores limitaran la calidad de nuestros resultados, y podemos decir que este seria un camino para mejorar nuestro modelo (“mejorar la calidad de los datos”, “Contastar los resultados con especialistas y personal que tiene contacto permanente con estos datos”, “aumentar el tamaño de la data”)
Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.