Maestría 2020 - UPUblica - Ing. Mecanica
Cargamos las librerias a utilizar
#############################################library(dplyr) # for data manipulation
library(caret) # for model-building
library(DMwR) # for smote implementation
library(purrr) # for functional programming (map)
library(pROC)
library(knitr)
library(qgraph)
library(nortest)
library(magrittr)
library(dplyr)
library(tidyr)
library(e1071)
library(OneR)
library(tidyverse) # data manipulation and visualization
library(ggplot2) # plot arrangement
library(gridExtra) # plot arrangement
library(caret)
library(ggplot2)
library(FactoMineR)
library(factoextra)
#library(modes) # MODA VER EL COMPORTAMIENTO GENERAL DE LA INF
library(randomForest)
library(klaR)
#CARGAS DATOS PARA TRABAJAR MODELO PREDICTIVO
############################################
ruta <- 'C:'
setwd('C:')
# ruta <- 'C:/Users/Jhampier/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto'
# setwd( 'C:/Users/Jhampier/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto')
#Leer el conjunto de datos del archivo CSV
DataSetUpublica <- read.table(paste(ruta, "/DataSetUnsaBinarizadaSinRuidoFuturo.csv",sep=""),header=TRUE,sep=";",stringsAsFactors = FALSE) ## dec="." es separador decimal
##########################################################
########## 2 COMPRESION DE DATOS Y 3 PREPARACIÓN DE DATOS#####
##########################################################
str(DataSetUpublica)'data.frame': 17509 obs. of 20 variables:
$ ESCUELA : chr " INGENIERIA INDUSTRIAL " " INGENIERIA INDUSTRIAL " " INGENIERIA INDUSTRIAL " " INGENIERIA INDUSTRIAL " ...
$ Anio_Ingreso : int 1989 1989 1989 1989 1989 1993 1993 1993 1993 1993 ...
$ CUI : int 19890258 19890258 19890258 19890258 19890258 19930161 19930161 19930161 19930161 19930161 ...
$ APELLI_NOMBRES : chr "ARMA/DEL CARPIO, JAIME RAFAEL" "ARMA/DEL CARPIO, JAIME RAFAEL" "ARMA/DEL CARPIO, JAIME RAFAEL" "ARMA/DEL CARPIO, JAIME RAFAEL" ...
$ periodo_matricula : int 2010 2011 2012 2013 2014 2010 2011 2012 2013 2014 ...
$ SEXO : chr "M" "M" "M" "M" ...
$ Edad : int 38 39 40 41 42 33 34 35 36 37 ...
$ LUGAR_NACIMIENTO : chr "Arequipa-Arequipa" "Arequipa-Arequipa" "Arequipa-Arequipa" "Arequipa-Arequipa" ...
$ PRDO_HASTA_MATRICULA: chr "7,8221" "8,4346" "9,0696" "9,864" ...
$ CREDS__APROBADOS : int 78 102 131 173 222 65 73 78 98 124 ...
$ ASIGS__APROBADAS : int 19 25 32 42 54 16 18 19 24 31 ...
$ ASIGS__DESAPROBADAS : int 0 0 0 0 0 0 0 0 0 0 ...
$ LUGAR_RESIDENCIA : chr "Arequipa-Arequipa-Yura" "Arequipa-Arequipa-Yura" "Arequipa-Arequipa-Yura" "Arequipa-Arequipa-Yura" ...
$ ANO_EGRESO_COLEGIO : int 23 24 25 26 27 18 19 20 21 22 ...
$ TIPO_COLEGIO : chr "Nacional" "Nacional" "Nacional" "Nacional" ...
$ LUGAR_COLEGIO : chr "Arequipa-Arequipa-Jacobo Hunter" "Arequipa-Arequipa-Jacobo Hunter" "Arequipa-Arequipa-Jacobo Hunter" "Arequipa-Arequipa-Jacobo Hunter" ...
$ MODALIDAD_INGRESO : chr "Ordinario" "Ordinario" "Ordinario" "Ordinario" ...
$ categoria : chr "CONTINUA" "CONTINUA" "CONTINUA" "CONTINUA" ...
$ categoriaBinarizada : int 0 0 0 0 0 0 0 0 0 0 ...
$ ProbabDesercion : num 4.98 6.67 6.27 7.6 6.86 4.98 6.67 6.27 7.6 6.86 ...#DATASET INICILA
DataSetUpublica########################################################
## DIMENSIONES - CANTIDAD DE FILAS Y VARIABLES(COLUMNAS)
nrow(DataSetUpublica)#[1] 17509[1] 17509ncol(DataSetUpublica)#[1] 18[1] 20colnames(DataSetUpublica)#Nombres de Variables [1] "ESCUELA" "Anio_Ingreso" "CUI"
[4] "APELLI_NOMBRES" "periodo_matricula" "SEXO"
[7] "Edad" "LUGAR_NACIMIENTO" "PRDO_HASTA_MATRICULA"
[10] "CREDS__APROBADOS" "ASIGS__APROBADAS" "ASIGS__DESAPROBADAS"
[13] "LUGAR_RESIDENCIA" "ANO_EGRESO_COLEGIO" "TIPO_COLEGIO"
[16] "LUGAR_COLEGIO" "MODALIDAD_INGRESO" "categoria"
[19] "categoriaBinarizada" "ProbabDesercion" ##NOMBRES Y TIPOS DE DATOS DE LAS COLUMNAS
#sapply(DataSetUpublica, mode)
#summary(DataSetUpublica)#PODEMOS OBSERVAR EN EL POWER
########################################################
########### PREPARACIÓN DE DATA POR VARIABLES ########
########################################################
###Converision para tipo de dato correcto
###Conversion para tipo de dato correcto
DataSetUpublicaFRMTO <-transform(DataSetUpublica,
ESCUELA = as.factor(ESCUELA),
CUI = as.character(CUI),
APELLI_NOMBRES = as.character(APELLI_NOMBRES),
SEXO = as.factor(SEXO),
LUGAR_NACIMIENTO = as.factor(LUGAR_NACIMIENTO),
LUGAR_RESIDENCIA = as.factor(LUGAR_RESIDENCIA),
TIPO_COLEGIO = as.factor(TIPO_COLEGIO),
LUGAR_COLEGIO = as.factor(LUGAR_COLEGIO),
MODALIDAD_INGRESO = as.factor(MODALIDAD_INGRESO),
DESERTOR = as.factor(as.character(categoriaBinarizada))
)
#Retiramos el campo Categoría
DataSetUpublicaFRMTO$categoria <- NULL
#Convertimos a Factor a la varaible Objetivo
levels(DataSetUpublicaFRMTO$DESERTOR) <- c("NO","SI")
# #Por útlimo remobramos el nombre de la Variable objetivo
# colnames(DataSetUpublicaFRMTO)[18] <- "DESERTOR"
DataSetUpublicaFRMTO[,'PRDO_HASTA_MATRICULA'] <- round(as.double(sub(",", "."
, DataSetUpublicaFRMTO[,'PRDO_HASTA_MATRICULA']
, fixed = TRUE)),2)
DataSetUpublicaFRMTO[,'ProbabDesercion'] <- round(as.double(sub(",", "."
, DataSetUpublicaFRMTO[,'ProbabDesercion']
, fixed = TRUE)),2)
DataSetUpublicaFRMTO[,'Anio_Ingreso'] <- as.integer(DataSetUpublicaFRMTO[,'Anio_Ingreso'])
####################################################################################
#Organizamos las variables en Categóricas(Cualitativas) y Cuantitativas(Contínuas)
#Lista de variables categóricas 12 Variables en Total
ListVar.Categ <- c( 'ESCUELA',
'SEXO',
'LUGAR_NACIMIENTO',
'LUGAR_RESIDENCIA',
'TIPO_COLEGIO',
'LUGAR_COLEGIO',
'MODALIDAD_INGRESO'
) # 8
#Lista de variables Continuas 13 Variables en Total
ListVar.Continuas <- c('Anio_Ingreso',
'periodo_matricula',
'Edad',
'CREDS__APROBADOS',
'ASIGS__APROBADAS',
'ASIGS__DESAPROBADAS',
'ANO_EGRESO_COLEGIO',
'PRDO_HASTA_MATRICULA',
'ProbabDesercion'
)
#Variable Objetivo(Target)
Var.Objetivo <- c('DESERTOR') #c('categoria') # 1
#Variable de Idenfitifación
Var.Identificacion <- c('CUI','APELLI_NOMBRES')
#Listado de todas las variables que influenciaran en el modelo
Var.TodasUprivada <- c(ListVar.Continuas,ListVar.Categ , Var.Objetivo)
##############################################################################
# ###ORDENAMOS EL DATASET CRONOLOGICAMENTE
############################################################################
# Se utilizará el campo del Codigo de Alumno para poder ordenar el dataframe
TotalFilas <- nrow(DataSetUpublicaFRMTO) #17509
SortUltimaFila=vector(mode='numeric', length=TotalFilas)
NuevoDataSetUpublicaFRMTO = data.frame(DataSetUpublicaFRMTO, SortUltimaFila)
NuevoDataSetUpublicaFRMTO$SortUltimaFila=as.numeric(NuevoDataSetUpublicaFRMTO$CUI)
###ORDENAMOS EL DATA SET
SortNuevoDataSetUpublicaFRMTO <- NuevoDataSetUpublicaFRMTO[order(NuevoDataSetUpublicaFRMTO$periodo_matricula,NuevoDataSetUpublicaFRMTO$SortUltimaFila),]
SortNuevoDataSetUpublicaFRMTO$SortUltimaFila <- NULL ##ELIMINARNOS LAS FILAS DE ORDENAMIENTO
##Reemplamos en el dataset que se trabajarn los modelos
DataSetUpublicaFRMTO<-SortNuevoDataSetUpublicaFRMTO
####################################################
##ANALISIS DE CANTIDAD DE REGISTROS POR SEMESTRE
####################################################
#Solo se trabaja con datos hasta el primer semestre del 2017
##SE toma la decisón del filtrar los registro del año 2017 que son 491 debido a que no se tienen los registro completos
DataSetUpublicaFRMTO.tmp <- DataSetUpublicaFRMTO[DataSetUpublicaFRMTO$periodo_matricula!=2017
,c( "CUI",Var.TodasUprivada)] %>% droplevels
Tabla_FrecAcumuladas <-table(DataSetUpublicaFRMTO.tmp$periodo_matricula) %>% as.data.frame()
colnames(Tabla_FrecAcumuladas) <- c("AnioMatricula","Cant")
Tabla_FrecAcumuladas$ACUMULADO<- cumsum(Tabla_FrecAcumuladas$Cant)
Tabla_FrecAcumuladas$PorcetAcum = round(100 *Tabla_FrecAcumuladas$ACUMULADO / sum(Tabla_FrecAcumuladas$Cant))
#Tabla de Frecuencias absolutas y relativas acumuladas por Semestre
Tabla_FrecAcumuladas ### SE TOMA LA DECISIÓN DE PARTICINAR para el entrenamiento del 68% de la data es decir hasta el año 2014 registro 11511DataSetUpublicaFRMTO <- DataSetUpublicaFRMTO.tmp
DataSetUpublicaFRMTO.tmp <- NULL
##############################################Observamos el DATASET ordenado cronologicamente
# Resultado DESPUES
DataSetUpublicaFRMTO #### EL NUEVO DATA SET SE ENCUENTRA ORDENADO CRONOLOGICAMENTEncol(DataSetUpublicaFRMTO) ### CANTIDAD DE VARIABLES[1] 18glimpse(DataSetUpublicaFRMTO)Observations: 17,018
Variables: 18
$ CUI <chr> "19890258", "19930161", "19932057", "19940844", …
$ Anio_Ingreso <int> 1989, 1993, 1993, 1994, 1995, 1995, 1996, 1996, …
$ periodo_matricula <int> 2010, 2010, 2010, 2010, 2010, 2010, 2010, 2010, …
$ Edad <int> 38, 33, 35, 36, 33, 37, 31, 31, 30, 30, 28, 30, …
$ CREDS__APROBADOS <int> 78, 65, 216, 103, 156, 208, 162, 72, 78, 208, 94…
$ ASIGS__APROBADAS <int> 19, 16, 55, 25, 38, 51, 41, 18, 21, 47, 23, 22, …
$ ASIGS__DESAPROBADAS <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ ANO_EGRESO_COLEGIO <int> 23, 18, 19, 11, 15, 21, 15, 10, 11, 15, 13, 14, …
$ PRDO_HASTA_MATRICULA <dbl> 7.82, 9.54, 10.98, 11.03, 11.92, 11.54, 11.22, 8…
$ ProbabDesercion <dbl> 4.98, 4.98, 4.98, 4.98, 4.98, 4.98, 4.98, 4.98, …
$ ESCUELA <fct> INGENIERIA INDUSTRIAL , INGENIERIA …
$ SEXO <fct> M, M, M, M, M, M, M, F, M, M, M, F, F, M, M, F, …
$ LUGAR_NACIMIENTO <fct> Arequipa-Arequipa, Arequipa-Arequipa, Arequipa-A…
$ LUGAR_RESIDENCIA <fct> Arequipa-Arequipa-Yura, Arequipa-Arequipa-Queque…
$ TIPO_COLEGIO <fct> Nacional, Parroquial, Nacional, Nacional, Partic…
$ LUGAR_COLEGIO <fct> Arequipa-Arequipa-Jacobo Hunter, Arequipa-Arequi…
$ MODALIDAD_INGRESO <fct> Ordinario, Ordinario, Ordinario, Profesionales, …
$ DESERTOR <fct> NO, NO, SI, NO, NO, NO, NO, NO, NO, SI, NO, NO, …Configuración para el modelo de entrenamiento
## OBSERVAMOS LAS ESCUELAS PROFESIONALES
summary(DataSetUpublicaFRMTO$ESCUELA) CIENCIA DE LA COMPUTACION INGENIERIA DE SISTEMAS
810 2431
INGENIERIA ELECTRICA INGENIERIA ELECTRONICA
2537 2976
INGENIERIA EN TELECOMUNICACIONES INGENIERIA INDUSTRIAL
802 4163
INGENIERIA MECANICA
3299 ##Filtraremos la carreara profesional
DataSetUpublicaFRMTO.RF <-DataSetUpublicaFRMTO[,Var.TodasUprivada] %>% filter(gsub("^\\s+|\\s+$", "",ESCUELA) =="INGENIERIA MECANICA" ) %>% droplevels
####################################################
##ANALISIS DE CANTIDAD DE REGISTROS POR AÑO
#Solo se trabaja con datos hasta el primer semestre del 2017
DataSetUpublicaFRMTO.tmp <- DataSetUpublicaFRMTO[,c( "CUI",Var.TodasUprivada)] %>% filter(gsub("^\\s+|\\s+$", "",ESCUELA) =="INGENIERIA MECANICA" ) %>% droplevels
X <-table(as.factor(DataSetUpublicaFRMTO.tmp$periodo_matricula)) %>% as.data.frame()
colnames(X) <- c("Anio","Cant")
X$ACUMULADO<- cumsum(X$Cant)
X$PorcetAcum = round(100 *X$ACUMULADO / sum(X$Cant))
#Tabla de Frecuencias absolutas y relativas acumuladas por Semestre
X ### #Para que las variables se visualicen correctamente
for (variable in ListVar.Categ) { levels(DataSetUpublicaFRMTO.RF[,variable]) }
nrow(DataSetUpublicaFRMTO.RF)[1] 3299summary(DataSetUpublicaFRMTO.RF$ESCUELA) INGENIERIA MECANICA
3299 DataSetUpublicaFRMTO.RF$ESCUELA <- NULLLUEGO DE ORDENAR PROCEDEMOS A ENTRENAR EL MODELO
####################################################
####PODEMOS OBSERVAR EL DESBALANCEO DE LAS CLASES
100*prop.table(table(DataSetUpublicaFRMTO.RF$DESERTOR))
NO SI
93.998181 6.001819 summary(DataSetUpublicaFRMTO.RF$DESERTOR) NO SI
3101 198 DataSetUpublicaFRMTO.RF %>% dplyr::select(DESERTOR) %>%
gather(metric,value) %>%
ggplot(aes(value, fill = metric)) +
geom_bar(show.legend = FALSE) +
facet_wrap(~ metric, scales = "free")
##calculamos las filas para el entrenamiento
TotalFilas <- nrow(DataSetUpublicaFRMTO.RF)
#OBservamos el acumulado y la cantidad de alumnos por semestre
X#####Se tomara el 68% de las de la data para entremiento y el resto para TEST
TrainFilas <- 2239
#VARIABLES CATEGORICAS
library(dummies)
#Dicotomizacion de variables categoricas
Datos_Dico_cat <- dplyr::select(DataSetUpublicaFRMTO.RF,
SEXO,LUGAR_NACIMIENTO,LUGAR_RESIDENCIA,TIPO_COLEGIO,LUGAR_COLEGIO,MODALIDAD_INGRESO)
Datos_Dico_cat <- dummy.data.frame(Datos_Dico_cat,names=c(
"SEXO","LUGAR_NACIMIENTO","LUGAR_RESIDENCIA","TIPO_COLEGIO","LUGAR_COLEGIO","MODALIDAD_INGRESO"))
colnames(Datos_Dico_cat) <- c("SEXOF" ,"SEXOM" ,
"LUGAR_NACIMIENTOÁncash-Mariscal Luzuriaga" ,"LUGAR_NACIMIENTOApurímac-Abancay" ,
"LUGAR_NACIMIENTOApurímac-Aymaraes" ,"LUGAR_NACIMIENTOApurímac-Chincheros" ,
"LUGAR_NACIMIENTOApurímac-Cotabambas" ,"LUGAR_NACIMIENTOArequipa-Arequipa" ,
"LUGAR_NACIMIENTOArequipa-Camaná" ,"LUGAR_NACIMIENTOArequipa-Caravelí" ,
"LUGAR_NACIMIENTOArequipa-Castilla" ,"LUGAR_NACIMIENTOArequipa-Caylloma" ,
"LUGAR_NACIMIENTOArequipa-Condesuyos" ,"LUGAR_NACIMIENTOArequipa-Islay" ,
"LUGAR_NACIMIENTOArequipa-La Unión" ,"LUGAR_NACIMIENTOAyacucho-Huamanga" ,
"LUGAR_NACIMIENTOAyacucho-Lucanas" ,"LUGAR_NACIMIENTOAyacucho-Parinacochas" ,
"LUGAR_NACIMIENTOCajamarca-Jaén" ,"LUGAR_NACIMIENTOCallao-Callao" ,
"LUGAR_NACIMIENTOCusco-Anta" ,"LUGAR_NACIMIENTOHuancavelica-Huaytará" ,
"LUGAR_NACIMIENTOHuánuco-Dos de Mayo" ,"LUGAR_NACIMIENTOHuánuco-Huánuco" ,
"LUGAR_NACIMIENTOIca-Pisco" ,"LUGAR_NACIMIENTOJunín-Huancayo" ,
"LUGAR_NACIMIENTOJunín-Satipo" ,"LUGAR_NACIMIENTOLambayeque-Chiclayo" ,
"LUGAR_NACIMIENTOMadre de Dios-Manu" ,"LUGAR_NACIMIENTOMadre de Dios-Tahuamanu" ,
"LUGAR_NACIMIENTOMadre de Dios-Tambopata" ,"LUGAR_NACIMIENTOPiura-Ayabaca" ,
"LUGAR_NACIMIENTOPiura-Huancabamba" ,"LUGAR_NACIMIENTOPiura-Morropón" ,
"LUGAR_NACIMIENTOPiura-Paita" ,"LUGAR_NACIMIENTOPiura-Piura" ,
"LUGAR_NACIMIENTOPiura-Sechura" ,"LUGAR_NACIMIENTOPiura-Talara" ,
"LUGAR_NACIMIENTOSan Martín-El Dorado" ,"LUGAR_NACIMIENTOSan Martín-Moyobamba" ,
"LUGAR_NACIMIENTOTumbes-Tumbes" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Alto Selva Alegre" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Arequipa" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Cayma" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Cerro Colorado" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Characato" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Chiguata" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Jacobo Hunter" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-José Luis Bustamante y Rivero","LUGAR_RESIDENCIAArequipa-Arequipa-La Joya" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Mariano Melgar" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Miraflores" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Pocsi" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Polobaya" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Quequeña" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Sabandia" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-San Juan de Tarucani" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Santa Isabel de Siguas" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Santa Rita de Siguas" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Socabaya" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Tiabaya" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Vítor" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Yanahuara" ,"LUGAR_RESIDENCIAArequipa-Arequipa-Yarabamba" ,
"LUGAR_RESIDENCIAArequipa-Arequipa-Yura" ,"TIPO_COLEGIONacional" ,
"TIPO_COLEGIOParroquial" ,"TIPO_COLEGIOParticular" ,
"LUGAR_COLEGIOApurímac-Abancay-Abancay" ,"LUGAR_COLEGIOApurímac-Aymaraes-Chalhuanca" ,
"LUGAR_COLEGIOApurímac-Cotabambas-Haquira" ,"LUGAR_COLEGIOArequipa-Arequipa-Alto Selva Alegre" ,
"LUGAR_COLEGIOArequipa-Arequipa-Arequipa" ,"LUGAR_COLEGIOArequipa-Arequipa-Cayma" ,
"LUGAR_COLEGIOArequipa-Arequipa-Cerro Colorado" ,"LUGAR_COLEGIOArequipa-Arequipa-Characato" ,
"LUGAR_COLEGIOArequipa-Arequipa-Chiguata" ,"LUGAR_COLEGIOArequipa-Arequipa-Jacobo Hunter" ,
"LUGAR_COLEGIOArequipa-Arequipa-José Luis Bustamante y Rivero" ,"LUGAR_COLEGIOArequipa-Arequipa-Mariano Melgar" ,
"LUGAR_COLEGIOArequipa-Arequipa-Polobaya" ,"LUGAR_COLEGIOArequipa-Arequipa-Sabandia" ,
"LUGAR_COLEGIOArequipa-Arequipa-San Juan de Tarucani" ,"LUGAR_COLEGIOArequipa-Arequipa-Santa Isabel de Siguas" ,
"LUGAR_COLEGIOArequipa-Arequipa-Santa Rita de Siguas" ,"LUGAR_COLEGIOArequipa-Arequipa-Tiabaya" ,
"LUGAR_COLEGIOArequipa-Arequipa-Vítor" ,"LUGAR_COLEGIOArequipa-Arequipa-Yanahuara" ,
"LUGAR_COLEGIOArequipa-Arequipa-Yarabamba" ,"LUGAR_COLEGIOArequipa-Arequipa-Yura" ,
"LUGAR_COLEGIOArequipa-Camaná-Camaná" ,"LUGAR_COLEGIOArequipa-Camaná-José María Quimper" ,
"LUGAR_COLEGIOArequipa-Camaná-Mariano Nicolás Valcárcel" ,"LUGAR_COLEGIOArequipa-Camaná-Mariscal Cáceres" ,
"LUGAR_COLEGIOArequipa-Camaná-Nicolás de Piérola" ,"LUGAR_COLEGIOArequipa-Camaná-Quilca" ,
"LUGAR_COLEGIOArequipa-Caravelí-Acarí" ,"LUGAR_COLEGIOArequipa-Caravelí-Caravelí" ,
"LUGAR_COLEGIOArequipa-Caravelí-Cháparra" ,"LUGAR_COLEGIOArequipa-Castilla-Andagua" ,
"LUGAR_COLEGIOArequipa-Castilla-Aplao" ,"LUGAR_COLEGIOArequipa-Castilla-Ayo" ,
"LUGAR_COLEGIOArequipa-Castilla-Huancarqui" ,"LUGAR_COLEGIOArequipa-Castilla-Machaguay" ,
"LUGAR_COLEGIOArequipa-Castilla-Orcopampa" ,"LUGAR_COLEGIOArequipa-Caylloma-Callalli" ,
"LUGAR_COLEGIOArequipa-Caylloma-Chivay" ,"LUGAR_COLEGIOArequipa-Caylloma-Huambo" ,
"LUGAR_COLEGIOArequipa-Caylloma-Ichupampa" ,"LUGAR_COLEGIOArequipa-Caylloma-Lari" ,
"LUGAR_COLEGIOArequipa-Caylloma-Lluta" ,"LUGAR_COLEGIOArequipa-Caylloma-Maca" ,
"LUGAR_COLEGIOArequipa-Caylloma-San Antonio de Chuca" ,"LUGAR_COLEGIOArequipa-Condesuyos-Chuquibamba" ,
"LUGAR_COLEGIOArequipa-Condesuyos-Salamanca" ,"LUGAR_COLEGIOArequipa-Condesuyos-Yanaquihua" ,
"LUGAR_COLEGIOArequipa-Islay-Cocachacra" ,"LUGAR_COLEGIOArequipa-Islay-Deán Valdivia" ,
"LUGAR_COLEGIOArequipa-Islay-Mejía" ,"LUGAR_COLEGIOArequipa-Islay-Mollendo" ,
"LUGAR_COLEGIOArequipa-Islay-Punta de Bombón" ,"LUGAR_COLEGIOArequipa-La Unión-Alca" ,
"LUGAR_COLEGIOArequipa-La Unión-Cotahuasi" ,"LUGAR_COLEGIOArequipa-La Unión-Toro" ,
"LUGAR_COLEGIOAyacucho-Huamanga-Ayacucho" ,"LUGAR_COLEGIOAyacucho-Lucanas-Puquio" ,
"LUGAR_COLEGIOCallao-Callao-Callao" ,"LUGAR_COLEGIOCallao-Callao-La Punta" ,
"LUGAR_COLEGIOHuancavelica-Huancavelica-Huancavelica" ,"LUGAR_COLEGIOHuánuco-Dos de Mayo-La Unión" ,
"LUGAR_COLEGIOHuánuco-Huacaybamba-Huacaybamba" ,"LUGAR_COLEGIOJunín-Chanchamayo-Chanchamayo" ,
"LUGAR_COLEGIOJunín-Yauli-Marcapomacocha" ,"LUGAR_COLEGIOLambayeque-Chiclayo-Eten Puerto" ,
"LUGAR_COLEGIOLambayeque-Chiclayo-La Victoria" ,"LUGAR_COLEGIOLambayeque-Chiclayo-Pucalá" ,
"LUGAR_COLEGIOMadre de Dios-Tahuamanu-Iñapari" ,"LUGAR_COLEGIOMadre de Dios-Tahuamanu-Tahuamanu" ,
"LUGAR_COLEGIOMadre de Dios-Tambopata-Tambopata" ,"LUGAR_COLEGIOPiura-Ayabaca-Ayabaca" ,
"LUGAR_COLEGIOPiura-Huancabamba-San Miguel de El Faique" ,"LUGAR_COLEGIOPiura-Morropón-Buenos Aires" ,
"LUGAR_COLEGIOPiura-Morropón-Chulucanas" ,"LUGAR_COLEGIOPiura-Morropón-San Juan de Bigote" ,
"LUGAR_COLEGIOPiura-Piura-Piura" ,"LUGAR_COLEGIOPiura-Talara-Los Órganos" ,
"LUGAR_COLEGIOPiura-Talara-Máncora" ,"LUGAR_COLEGIOPiura-Talara-Pariñas" ,
"LUGAR_COLEGIOSan Martín-El Dorado-San Martín" ,"LUGAR_COLEGIOSan Martín-Moyobamba-Moyobamba" ,
"MODALIDAD_INGRESOConvenios y Otros" ,"MODALIDAD_INGRESOCPU" ,
"MODALIDAD_INGRESODeportistas Calificados" ,"MODALIDAD_INGRESOOrdinario" ,
"MODALIDAD_INGRESOPrimeros Puestos" ,"MODALIDAD_INGRESOProfesionales" ,
"MODALIDAD_INGRESOTraslados Externos Nacionales" ,"MODALIDAD_INGRESOTraslados Internos" )AQUI SE APLICAN LOS MODELOS Y SE MUESTRA SUS MATRICES DE CONFUSIÓN COMO REFERENCIA
#str(DataSetUpublicaFRMTO.RF)
data<- cbind(
DataSetUpublicaFRMTO.RF[,ListVar.Continuas]
,Datos_Dico_cat
,DESERTOR =DataSetUpublicaFRMTO.RF[,"DESERTOR"]
)
##RENOMBRAMOS LAS VARIABLES para que puedan ser mas explicativas Datos_Dico_cat.names
#colnames(data) <- Datos_Dico_cat.names
####### VERIFICAMOS NUEVAMENTE LA DISTRIBUCIÓN DE LA DATA
summary(data[,"DESERTOR"]) NO SI
3101 198 ##DENIFIMOS LOS NODOS DE ENTRENAMIENTO
x_trainRF <- data[ (1:TrainFilas),!(names(data) %in% c("DESERTOR"))]#DataSetUpublicaFRMTO.RF[ (1:TrainFilas),]
y_trainRF <- data[ (1:TrainFilas),'DESERTOR']
summary(y_trainRF) ### DATOS PARA ENTRENAMIENTO NO SI
2128 111 ##### DATOS PARA EVALUACION
x_testRF <- data[ ((TrainFilas+1):TotalFilas),!(names(data) %in% c("DESERTOR"))]
y_testRF <- data[ ((TrainFilas+1):TotalFilas),'DESERTOR']
summary(y_testRF)##### DATOS PARA TESTING NO SI
973 87 PROCEDEMOS A ENTRENAR LOS DISTINTOS MODELOS
RAMDOM FOREST con validación cruzada
No muestra buenos resultados para sensibilidad debido al parecer a que la variable objetivo es imbalanceada
# configurar función de Evaluación del modelos control para Training para el caso REPEAT CROSS VALIDATION
ctrl <- trainControl(method = "cv", number = 10, repeats = 1, summaryFunction = twoClassSummary, classProbs = TRUE)
## configuramos un parametro de RamdomForest para Tunear el modelo.
tunegrid <- expand.grid(.mtry = c(sqrt(ncol(data))))# Opcional
RF_MDL <- caret::train(x = x_trainRF, y = y_trainRF ,verbose = FALSE
, method = "rf", metric = "Acurracy", tuneGrid = tunegrid
, trControl = ctrl)
mc_PredictOrigTuneGrid<- table(predict(RF_MDL,x_testRF),y_testRF)
mc_PredictOrigTuneGrid y_testRF
NO SI
NO 971 86
SI 2 1cm_RF <- confusionMatrix(predict(RF_MDL,x_testRF), y_testRF,positive="SI")
cm_RF$byClass Sensitivity Specificity Pos Pred Value
0.0114942529 0.9979445015 0.3333333333
Neg Pred Value Precision Recall
0.9186376537 0.3333333333 0.0114942529
F1 Prevalence Detection Rate
0.0222222222 0.0820754717 0.0009433962
Detection Prevalence Balanced Accuracy
0.0028301887 0.5047193772 RAMDOM FOREST con PESOS para la variable objetivo
#########################################################
#########################################################
# Create model weights (they sum to one)
model_weights <- ifelse(y_trainRF == "NO",
(1/table(y_trainRF)[1]) * 0.1,
(1/table(y_trainRF)[2]) * 0.9
)
summary(model_weights) Min. 1st Qu. Median Mean 3rd Qu. Max.
4.699e-05 4.699e-05 4.699e-05 4.466e-04 4.699e-05 8.108e-03 # Use the same seed to ensure same cross-validation splits
ctrl$seeds <- RF_MDL$control$seeds
# Build weighted model
RF_Weight_MDL <- train(x = x_trainRF, y = y_trainRF,
method = "rf",
verbose = FALSE,
weights = model_weights,
metric = "Acurracy",
tuneGrid = tunegrid,
trControl = ctrl)
mc_PredictWeightTuneGrid<- table(predict(RF_Weight_MDL,x_testRF),y_testRF)
mc_PredictWeightTuneGrid y_testRF
NO SI
NO 971 86
SI 2 1cm_RF_Weight <- confusionMatrix(predict(RF_Weight_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Weight$byClass Sensitivity Specificity Pos Pred Value
0.0114942529 0.9979445015 0.3333333333
Neg Pred Value Precision Recall
0.9186376537 0.3333333333 0.0114942529
F1 Prevalence Detection Rate
0.0222222222 0.0820754717 0.0009433962
Detection Prevalence Balanced Accuracy
0.0028301887 0.5047193772 RAMDOM FOREST con técnica de balanceo “UNDER”
76% para sensitividad
# Build down-sampled model
ctrl$sampling <- "down"
RF_Under_MDL <- train(x = x_trainRF, y = y_trainRF,
method = "rf",
verbose = FALSE,
tuneGrid = tunegrid,
metric = "Acurracy",
trControl = ctrl)
mc_PredictDownTuneGrid<- table(predict(RF_Under_MDL,x_testRF),y_testRF)
mc_PredictDownTuneGrid y_testRF
NO SI
NO 847 43
SI 126 44cm_RF_Under <- confusionMatrix(predict(RF_Under_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Under$byClass Sensitivity Specificity Pos Pred Value
0.50574713 0.87050360 0.25882353
Neg Pred Value Precision Recall
0.95168539 0.25882353 0.50574713
F1 Prevalence Detection Rate
0.34241245 0.08207547 0.04150943
Detection Prevalence Balanced Accuracy
0.16037736 0.68812536 RAMDOM FOREST con técnica de balanceo “OVER”
#
ctrl$sampling <- "up"
RF_Over_MDL <- train(x = x_trainRF, y = y_trainRF,
method = "rf",
verbose = FALSE,
metric = "Acurracy",
tuneGrid = tunegrid,
trControl = ctrl)
mc_PredictUpTuneGrid<- table(predict(RF_Over_MDL,x_testRF),y_testRF)
mc_PredictUpTuneGrid y_testRF
NO SI
NO 950 79
SI 23 8cm_RF_Over <- confusionMatrix(predict(RF_Over_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Over$byClass Sensitivity Specificity Pos Pred Value
0.09195402 0.97636177 0.25806452
Neg Pred Value Precision Recall
0.92322643 0.25806452 0.09195402
F1 Prevalence Detection Rate
0.13559322 0.08207547 0.00754717
Detection Prevalence Balanced Accuracy
0.02924528 0.53415790 RAMDOM FOREST con técnica de balanceo “SMOTE”
# Build smote model
ctrl$sampling <- "smote"
RF_Smote_MDL <- train(x = x_trainRF, y = y_trainRF,
method = "rf",
verbose = FALSE,
metric = "Acurracy",
tuneGrid = tunegrid,
trControl = ctrl)
mc_PredictSmoteTuneGrid<- table(predict(RF_Smote_MDL,x_testRF),y_testRF)
mc_PredictSmoteTuneGrid y_testRF
NO SI
NO 913 62
SI 60 25cm_RF_Smote <- confusionMatrix(predict(RF_Smote_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Smote$byClass Sensitivity Specificity Pos Pred Value
0.27586207 0.93833505 0.28571429
Neg Pred Value Precision Recall
0.93545082 0.28571429 0.27586207
F1 Prevalence Detection Rate
0.28070175 0.08207547 0.02264151
Detection Prevalence Balanced Accuracy
0.07924528 0.60709856 RAMDOM FOREST con escalamiento de variables numéricas
#################### #################### ####################
#################### NUEVOS
ctrl <- trainControl(method = "cv", number = 10, repeats = 1, verboseIter = FALSE)
# summary( DataSetUpublicaFRMTO.RF$DESERTOR)
# summary(x_trainRF$DESERTOR)
# summary(x_testRF$DESERTOR)
set.seed(696)
RF_Scale_MDL <- caret::train(x = x_trainRF, y = y_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_original<- table(predict(RF_Scale_MDL,x_testRF), y_testRF)
mc_original y_testRF
NO SI
NO 973 87
SI 0 0cm_RF_Scale <- confusionMatrix(predict(RF_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_ScaleConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 973 87
SI 0 0
Accuracy : 0.9179
95% CI : (0.8997, 0.9337)
No Information Rate : 0.9179
P-Value [Acc > NIR] : 0.5285
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.00000
Specificity : 1.00000
Pos Pred Value : NaN
Neg Pred Value : 0.91792
Prevalence : 0.08208
Detection Rate : 0.00000
Detection Prevalence : 0.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
RAMDOM FOREST con escalamiento de variables numéricas y balanceo “UNDER”
ctrl$sampling <- "down"
set.seed(696)
RF_Under_Scale_MDL <- caret::train(x = x_trainRF, y = y_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalUnder<- table(predict(RF_Under_Scale_MDL,x_testRF), y_testRF)
mc_originalUnder y_testRF
NO SI
NO 751 39
SI 222 48cm_RF_Under_Scale <- confusionMatrix(predict(RF_Under_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Under_ScaleConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 752 39
SI 221 48
Accuracy : 0.7547
95% CI : (0.7277, 0.7804)
No Information Rate : 0.9179
P-Value [Acc > NIR] : 1
Kappa : 0.1662
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.55172
Specificity : 0.77287
Pos Pred Value : 0.17844
Neg Pred Value : 0.95070
Prevalence : 0.08208
Detection Rate : 0.04528
Detection Prevalence : 0.25377
Balanced Accuracy : 0.66230
'Positive' Class : SI
RAMDOM FOREST con escalamiento de variables numéricas y balanceo “OVER”
ctrl$sampling <- "up"
set.seed(696)
RF_Over_Scale_MDL <- caret::train(x = x_trainRF, y = y_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalOver<- table(predict(RF_Over_Scale_MDL,x_testRF), y_testRF)
mc_originalOver y_testRF
NO SI
NO 968 81
SI 5 6cm_RF_Over_Scale <- confusionMatrix(predict(RF_Over_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Over_ScaleConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 968 81
SI 5 6
Accuracy : 0.9189
95% CI : (0.9008, 0.9346)
No Information Rate : 0.9179
P-Value [Acc > NIR] : 0.4839
Kappa : 0.106
Mcnemar's Test P-Value : 6.092e-16
Sensitivity : 0.06897
Specificity : 0.99486
Pos Pred Value : 0.54545
Neg Pred Value : 0.92278
Prevalence : 0.08208
Detection Rate : 0.00566
Detection Prevalence : 0.01038
Balanced Accuracy : 0.53191
'Positive' Class : SI
RAMDOM FOREST con escalamiento de variables numéricas y balanceo “SMOTE”
ctrl$sampling <- "smote"
set.seed(696)
RF_Smote_Scale_MDL <- caret::train(x = x_trainRF, y = y_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalSmote<- table(predict(RF_Smote_Scale_MDL,x_testRF), y_testRF)
mc_originalSmote y_testRF
NO SI
NO 973 87
SI 0 0cm_RF_Smote_Scale <- confusionMatrix(predict(RF_Smote_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Smote_ScaleConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 973 87
SI 0 0
Accuracy : 0.9179
95% CI : (0.8997, 0.9337)
No Information Rate : 0.9179
P-Value [Acc > NIR] : 0.5285
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.00000
Specificity : 1.00000
Pos Pred Value : NaN
Neg Pred Value : 0.91792
Prevalence : 0.08208
Detection Rate : 0.00000
Detection Prevalence : 0.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
### Arboles de Decisión J48 técnica de balanceo “UNDER”
library("RWeka")
set.seed(696)
ADj48_Lcaret_MDL <- train(x = x_trainRF,y = y_trainRF,
method = "J48"#,preProcess = c("scale", "center"),
#tuneGrid = hiperparametros,
#metric = "Accuracy",
#trControl = ctrl
)
mc_ADj48_Lcaret<- table(predict(ADj48_Lcaret_MDL,x_testRF), y_testRF)
mc_ADj48_Lcaret y_testRF
NO SI
NO 973 87
SI 0 0cm_ADj48_Lcaret <- confusionMatrix(predict(ADj48_Lcaret_MDL,x_testRF), y_testRF,positive="SI")
cm_ADj48_Lcaret$byClass Sensitivity Specificity Pos Pred Value
0.00000000 1.00000000 NaN
Neg Pred Value Precision Recall
0.91792453 NA 0.00000000
F1 Prevalence Detection Rate
NA 0.08207547 0.00000000
Detection Prevalence Balanced Accuracy
0.00000000 0.50000000 ### Arboles de Decisión J48 técnica de balanceo “UNDER” y escalamiento
###CON CARET
ctrl$sampling <- "down"
ADj48_Lcaret_scale_down_MDL <- caret::train(x_trainRF,y_trainRF,method ='J48',preProcess = c("scale", "center"),trControl = ctrl)
mc_ADj48_Lcaret_scale_down<- table(predict(ADj48_Lcaret_scale_down_MDL,x_testRF), y_testRF)
mc_ADj48_Lcaret_scale_down y_testRF
NO SI
NO 811 45
SI 162 42cm_ADj48_Lcaret_scale_down <- confusionMatrix(predict(ADj48_Lcaret_scale_down_MDL,x_testRF), y_testRF,positive="SI")
cm_ADj48_Lcaret_scale_down$byClass Sensitivity Specificity Pos Pred Value
0.48275862 0.83350462 0.20588235
Neg Pred Value Precision Recall
0.94742991 0.20588235 0.48275862
F1 Prevalence Detection Rate
0.28865979 0.08207547 0.03962264
Detection Prevalence Balanced Accuracy
0.19245283 0.65813162 NAIVE BAYES
NaiveBayes_MDL <- naiveBayes(x_trainRF,y_trainRF)
mc_originalBayesiano<- table(predict(NaiveBayes_MDL,x_testRF), y_testRF)
mc_originalBayesiano y_testRF
NO SI
NO 0 0
SI 973 87cm_NaiveBayes <- confusionMatrix(predict(NaiveBayes_MDL,x_testRF), y_testRF,positive="SI")
cm_NaiveBayesConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 0 0
SI 973 87
Accuracy : 0.0821
95% CI : (0.0663, 0.1003)
No Information Rate : 0.9179
P-Value [Acc > NIR] : 1
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.00000
Specificity : 0.00000
Pos Pred Value : 0.08208
Neg Pred Value : NaN
Prevalence : 0.08208
Detection Rate : 0.08208
Detection Prevalence : 1.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
RESUMEN DE RESULTADOS
#################################################################################################################
################################### RESUMEN DE RESULTADOS #######################################################
# #################################################################################################################
models <- list( RF = RF_MDL,
RF_Weight = RF_Weight_MDL,
RF_Under = RF_Under_MDL,
RF_Over = RF_Over_MDL,
RF_Smote = RF_Smote_MDL,
RF_Scale = RF_Scale_MDL,
RF_Under_Scale = RF_Under_Scale_MDL,
RF_Over_Scale = RF_Over_Scale_MDL,
RF_Smote_Scale = RF_Smote_Scale_MDL,
ADj48_Lcaret = ADj48_Lcaret_MDL,
ADj48_Lcaret_scale_down = ADj48_Lcaret_scale_down_MDL,
NaiveBayes = NaiveBayes_MDL
)
# resampling <- resamples(models)
# bwplot(resampling)
library(dplyr)
comparison <- data.frame(model = names(models), Sensitivity = rep(NA, length(models)),
Specificity = rep(NA, length(models)), Precision = rep(NA, length(models)),
Recall = rep(NA, length(models)), F1 = rep(NA, length(models)))
for (name in names(models)) {
switch(name,
RF ={rowModel<- 1},
RF_Weight ={rowModel<- 2},
RF_Under ={rowModel<- 3},
RF_Over ={rowModel<- 4}, #smote
RF_Smote ={rowModel<- 5}, #Bayesiano
RF_Scale ={rowModel<- 6},
RF_Under_Scale ={rowModel<- 7},
RF_Under_Over ={rowModel<- 8},
RF_Under_Smote ={rowModel<- 9},
ADj48_Lcaret ={rowModel<- 10},
ADj48_Lcaret_scale_down ={rowModel<- 11},
NaiveBayes = {rowModel<- 12}
)
model <- get(paste0("cm_", name))
comparison[rowModel,'Precision' ] <-model$byClass["Precision"]
comparison[rowModel,'Sensitivity' ] <-model$byClass["Sensitivity"]
comparison[rowModel,'Specificity' ] <-model$byClass["Specificity"] ## IMPORTANTE
comparison[rowModel,'Recall' ] <-model$byClass["Recall"]
comparison[rowModel,'F1' ] <-model$byClass["F1"]
}
comparisoncolnames(comparison) <- c(" model","Sensitivity","Specificity"," Precision"," Recall"," F1");
write.csv(comparison[,1:6],file="UPUBLICA_IngMecanica2020.csv", sep=",",row.names = FALSE)