Maestría 2020 - UPrivada - Ing. MECÁNICA
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
DataSetUprivada <- read.table(paste(ruta, "/DataSetUprivadaBinarizadaSinRuidoFuturo.csv",sep=""),header=TRUE,sep=";",stringsAsFactors = FALSE) ## dec="." es separador decimal
##########################################################
########## 2 COMPRESION DE DATOS Y 3 PREPARACIÓN DE DATOS#####
##########################################################
str(DataSetUprivada)'data.frame': 35693 obs. of 28 variables:
$ CodAlumno : chr "20000062092012-1" "20000062092012-2" "20000062092013-1" "20000062092013-2" ...
$ SemestresEstudiadosAcum : int 1 2 3 4 1 2 3 4 1 2 ...
$ CantCursosLlevadosAcum : int 7 15 22 29 6 13 20 28 6 11 ...
$ CursosLlevadosFueraCarreraAcum: int 1 2 3 4 1 2 3 4 1 2 ...
$ AvgSinAplzAcum : chr "10,52" "11,47" "11,41" "11,34" ...
$ AvgConAplzAcum : chr "10,76" "11,59" "11,44" "11,46" ...
$ CantCursosAplzAcum : int 1 1 2 3 2 3 4 6 1 1 ...
$ SumCredTeoAcum : int 15 30 44 58 14 27 40 56 12 21 ...
$ SumCredPraAcum : int 7 14 21 28 6 13 20 27 6 11 ...
$ edad : int 20 20 21 21 20 20 21 21 34 35 ...
$ SEXO : chr "M" "M" "M" "M" ...
$ AvgVezMatriAcum : chr "1,14" "1,13" "1,09" "1,07" ...
$ CarreraProfesional : chr "INGENIERIA AGRONOMICA" "INGENIERIA AGRONOMICA" "INGENIERIA AGRONOMICA" "INGENIERIA AGRONOMICA" ...
$ MODALIDAD_INGRESO : chr "Primeros Puestos" "Primeros Puestos" "Primeros Puestos" "Primeros Puestos" ...
$ ANIO_INGRESO : int 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 ...
$ UBIG_NACIMIENTO : chr "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" ...
$ UBIG_RESIDENCIA : chr "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" "JOSE LUIS BUSTAMANTE Y RIVERO" ...
$ TIPO_VIVIENDA : chr "CASA" "CASA" "CASA" "CASA" ...
$ GradoInstruccionPapa : chr "SUPERIOR UNIV. INCOMPLETA" "SUPERIOR UNIV. INCOMPLETA" "SUPERIOR UNIV. INCOMPLETA" "SUPERIOR UNIV. INCOMPLETA" ...
$ ProfesionPapa : chr "OTROS" "OTROS" "OTROS" "OTROS" ...
$ OcupacionPapa : chr "EMPRESARIO" "EMPRESARIO" "EMPRESARIO" "EMPRESARIO" ...
$ GradoInstruccionMama : chr "SUPERIOR TECNICA INCOMPLETA" "SUPERIOR TECNICA INCOMPLETA" "SUPERIOR TECNICA INCOMPLETA" "SUPERIOR TECNICA INCOMPLETA" ...
$ ProfesionMama : chr "OTROS" "OTROS" "OTROS" "OTROS" ...
$ OcupacionMama : chr "EMPLEADO" "EMPLEADO" "EMPLEADO" "EMPLEADO" ...
$ CantCursosAnulados : int 1 1 1 1 0 0 0 0 0 0 ...
$ categoria : chr "CONTINUA" "CONTINUA" "CONTINUA" "EGRESADO" ...
$ categoriaBinarizada : int 0 0 0 0 0 0 0 1 0 0 ...
$ ProbabDesercion : chr "14,24" "10,24" "6,61" "5,87" ...#DATASET INICILA
DataSetUprivada########################################################
## DIMENSIONES - CANTIDAD DE FILAS Y VARIABLES(COLUMNAS)
nrow(DataSetUprivada)#[1] 35693[1] 35693ncol(DataSetUprivada)#[1] 27 -1 de categoria(var categorica)[1] 28colnames(DataSetUprivada)#Nombres de Variables [1] "CodAlumno" "SemestresEstudiadosAcum"
[3] "CantCursosLlevadosAcum" "CursosLlevadosFueraCarreraAcum"
[5] "AvgSinAplzAcum" "AvgConAplzAcum"
[7] "CantCursosAplzAcum" "SumCredTeoAcum"
[9] "SumCredPraAcum" "edad"
[11] "SEXO" "AvgVezMatriAcum"
[13] "CarreraProfesional" "MODALIDAD_INGRESO"
[15] "ANIO_INGRESO" "UBIG_NACIMIENTO"
[17] "UBIG_RESIDENCIA" "TIPO_VIVIENDA"
[19] "GradoInstruccionPapa" "ProfesionPapa"
[21] "OcupacionPapa" "GradoInstruccionMama"
[23] "ProfesionMama" "OcupacionMama"
[25] "CantCursosAnulados" "categoria"
[27] "categoriaBinarizada" "ProbabDesercion" ##NOMBRES Y TIPOS DE DATOS DE LAS COLUMNAS
#sapply(DataSetUprivada, mode)
#summary(DataSetUprivada)#PODEMOS OBSERVAR EN EL POWER
summary(DataSetUprivada$CarreraProfesional)#PODEMOS OBSERVAR EN EL POWER Length Class Mode
35693 character character ########################################################
########### PREPARACIÓN DE DATA POR VARIABLES ########
########################################################
###Converision para tipo de dato correcto
DataSetUPRIVADAFRMTO <-transform(DataSetUprivada,
SEXO = as.factor(as.character(SEXO)),
CarreraProfesional = as.factor(as.character(CarreraProfesional)),
MODALIDAD_INGRESO = as.factor(as.character(MODALIDAD_INGRESO)),
UBIG_NACIMIENTO = as.factor(as.character(UBIG_NACIMIENTO)),
UBIG_RESIDENCIA = as.factor(as.character(UBIG_RESIDENCIA)),
TIPO_VIVIENDA = as.factor(as.character(TIPO_VIVIENDA)),
GradoInstruccionPapa = as.factor(as.character(GradoInstruccionPapa)),
ProfesionPapa = as.factor(as.character(ProfesionPapa)),
OcupacionPapa = as.factor(as.character(OcupacionPapa)),
GradoInstruccionMama = as.factor(as.character(GradoInstruccionMama)),
ProfesionMama = as.factor(as.character(ProfesionMama)),
OcupacionMama = as.factor(as.character(OcupacionMama))
,categoriaBinarizada = as.factor(as.character(categoriaBinarizada))
)
DataSetUPRIVADAFRMTO[,'AvgSinAplzAcum'] <- as.numeric(sub(",", ".", DataSetUPRIVADAFRMTO[,'AvgSinAplzAcum']
, fixed = TRUE))
DataSetUPRIVADAFRMTO[,'AvgConAplzAcum'] <- as.numeric(sub(",", ".", DataSetUPRIVADAFRMTO[,'AvgConAplzAcum']
, fixed = TRUE))
DataSetUPRIVADAFRMTO[,'AvgVezMatriAcum'] <- as.numeric(sub(",", ".", DataSetUPRIVADAFRMTO[,'AvgVezMatriAcum']
, fixed = TRUE))
DataSetUPRIVADAFRMTO[,'ProbabDesercion'] <- as.numeric(sub(",", ".", DataSetUPRIVADAFRMTO[,'ProbabDesercion']
, fixed = TRUE))
##sapply(DataSetUPRIVADAFRMTO, mode)
ListVar.Categ <- c('SEXO','CarreraProfesional','MODALIDAD_INGRESO'
,'UBIG_NACIMIENTO','UBIG_RESIDENCIA','TIPO_VIVIENDA'
,'GradoInstruccionPapa','ProfesionPapa','OcupacionPapa'
,'GradoInstruccionMama','ProfesionMama','OcupacionMama') # 12
Var.Objetivo <- c('categoriaBinarizada') #c('categoria') # 1
ListVar.Continuas <- c('SemestresEstudiadosAcum'
,'CantCursosLlevadosAcum'
,'CursosLlevadosFueraCarreraAcum'
,'AvgSinAplzAcum','AvgConAplzAcum'
,'CantCursosAplzAcum'
,'SumCredTeoAcum'
,'SumCredPraAcum'
,'edad'
#T#,'AvgVezMatriAcum'
,'ANIO_INGRESO'
#T#,'CantCursosAnulados' # 12
,'ProbabDesercion'
)
Var.Identificacion <- c('CodAlumno') # 1
Var.TodasUprivada <- c(ListVar.Categ ,ListVar.Continuas , Var.Objetivo)
##############################################################################
# ###ORDENAMOS EL DATASET CRONOLOGICAMENTE
############################################################################
### DATASET PREVIO AL ORDENAMIENTO CRONOLóGICO
### DataSetUPRIVADAFRMTO
TotalFilas <- nrow(DataSetUPRIVADAFRMTO) #35687
SortUltimaFila=vector(mode='numeric', length=TotalFilas)
SortUltimaFila2=vector(mode='numeric', length=TotalFilas)
##Obtendremos las variables dle codigod el alumno para ordenar el dataset
NuevoDataSetUPRIVADAFRMTO = data.frame(DataSetUPRIVADAFRMTO, SortUltimaFila,SortUltimaFila2)
#View(NuevoDataSetUPRIVADAFRMTO)
#summary(NuevoDataSetUPRIVADAFRMTO)
NuevoDataSetUPRIVADAFRMTO$SortUltimaFila=as.numeric( substr(NuevoDataSetUPRIVADAFRMTO$CodAlumno, 11, 14))
NuevoDataSetUPRIVADAFRMTO$SortUltimaFila2=as.numeric( substr(NuevoDataSetUPRIVADAFRMTO$CodAlumno, 16, 17))
###ORDENAMOS EL DATA SET
SortNuevoDataSetUPRIVADAFRMTO <- NuevoDataSetUPRIVADAFRMTO[order(NuevoDataSetUPRIVADAFRMTO$SortUltimaFila,NuevoDataSetUPRIVADAFRMTO$SortUltimaFila2),]
#DATASET ORDENADO
SortNuevoDataSetUPRIVADAFRMTO#DATASET ORDENADOSortNuevoDataSetUPRIVADAFRMTO$SortUltimaFila <- NULL ##ELIMINARNOS LAS FILAS DE ORDENAMIENTO
SortNuevoDataSetUPRIVADAFRMTO$SortUltimaFila2 <- NULL ##ELIMINARNOS LAS FILAS DE ORDENAMIENTO
##Reemplamos en el dataset que se trabajarn los modelos
DataSetUPRIVADAFRMTO<-SortNuevoDataSetUPRIVADAFRMTOObservamos el DATASET ordenado cronologicamente
# Resultado DESPUES
DataSetUPRIVADAFRMTO #### EL NUEVO DATA SET SE ENCUENTRA ORDENADO CRONOLOGICAMENTEncol(DataSetUPRIVADAFRMTO) ### CANTIDAD DE VARIABLES[1] 28glimpse(DataSetUPRIVADAFRMTO)Observations: 35,693
Variables: 28
$ CodAlumno <chr> "20000062092012-1", "20000063092012-1"…
$ SemestresEstudiadosAcum <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ CantCursosLlevadosAcum <int> 7, 6, 6, 2, 5, 6, 6, 5, 5, 5, 5, 6, 5,…
$ CursosLlevadosFueraCarreraAcum <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ AvgSinAplzAcum <dbl> 10.52, 10.33, 12.05, 7.33, 8.93, 10.89…
$ AvgConAplzAcum <dbl> 10.76, 10.67, 13.00, 7.50, 9.27, 11.22…
$ CantCursosAplzAcum <int> 1, 2, 1, 1, 1, 1, 0, 2, 0, 0, 1, 1, 0,…
$ SumCredTeoAcum <int> 15, 14, 12, 4, 11, 14, 14, 10, 9, 10, …
$ SumCredPraAcum <int> 7, 6, 6, 2, 3, 6, 6, 5, 5, 5, 5, 5, 4,…
$ edad <int> 20, 20, 34, 19, 22, 20, 20, 20, 26, 20…
$ SEXO <fct> M, M, F, M, F, F, M, M, M, M, M, M, M,…
$ AvgVezMatriAcum <dbl> 1.14, 1.00, 1.00, 2.00, 1.40, 1.00, 1.…
$ CarreraProfesional <fct> INGENIERIA AGRONOMICA, INGENIERIA AGRO…
$ MODALIDAD_INGRESO <fct> Primeros Puestos, Primeros Puestos, Gr…
$ ANIO_INGRESO <int> 2009, 2009, 2009, 2009, 2009, 2009, 20…
$ UBIG_NACIMIENTO <fct> JOSE LUIS BUSTAMANTE Y RIVERO, SAMUEL …
$ UBIG_RESIDENCIA <fct> JOSE LUIS BUSTAMANTE Y RIVERO, JOSE LU…
$ TIPO_VIVIENDA <fct> CASA, DEPARTAMENTO, CASA, CASA, CASA, …
$ GradoInstruccionPapa <fct> SUPERIOR UNIV. INCOMPLETA, SUPERIOR UN…
$ ProfesionPapa <fct> "OTROS", "PROFESION ...", "OTROS", "PR…
$ OcupacionPapa <fct> EMPRESARIO, AGRICULTOR, FF. POLICIALES…
$ GradoInstruccionMama <fct> SUPERIOR TECNICA INCOMPLETA, SECUNDARI…
$ ProfesionMama <fct> OTROS, PROFESION ..., OTROS, PROFESION…
$ OcupacionMama <fct> EMPLEADO, AMA DE CASA, EMPLEADO, AMA D…
$ CantCursosAnulados <int> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0,…
$ categoria <chr> "CONTINUA", "CONTINUA", "CONTINUA", "C…
$ categoriaBinarizada <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1,…
$ ProbabDesercion <dbl> 14.24, 14.24, 14.24, 14.24, 14.24, 14.…Configuración para el modelo de entrenamiento
## OBSERVAMOS LAS CARRERAS PROFESIONALES
summary(DataSetUPRIVADAFRMTO$CarreraProfesional) INGENIERIA AGRONOMICA
952
INGENIERIA AGRONOMICA Y AGRICOLA
551
INGENIERIA DE INDUSTRIA ALIMENTARIA
2392
INGENIERIA DE MINAS
3119
INGENIERIA DE SISTEMAS
4537
INGENIERIA ELECTRONICA
3699
INGENIERIA INDUSTRIAL
8791
INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA
8528
MEDICINA VETERINARIA Y ZOOTECNIA
3124 #### ACTUALIZAMOS EL VALOR DE ING AGRONÓMICA POR SER EL MISMO DATOS INGENIERIA AGRONOMICA = INGENIERIA AGRONOMICA Y AGRICOLA
DataSetUPRIVADAFRMTO$CarreraProfesional[DataSetUPRIVADAFRMTO$CarreraProfesional == "INGENIERIA AGRONOMICA"] <- "INGENIERIA AGRONOMICA Y AGRICOLA"
DataSetUPRIVADAFRMTO$CarreraProfesional <- droplevels(DataSetUPRIVADAFRMTO$CarreraProfesional)
#### FILTRAMOS DATOS SOLO HASTA EL PRIMER SEMESTRE DEL 2017 POR RAZONES DE DATA COMPLETA"
##Solo se trabaja con dastos hasta el primer semestre del 2017 - Tambien filtraremos la carreara profesional
DataSetUPRIVADAFRMTO.RF <-DataSetUPRIVADAFRMTO[substr(DataSetUPRIVADAFRMTO$CodAlumno, 11, 17)!="2017-2",Var.TodasUprivada] %>% filter(gsub("^\\s+|\\s+$", "",CarreraProfesional) =="INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA" ) %>% droplevels
####################################################
##ANALISIS DE CANTIDAD DE REGISTROS POR SEMESTRE
#Solo se trabaja con datos hasta el primer semestre del 2017
DataSetUPRIVADAFRMTO.tmp <- DataSetUPRIVADAFRMTO[substr(DataSetUPRIVADAFRMTO$CodAlumno, 11, 17)!="2017-2" ,c( "CodAlumno",Var.TodasUprivada)] %>% filter(gsub("^\\s+|\\s+$", "",CarreraProfesional) =="INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA" ) %>% droplevels
X <-table(as.factor(substr(DataSetUPRIVADAFRMTO.tmp$CodAlumno, 11, 17))) %>% as.data.frame()
colnames(X) <- c("Semestre","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 ### SE TOMA LA DECISIÓN DE PARTICINAR para el entrenamiento al semestre 2015-2 que represetan el 73 % de la data total #Para que las variables se visualicen correctamente
for (variable in ListVar.Categ) { levels(DataSetUPRIVADAFRMTO.RF[,variable]) }
nrow(DataSetUPRIVADAFRMTO.RF)[1] 8359summary(DataSetUPRIVADAFRMTO.RF$CarreraProfesional)INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA
8359 DataSetUPRIVADAFRMTO.RF$CarreraProfesional <- NULL
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada <- as.character(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada[DataSetUPRIVADAFRMTO.RF$categoriaBinarizada == "0"] <- "NO"### LOS QUE CONTINUAN
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada[DataSetUPRIVADAFRMTO.RF$categoriaBinarizada == "1"] <- "SI"### LOS DESERTORES
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada <- factor(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)LUEGO DE ORDENAR PROCEDEMOS A ENTRENAR EL MODELO
####################################################
####PODEMOS OBSERVAR EL DESBALANCEO DE LAS CLASES
100*prop.table(table(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada))
NO SI
91.745424 8.254576 summary(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada) NO SI
7669 690 DataSetUPRIVADAFRMTO.RF %>% dplyr::select(categoriaBinarizada) %>%
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(DataSetUPRIVADAFRMTO.RF)
#OBservamos el acumulado y la cantidad de alumnos por semestre
X#####Se tomara el 70% de las de la data para entremiento
TrainFilas <- 5810
##VEMOS EL DATASET QUE SE UTILIZARA PARA ENTRENAR
#DataSetUPRIVADAFRMTO.RF
###summary(DataSetUPRIVADAFRMTO.RF$ANIO_INGRESO)
#VARIABLES CATEGORICAS
library(dummies)
#Dicotomizacion de variables categoricas
Datos_Dico_cat <- dplyr::select(DataSetUPRIVADAFRMTO.RF
,SEXO,MODALIDAD_INGRESO,UBIG_NACIMIENTO,UBIG_RESIDENCIA
,TIPO_VIVIENDA,GradoInstruccionPapa,ProfesionPapa,OcupacionPapa,GradoInstruccionMama
,ProfesionMama,OcupacionMama)# ListVar.Categ - CarreraProfesional por se se sistemas
Datos_Dico_cat <- dummy.data.frame(Datos_Dico_cat,names=c(
"SEXO","MODALIDAD_INGRESO","UBIG_NACIMIENTO","UBIG_RESIDENCIA"
,"TIPO_VIVIENDA","GradoInstruccionPapa","ProfesionPapa","OcupacionPapa","GradoInstruccionMama"
,"ProfesionMama","OcupacionMama"))#CarreraProfesional
Datos_Dico_cat.names <- c("SemestresEstudiadosAcum" ,"CantCursosLlevadosAcum" ,
"CursosLlevadosFueraCarreraAcum" ,"AvgSinAplzAcum" ,
"AvgConAplzAcum" ,"CantCursosAplzAcum" ,
"SumCredTeoAcum" ,"SumCredPraAcum" ,
"edad" ,"ANIO_INGRESO" ,
"ProbabDesercion" ,"SEXOF" ,
"SEXOM" ,"MODALIDAD_INGRESOBecas Integrales" ,
"MODALIDAD_INGRESOCentro Preuniversitario _ Ilo" ,"MODALIDAD_INGRESOCentro Preuniversitario _ Ilo I" ,
"MODALIDAD_INGRESOCentro Preuniversitario _ Ilo II" ,"MODALIDAD_INGRESOCentro Preuniversitario _ Juliaca II" ,
"MODALIDAD_INGRESOCentro Preuniversitario _ Juliaca III" ,"MODALIDAD_INGRESOCentro Preuniversitario I" ,
"MODALIDAD_INGRESOCentro Preuniversitario II" ,"MODALIDAD_INGRESOCentro Preuniversitario III" ,
"MODALIDAD_INGRESOCobertura de Metas CPU I" ,"MODALIDAD_INGRESOCobertura de Metas CPU II" ,
"MODALIDAD_INGRESOCobertura de Metas CPU III" ,"MODALIDAD_INGRESOCobertura de Metas I" ,
"MODALIDAD_INGRESOCobertura de Metas II" ,"MODALIDAD_INGRESOCobertura de Metas III" ,
"MODALIDAD_INGRESOConvenio Andrés Bello" ,"MODALIDAD_INGRESODeportista Destacado" ,
"MODALIDAD_INGRESOEgresados Bachillerato Sec" ,"MODALIDAD_INGRESOGraduado o Profesional Universitario" ,
"MODALIDAD_INGRESOGraduado o Profesional Universitario II" ,"MODALIDAD_INGRESOIngreso Adulto" ,
"MODALIDAD_INGRESOIngreso Especial Persona con discapacidad" ,"MODALIDAD_INGRESOPrimer Examen General" ,
"MODALIDAD_INGRESOPrimeros Puestos" ,"MODALIDAD_INGRESOSegundo Examen General" ,
"MODALIDAD_INGRESOTercer Examen General" ,"MODALIDAD_INGRESOTitulado en Instituto Superior" ,
"MODALIDAD_INGRESOTitulado en Instituto Superior II" ,"MODALIDAD_INGRESOTraslado Externo Nacional" ,
"MODALIDAD_INGRESOTraslado Externo Nacional II" ,"MODALIDAD_INGRESOTraslado Interno" ,
"MODALIDAD_INGRESOTraslado Interno II" ,"UBIG_NACIMIENTOABANCAY" ,
"UBIG_NACIMIENTOACORA" ,"UBIG_NACIMIENTOALCA" ,
"UBIG_NACIMIENTOALTO DE LA ALIANZA" ,"UBIG_NACIMIENTOALTO SELVA ALEGRE" ,
"UBIG_NACIMIENTOANTA" ,"UBIG_NACIMIENTOANTAUTA" ,
"UBIG_NACIMIENTOAPLAO" ,"UBIG_NACIMIENTOARAPA" ,
"UBIG_NACIMIENTOAREQUIPA" ,"UBIG_NACIMIENTOASILLO" ,
"UBIG_NACIMIENTOATICO" ,"UBIG_NACIMIENTOAYAVIRI" ,
"UBIG_NACIMIENTOAZANGARO" ,"UBIG_NACIMIENTOBARRANCA" ,
"UBIG_NACIMIENTOCABANACONDE" ,"UBIG_NACIMIENTOCABANILLAS" ,
"UBIG_NACIMIENTOCAJABAMBA" ,"UBIG_NACIMIENTOCAJAMARCA" ,
"UBIG_NACIMIENTOCALANA" ,"UBIG_NACIMIENTOCALCA" ,
"UBIG_NACIMIENTOCAMANA" ,"UBIG_NACIMIENTOCANARIA" ,
"UBIG_NACIMIENTOCARAVELI" ,"UBIG_NACIMIENTOCARMEN DE LA LEGUA REYNOSO" ,
"UBIG_NACIMIENTOCAYLLOMA" ,"UBIG_NACIMIENTOCAYMA" ,
"UBIG_NACIMIENTOCERRO COLORADO" ,"UBIG_NACIMIENTOCHALA" ,
"UBIG_NACIMIENTOCHAMACA" ,"UBIG_NACIMIENTOCHANCHAMAYO" ,
"UBIG_NACIMIENTOCHARACATO" ,"UBIG_NACIMIENTOCHICLAYO" ,
"UBIG_NACIMIENTOCHINCHA ALTA" ,"UBIG_NACIMIENTOCHIVAY" ,
"UBIG_NACIMIENTOCOCACHACRA" ,"UBIG_NACIMIENTOCOPORAQUE" ,
"UBIG_NACIMIENTOCORONEL GREGORIO ALBARRACIN LANCHIPA" ,"UBIG_NACIMIENTOCOTAHUASI" ,
"UBIG_NACIMIENTOCURAHUASI" ,"UBIG_NACIMIENTOCUSCO" ,
"UBIG_NACIMIENTOCUYOCUYO" ,"UBIG_NACIMIENTODEAN VALDIVIA" ,
"UBIG_NACIMIENTODESAGUADERO" ,"UBIG_NACIMIENTOEL TAMBO" ,
"UBIG_NACIMIENTOESPINAR" ,"UBIG_NACIMIENTOHUACHO" ,
"UBIG_NACIMIENTOHUAMBO" ,"UBIG_NACIMIENTOHUANCAYO" ,
"UBIG_NACIMIENTOHUANUCO" ,"UBIG_NACIMIENTOICA" ,
"UBIG_NACIMIENTOILABAYA" ,"UBIG_NACIMIENTOILO" ,
"UBIG_NACIMIENTOIQUITOS" ,"UBIG_NACIMIENTOJACOBO HUNTER" ,
"UBIG_NACIMIENTOJAQUI" ,"UBIG_NACIMIENTOJESUS MARIA" ,
"UBIG_NACIMIENTOJOSE DOMINGO CHOQUEHUANCA" ,"UBIG_NACIMIENTOJOSE LUIS BUSTAMANTE Y RIVERO" ,
"UBIG_NACIMIENTOJULIACA" ,"UBIG_NACIMIENTOLA JOYA" ,
"UBIG_NACIMIENTOLA TINGUIÑA" ,"UBIG_NACIMIENTOLA VICTORIA" ,
"UBIG_NACIMIENTOLANGUI" ,"UBIG_NACIMIENTOLAYO" ,
"UBIG_NACIMIENTOLIMA" ,"UBIG_NACIMIENTOLINCE" ,
"UBIG_NACIMIENTOLLUTA" ,"UBIG_NACIMIENTOLOS ORGANOS" ,
"UBIG_NACIMIENTOMADRIGAL" ,"UBIG_NACIMIENTOMAJES" ,
"UBIG_NACIMIENTOMALA" ,"UBIG_NACIMIENTOMARANGANI" ,
"UBIG_NACIMIENTOMARCONA" ,"UBIG_NACIMIENTOMARIANO MELGAR" ,
"UBIG_NACIMIENTOMARIANO NICOLAS VALCARCEL" ,"UBIG_NACIMIENTOMARISCAL CACERES" ,
"UBIG_NACIMIENTOMATARA" ,"UBIG_NACIMIENTOMIRAFLORES" ,
"UBIG_NACIMIENTOMOHO" ,"UBIG_NACIMIENTOMOLLEBAYA" ,
"UBIG_NACIMIENTOMOLLENDO" ,"UBIG_NACIMIENTOMOQUEGUA" ,
"UBIG_NACIMIENTOMUÑANI" ,"UBIG_NACIMIENTONAZCA" ,
"UBIG_NACIMIENTONUÑOA" ,"UBIG_NACIMIENTOOCOÑA" ,
"UBIG_NACIMIENTOOLLACHEA" ,"UBIG_NACIMIENTOORCOPAMPA" ,
"UBIG_NACIMIENTOOROPESA" ,"UBIG_NACIMIENTOORURILLO" ,
"UBIG_NACIMIENTOOTRO PAIS" ,"UBIG_NACIMIENTOPACOCHA" ,
"UBIG_NACIMIENTOPALLPATA" ,"UBIG_NACIMIENTOPAMPACOLCA" ,
"UBIG_NACIMIENTOPARATIA" ,"UBIG_NACIMIENTOPARCONA" ,
"UBIG_NACIMIENTOPARIÑAS" ,"UBIG_NACIMIENTOPAUCARPATA" ,
"UBIG_NACIMIENTOPISCO" ,"UBIG_NACIMIENTOPOLOBAYA" ,
"UBIG_NACIMIENTOPUEBLO LIBRE" ,"UBIG_NACIMIENTOPUNO" ,
"UBIG_NACIMIENTOPUNTA DE BOMBON" ,"UBIG_NACIMIENTOQUILLABAMBA" ,
"UBIG_NACIMIENTORIMAC" ,"UBIG_NACIMIENTORIO GRANDE" ,
"UBIG_NACIMIENTOSACHACA" ,"UBIG_NACIMIENTOSAN ANTON" ,
"UBIG_NACIMIENTOSAN BORJA" ,"UBIG_NACIMIENTOSAN ISIDRO" ,
"UBIG_NACIMIENTOSAN JERONIMO" ,"UBIG_NACIMIENTOSAN JUAN DE LURIGANCHO" ,
"UBIG_NACIMIENTOSAN JUAN DE MIRAFLORES" ,"UBIG_NACIMIENTOSAN JUAN DEL ORO" ,
"UBIG_NACIMIENTOSAN MARTIN DE PORRES" ,"UBIG_NACIMIENTOSAN MIGUEL" ,
"UBIG_NACIMIENTOSAN SEBASTIAN" ,"UBIG_NACIMIENTOSAN VICENTE DE CAÑETE" ,
"UBIG_NACIMIENTOSANDIA" ,"UBIG_NACIMIENTOSANTA ANA" ,
"UBIG_NACIMIENTOSANTA LUCIA" ,"UBIG_NACIMIENTOSANTIAGO" ,
"UBIG_NACIMIENTOSANTIAGO DE PUPUJA" ,"UBIG_NACIMIENTOSANTO TOMAS" ,
"UBIG_NACIMIENTOSICUANI" ,"UBIG_NACIMIENTOSOCABAYA" ,
"UBIG_NACIMIENTOSULLANA" ,"UBIG_NACIMIENTOSUYCKUTAMBO" ,
"UBIG_NACIMIENTOTACNA" ,"UBIG_NACIMIENTOTAMBOPATA" ,
"UBIG_NACIMIENTOTAMBURCO" ,"UBIG_NACIMIENTOTARACO" ,
"UBIG_NACIMIENTOTIABAYA" ,"UBIG_NACIMIENTOTOMEPAMPA" ,
"UBIG_NACIMIENTOTORATA" ,"UBIG_NACIMIENTOTRUJILLO" ,
"UBIG_NACIMIENTOUCHUMAYO" ,"UBIG_NACIMIENTOURACA" ,
"UBIG_NACIMIENTOWANCHAQ" ,"UBIG_NACIMIENTOYANAHUARA" ,
"UBIG_NACIMIENTOYARABAMBA" ,"UBIG_RESIDENCIAALTO DE LA ALIANZA" ,
"UBIG_RESIDENCIAALTO SELVA ALEGRE" ,"UBIG_RESIDENCIAAPLAO" ,
"UBIG_RESIDENCIAAREQUIPA" ,"UBIG_RESIDENCIAAYAVIRI" ,
"UBIG_RESIDENCIACABANILLAS" ,"UBIG_RESIDENCIACAMANA" ,
"UBIG_RESIDENCIACARAVELI" ,"UBIG_RESIDENCIACAYMA" ,
"UBIG_RESIDENCIACERRO COLORADO" ,"UBIG_RESIDENCIACHARACATO" ,
"UBIG_RESIDENCIACOCACHACRA" ,"UBIG_RESIDENCIACORONEL GREGORIO ALBARRACIN LANCHIPA" ,
"UBIG_RESIDENCIACUSCO" ,"UBIG_RESIDENCIADEAN VALDIVIA" ,
"UBIG_RESIDENCIAESPINAR" ,"UBIG_RESIDENCIAHUANCAYO" ,
"UBIG_RESIDENCIAILABAYA" ,"UBIG_RESIDENCIAILO" ,
"UBIG_RESIDENCIAISLAY" ,"UBIG_RESIDENCIAJACOBO HUNTER" ,
"UBIG_RESIDENCIAJOSE LUIS BUSTAMANTE Y RIVERO" ,"UBIG_RESIDENCIAJULIACA" ,
"UBIG_RESIDENCIALA JOYA" ,"UBIG_RESIDENCIALLUTA" ,
"UBIG_RESIDENCIAMAJES" ,"UBIG_RESIDENCIAMARCONA" ,
"UBIG_RESIDENCIAMARIANO MELGAR" ,"UBIG_RESIDENCIAMARISCAL CACERES" ,
"UBIG_RESIDENCIAMIRAFLORES" ,"UBIG_RESIDENCIAMOLLEBAYA" ,
"UBIG_RESIDENCIAMOLLENDO" ,"UBIG_RESIDENCIAMOQUEGUA" ,
"UBIG_RESIDENCIANICOLAS DE PIEROLA" ,"UBIG_RESIDENCIAOROPESA" ,
"UBIG_RESIDENCIAPACOCHA" ,"UBIG_RESIDENCIAPAUCARPATA" ,
"UBIG_RESIDENCIAPOCOLLAY" ,"UBIG_RESIDENCIAPOLOBAYA" ,
"UBIG_RESIDENCIAPUEBLO NUEVO" ,"UBIG_RESIDENCIAPUNO" ,
"UBIG_RESIDENCIAPUNTA DE BOMBON" ,"UBIG_RESIDENCIARIO GRANDE" ,
"UBIG_RESIDENCIASABANDIA" ,"UBIG_RESIDENCIASACHACA" ,
"UBIG_RESIDENCIASAMUEL PASTOR" ,"UBIG_RESIDENCIASAN JERONIMO" ,
"UBIG_RESIDENCIASAN SEBASTIAN" ,"UBIG_RESIDENCIASANTIAGO" ,
"UBIG_RESIDENCIASICUANI" ,"UBIG_RESIDENCIASOCABAYA" ,
"UBIG_RESIDENCIATACNA" ,"UBIG_RESIDENCIATARICA" ,
"UBIG_RESIDENCIATIABAYA" ,"UBIG_RESIDENCIAUCHUMAYO" ,
"UBIG_RESIDENCIAURACA" ,"UBIG_RESIDENCIAURUBAMBA" ,
"UBIG_RESIDENCIAWANCHAQ" ,"UBIG_RESIDENCIAYANAHUARA" ,
"UBIG_RESIDENCIAYURA" ,"TIPO_VIVIENDACASA" ,
"TIPO_VIVIENDADEPARTAMENTO" ,"TIPO_VIVIENDAVECINDAD" ,
"GradoInstruccionPapaDR MAGISTER ALTA ESPECIALIDAD" ,"GradoInstruccionPapaEST SUP NO UNIVERSITARIOS" ,
"GradoInstruccionPapaGRADUADO UNIVERSITARIO" ,"GradoInstruccionPapaNINGUNO" ,
"GradoInstruccionPapaNIVEL EDUCATIVO " ,"GradoInstruccionPapaOTROS" ,
"GradoInstruccionPapaPRIMARIA COMPLETA" ,"GradoInstruccionPapaPRIMARIA INCOMPLETA" ,
"GradoInstruccionPapaSECUNDARIA COMPLETA" ,"GradoInstruccionPapaSECUNDARIA INCOMPLETA" ,
"GradoInstruccionPapaSUPERIOR TECNICA COMPLETA" ,"GradoInstruccionPapaSUPERIOR TECNICA INCOMPLETA" ,
"GradoInstruccionPapaSUPERIOR UNIV COMPLETA" ,"GradoInstruccionPapaSUPERIOR UNIV INCOMPLETA" ,
"ProfesionPapaABOGADO" ,"ProfesionPapaADMINISTRADOR DE EMPRESAS" ,
"ProfesionPapaAGRONOMO Y AFINES" ,"ProfesionPapaANTROPOLOGO ARQUEOLOGO HISTORIADOR SOCIOLOGO Y ",
"ProfesionPapaARQUITECTO URBANISTA E INGENIERO DE TRANSITO" ,"ProfesionPapaBIOLOGO" ,
"ProfesionPapaCONTADOR" ,"ProfesionPapaECONOMISTA" ,
"ProfesionPapaENFERMERA" ,"ProfesionPapaFARMACEUTICO" ,
"ProfesionPapaGEOLOGO GEOFISICO Y OCEANOGRAFO" ,"ProfesionPapaINGENIERO otros" ,
"ProfesionPapaINGENIERO CIVIL" ,"ProfesionPapaINGENIERO DE MINAS METALURGICO Y AFINES" ,
"ProfesionPapaINGENIERO DE SISTEMAS" ,"ProfesionPapaINGENIERO ELECTRICISTA ELECTRONICO Y DE TELECOMUN",
"ProfesionPapaINGENIERO INDUSTRIAL" ,"ProfesionPapaINGENIERO MECANICO" ,
"ProfesionPapaINGENIERO PESQUERO" ,"ProfesionPapaINGENIERO QUIMICO" ,
"ProfesionPapaMATEMATICO Y AFINES" ,"ProfesionPapaMEDICO" ,
"ProfesionPapaODONTOLOGO" ,"ProfesionPapaOTROS" ,
"ProfesionPapaPROFESION " ,"ProfesionPapaPROFESOR" ,
"ProfesionPapaPROFESOR DE EDUCACION SECUNDARIA Y BASICA" ,"ProfesionPapaPROFESOR DE UNIVERSIDADES ESEP Y OTROS CENTROS DE",
"ProfesionPapaPROFESOR Y O MAESTRO DE PRIMARIA" ,"ProfesionPapaPSICOLOGO" ,
"ProfesionPapaTRABAJADOR SOCIAL" ,"ProfesionPapaVETERINARIO" ,
"OcupacionPapaAGRICULTOR" ,"OcupacionPapaAMA DE CASA" ,
"OcupacionPapaCOMERCIANTE MAYORISTA" ,"OcupacionPapaCOMERCIANTE MINORISTA" ,
"OcupacionPapaCONDUCTOR DE VEHICULO" ,"OcupacionPapaDISCAPACITADO" ,
"OcupacionPapaEMPLEADO" ,"OcupacionPapaEMPRESARIO" ,
"OcupacionPapaFF POLICIALES" ,"OcupacionPapaFFAA OFICIAL" ,
"OcupacionPapaFFAA SUBALTERNO" ,"OcupacionPapaJUBILADO CESANTE" ,
"OcupacionPapaMICROEMPRESARIO" ,"OcupacionPapaOBRERO" ,
"OcupacionPapaOCUPACION " ,"OcupacionPapaOTRO" ,
"GradoInstruccionMama" ,"GradoInstruccionMamaDR MAGISTER ALTA ESPECIALIDAD" ,
"GradoInstruccionMamaEST SUP NO UNIVERSITARIOS" ,"GradoInstruccionMamaGRADUADO UNIVERSITARIO" ,
"GradoInstruccionMamaNINGUNO" ,"GradoInstruccionMamaNIVEL EDUCATIVO " ,
"GradoInstruccionMamaOTROS" ,"GradoInstruccionMamaPRIMARIA COMPLETA" ,
"GradoInstruccionMamaPRIMARIA INCOMPLETA" ,"GradoInstruccionMamaSECUNDARIA COMPLETA" ,
"GradoInstruccionMamaSECUNDARIA INCOMPLETA" ,"GradoInstruccionMamaSUPERIOR TECNICA COMPLETA" ,
"GradoInstruccionMamaSUPERIOR TECNICA INCOMPLETA" ,"GradoInstruccionMamaSUPERIOR UNIV COMPLETA" ,
"GradoInstruccionMamaSUPERIOR UNIV INCOMPLETA" ,"ProfesionMama" ,
"ProfesionMamaABOGADO" ,"ProfesionMamaADMINISTRADOR DE EMPRESAS" ,
"ProfesionMamaAGRONOMO Y AFINES" ,"ProfesionMamaANTROPOLOGO ARQUEOLOGO HISTORIADOR SOCIOLOGO Y ",
"ProfesionMamaARQUITECTO URBANISTA E INGENIERO DE TRANSITO" ,"ProfesionMamaBIOLOGO" ,
"ProfesionMamaCONTADOR" ,"ProfesionMamaECONOMISTA" ,
"ProfesionMamaENFERMERA" ,"ProfesionMamaFARMACEUTICO" ,
"ProfesionMamaGEOLOGO GEOFISICO Y OCEANOGRAFO" ,"ProfesionMamaINGENIERO otros" ,
"ProfesionMamaINGENIERO CIVIL" ,"ProfesionMamaINGENIERO DE MINAS METALURGICO Y AFINES" ,
"ProfesionMamaINGENIERO DE SISTEMAS" ,"ProfesionMamaINGENIERO INDUSTRIAL" ,
"ProfesionMamaINGENIERO QUIMICO" ,"ProfesionMamaMATEMATICO Y AFINES" ,
"ProfesionMamaMEDICO" ,"ProfesionMamaOBSTETRIZ" ,
"ProfesionMamaODONTOLOGO" ,"ProfesionMamaOTROS" ,
"ProfesionMamaPROFESION " ,"ProfesionMamaPROFESOR" ,
"ProfesionMamaPROFESOR DE EDUCACION ESPECIAL" ,"ProfesionMamaPROFESOR DE EDUCACION INICIAL O PRE_ESCOLAR" ,
"ProfesionMamaPROFESOR DE EDUCACION SECUNDARIA Y BASICA" ,"ProfesionMamaPROFESOR DE UNIVERSIDADES ESEP Y OTROS CENTROS DE",
"ProfesionMamaPROFESOR Y O MAESTRO DE PRIMARIA" ,"ProfesionMamaPSICOLOGO" ,
"ProfesionMamaTRABAJADOR SOCIAL" ,"ProfesionMamaVETERINARIO" ,
"OcupacionMama" ,"OcupacionMamaAGRICULTOR" ,
"OcupacionMamaAMA DE CASA" ,"OcupacionMamaCOMERCIANTE MAYORISTA" ,
"OcupacionMamaCOMERCIANTE MINORISTA" ,"OcupacionMamaCONDUCTOR DE VEHICULO" ,
"OcupacionMamaDISCAPACITADO" ,"OcupacionMamaEMPLEADO" ,
"OcupacionMamaEMPRESARIO" ,"OcupacionMamaFF POLICIALES" ,
"OcupacionMamaFFAA SUBALTERNO" ,"OcupacionMamaJUBILADO CESANTE" ,
"OcupacionMamaMICROEMPRESARIO" ,"OcupacionMamaOBRERO" ,
"OcupacionMamaOCUPACION " ,"OcupacionMamaOTRO" ,
"categoriaBinarizada" )AQUI SE APLICAN LOS MODELOS Y SE MUESTRA SUS MATRICES DE CONFUSIÓN COMO REFERENCIA
#str(DataSetUPRIVADAFRMTO.RF)
data<- cbind(
DataSetUPRIVADAFRMTO.RF[,ListVar.Continuas]
,Datos_Dico_cat
,categoriaBinarizada =DataSetUPRIVADAFRMTO.RF[,"categoriaBinarizada"]
)
##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[,"categoriaBinarizada"]) NO SI
7669 690 ##DENIFIMOS LOS NODOS DE ENTRENAMIENTO
x_trainRF <- data[ (1:TrainFilas),!(names(data) %in% c("categoriaBinarizada"))]#DataSetUPRIVADAFRMTO.RF[ (1:TrainFilas),]
y_trainRF <- data[ (1:TrainFilas),'categoriaBinarizada']
summary(y_trainRF) ### DATOS PARA ENTRENAMIENTO NO SI
5337 473 ##### DATOS PARA EVALUACION
x_testRF <- data[ ((TrainFilas+1):TotalFilas),!(names(data) %in% c("categoriaBinarizada"))]
y_testRF <- data[ ((TrainFilas+1):TotalFilas),'categoriaBinarizada']
summary(y_testRF)##### DATOS PARA TESTING NO SI
2332 217 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 2321 165
SI 11 52cm_RF <- confusionMatrix(predict(RF_MDL,x_testRF), y_testRF,positive="SI")
cm_RF$byClass Sensitivity Specificity Pos Pred Value
0.23963134 0.99528302 0.82539683
Neg Pred Value Precision Recall
0.93362832 0.82539683 0.23963134
F1 Prevalence Detection Rate
0.37142857 0.08513142 0.02040016
Detection Prevalence Balanced Accuracy
0.02471557 0.61745718 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.
1.874e-05 1.874e-05 1.874e-05 1.721e-04 1.874e-05 1.903e-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 2321 165
SI 11 52cm_RF_Weight <- confusionMatrix(predict(RF_Weight_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Weight$byClass Sensitivity Specificity Pos Pred Value
0.23963134 0.99528302 0.82539683
Neg Pred Value Precision Recall
0.93362832 0.82539683 0.23963134
F1 Prevalence Detection Rate
0.37142857 0.08513142 0.02040016
Detection Prevalence Balanced Accuracy
0.02471557 0.61745718 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 2039 57
SI 293 160cm_RF_Under <- confusionMatrix(predict(RF_Under_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Under$byClass Sensitivity Specificity Pos Pred Value
0.73732719 0.87435678 0.35320088
Neg Pred Value Precision Recall
0.97280534 0.35320088 0.73732719
F1 Prevalence Detection Rate
0.47761194 0.08513142 0.06276971
Detection Prevalence Balanced Accuracy
0.17771675 0.80584198 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 2303 136
SI 29 81cm_RF_Over <- confusionMatrix(predict(RF_Over_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Over$byClass Sensitivity Specificity Pos Pred Value
0.37327189 0.98756432 0.73636364
Neg Pred Value Precision Recall
0.94423944 0.73636364 0.37327189
F1 Prevalence Detection Rate
0.49541284 0.08513142 0.03177717
Detection Prevalence Balanced Accuracy
0.04315418 0.68041811 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 2293 126
SI 39 91cm_RF_Smote <- confusionMatrix(predict(RF_Smote_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Smote$byClass Sensitivity Specificity Pos Pred Value
0.41935484 0.98327616 0.70000000
Neg Pred Value Precision Recall
0.94791236 0.70000000 0.41935484
F1 Prevalence Detection Rate
0.52449568 0.08513142 0.03570027
Detection Prevalence Balanced Accuracy
0.05100039 0.70131550 RAMDOM FOREST con escalamiento de variables numéricas
#################### #################### ####################
#################### NUEVOS
ctrl <- trainControl(method = "cv", number = 10, repeats = 1, verboseIter = FALSE)
# summary( DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)
# summary(x_trainRF$categoriaBinarizada)
# summary(x_testRF$categoriaBinarizada)
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 2316 143
SI 16 74cm_RF_Scale <- confusionMatrix(predict(RF_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_ScaleConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 2317 144
SI 15 73
Accuracy : 0.9376
95% CI : (0.9275, 0.9467)
No Information Rate : 0.9149
P-Value [Acc > NIR] : 1.041e-05
Kappa : 0.4518
Mcnemar's Test P-Value : < 2.2e-16
Sensitivity : 0.33641
Specificity : 0.99357
Pos Pred Value : 0.82955
Neg Pred Value : 0.94149
Prevalence : 0.08513
Detection Rate : 0.02864
Detection Prevalence : 0.03452
Balanced Accuracy : 0.66499
'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 2224 101
SI 108 116cm_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 2225 103
SI 107 114
Accuracy : 0.9176
95% CI : (0.9063, 0.928)
No Information Rate : 0.9149
P-Value [Acc > NIR] : 0.3251
Kappa : 0.4755
Mcnemar's Test P-Value : 0.8360
Sensitivity : 0.52535
Specificity : 0.95412
Pos Pred Value : 0.51584
Neg Pred Value : 0.95576
Prevalence : 0.08513
Detection Rate : 0.04472
Detection Prevalence : 0.08670
Balanced Accuracy : 0.73973
'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 2301 140
SI 31 77cm_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 2301 141
SI 31 76
Accuracy : 0.9325
95% CI : (0.9221, 0.942)
No Information Rate : 0.9149
P-Value [Acc > NIR] : 0.0005657
Kappa : 0.4375
Mcnemar's Test P-Value : < 2.2e-16
Sensitivity : 0.35023
Specificity : 0.98671
Pos Pred Value : 0.71028
Neg Pred Value : 0.94226
Prevalence : 0.08513
Detection Rate : 0.02982
Detection Prevalence : 0.04198
Balanced Accuracy : 0.66847
'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 2331 215
SI 1 2cm_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 2331 215
SI 1 2
Accuracy : 0.9153
95% CI : (0.9038, 0.9258)
No Information Rate : 0.9149
P-Value [Acc > NIR] : 0.4898
Kappa : 0.0159
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.0092166
Specificity : 0.9995712
Pos Pred Value : 0.6666667
Neg Pred Value : 0.9155538
Prevalence : 0.0851314
Detection Rate : 0.0007846
Detection Prevalence : 0.0011769
Balanced Accuracy : 0.5043939
'Positive' Class : SI
### Arboles de Decisión J48 técnica de balanceo “UNDER”
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 2321 177
SI 11 40cm_ADj48_Lcaret <- confusionMatrix(predict(ADj48_Lcaret_MDL,x_testRF), y_testRF,positive="SI")
cm_ADj48_Lcaret$byClass Sensitivity Specificity Pos Pred Value
0.18433180 0.99528302 0.78431373
Neg Pred Value Precision Recall
0.92914331 0.78431373 0.18433180
F1 Prevalence Detection Rate
0.29850746 0.08513142 0.01569243
Detection Prevalence Balanced Accuracy
0.02000785 0.58980741 ### 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 1664 56
SI 668 161cm_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.74193548 0.71355060 0.19420989
Neg Pred Value Precision Recall
0.96744186 0.19420989 0.74193548
F1 Prevalence Detection Rate
0.30783939 0.08513142 0.06316202
Detection Prevalence Balanced Accuracy
0.32522558 0.72774304 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 132 11
SI 2200 206cm_NaiveBayes <- confusionMatrix(predict(NaiveBayes_MDL,x_testRF), y_testRF,positive="SI")
cm_NaiveBayesConfusion Matrix and Statistics
Reference
Prediction NO SI
NO 132 11
SI 2200 206
Accuracy : 0.1326
95% CI : (0.1197, 0.1464)
No Information Rate : 0.9149
P-Value [Acc > NIR] : 1
Kappa : 0.0011
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.94931
Specificity : 0.05660
Pos Pred Value : 0.08562
Neg Pred Value : 0.92308
Prevalence : 0.08513
Detection Rate : 0.08082
Detection Prevalence : 0.94390
Balanced Accuracy : 0.50296
'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="UPRIVADA_IngMecanica2020.csv", sep=",",row.names = FALSE)