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] 35693
ncol(DataSetUprivada)#[1] 27 -1 de categoria(var categorica)
[1] 28
colnames(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 ORDENADO
SortNuevoDataSetUPRIVADAFRMTO$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<-SortNuevoDataSetUPRIVADAFRMTO
# Resultado DESPUES
DataSetUPRIVADAFRMTO #### EL NUEVO DATA SET SE ENCUENTRA ORDENADO CRONOLOGICAMENTE
ncol(DataSetUPRIVADAFRMTO) ### CANTIDAD DE VARIABLES
[1] 28
glimpse(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.…
## 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 DE MINAS" ) %>% 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 DE MINAS" ) %>% 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] 3047
summary(DataSetUPRIVADAFRMTO.RF$CarreraProfesional)
INGENIERIA DE MINAS
3047
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)
####################################################
####PODEMOS OBSERVAR EL DESBALANCEO DE LAS CLASES
100*prop.table(table(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada))
NO SI
93.075156 6.924844
summary(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)
NO SI
2836 211
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 73% de las de la data para entremiento
TrainFilas <- 2212 #round(TotalFilas*0.7)
##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_INGRESOBeca18" ,
"MODALIDAD_INGRESOCentro Preuniversitario I" ,"MODALIDAD_INGRESOCentro Preuniversitario II" ,
"MODALIDAD_INGRESOCentro Preuniversitario III" ,"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_INGRESODeportista Destacado" ,"MODALIDAD_INGRESOGraduado o Profesional Universitario" ,
"MODALIDAD_INGRESOGraduado o Profesional Universitario II" ,"MODALIDAD_INGRESOPrimer Examen General" ,
"MODALIDAD_INGRESOPrimeros Puestos" ,"MODALIDAD_INGRESOSegundo Examen General" ,
"MODALIDAD_INGRESOTercer Examen General" ,"MODALIDAD_INGRESOTraslado Externo Nacional" ,
"MODALIDAD_INGRESOTraslado Externo Nacional II" ,"MODALIDAD_INGRESOTraslado Interno" ,
"MODALIDAD_INGRESOTraslado Interno II" ,"UBIG_NACIMIENTOABANCAY" ,
"UBIG_NACIMIENTOALTO DE LA ALIANZA" ,"UBIG_NACIMIENTOALTO SELVA ALEGRE" ,
"UBIG_NACIMIENTOANDAHUAYLAS" ,"UBIG_NACIMIENTOANTAUTA" ,
"UBIG_NACIMIENTOAPLAO" ,"UBIG_NACIMIENTOAREQUIPA" ,
"UBIG_NACIMIENTOATE" ,"UBIG_NACIMIENTOATICO" ,
"UBIG_NACIMIENTOCAJABAMBA" ,"UBIG_NACIMIENTOCAJAMARCA" ,
"UBIG_NACIMIENTOCALANA" ,"UBIG_NACIMIENTOCAMANA" ,
"UBIG_NACIMIENTOCAYARANI" ,"UBIG_NACIMIENTOCAYLLOMA" ,
"UBIG_NACIMIENTOCAYMA" ,"UBIG_NACIMIENTOCERRO COLORADO" ,
"UBIG_NACIMIENTOCHAPARRA" ,"UBIG_NACIMIENTOCHARACATO" ,
"UBIG_NACIMIENTOCHICLAYO" ,"UBIG_NACIMIENTOCHIVAY" ,
"UBIG_NACIMIENTOCOCACHACRA" ,"UBIG_NACIMIENTOCOLQUEMARCA" ,
"UBIG_NACIMIENTOCUSCO" ,"UBIG_NACIMIENTODANIEL HERNANDEZ" ,
"UBIG_NACIMIENTODEAN VALDIVIA" ,"UBIG_NACIMIENTOESPINAR" ,
"UBIG_NACIMIENTOHUANCA" ,"UBIG_NACIMIENTOHUANCANE" ,
"UBIG_NACIMIENTOHUANCARQUI" ,"UBIG_NACIMIENTOHUANUHUANU" ,
"UBIG_NACIMIENTOHUATASANI" ,"UBIG_NACIMIENTOICA" ,
"UBIG_NACIMIENTOICHUÑA" ,"UBIG_NACIMIENTOICHUPAMPA" ,
"UBIG_NACIMIENTOILABAYA" ,"UBIG_NACIMIENTOILAVE" ,
"UBIG_NACIMIENTOILO" ,"UBIG_NACIMIENTOINCHUPALLA" ,
"UBIG_NACIMIENTOJACOBO HUNTER" ,"UBIG_NACIMIENTOJESUS MARIA" ,
"UBIG_NACIMIENTOJOSE DOMINGO CHOQUEHUANCA" ,"UBIG_NACIMIENTOJOSE LUIS BUSTAMANTE Y RIVERO" ,
"UBIG_NACIMIENTOJULIACA" ,"UBIG_NACIMIENTOLA JOYA" ,
"UBIG_NACIMIENTOLA MERCED" ,"UBIG_NACIMIENTOLEONCIO PRADO" ,
"UBIG_NACIMIENTOLIMA" ,"UBIG_NACIMIENTOLLUTA" ,
"UBIG_NACIMIENTOLURIGANCHO" ,"UBIG_NACIMIENTOMAJES" ,
"UBIG_NACIMIENTOMARA" ,"UBIG_NACIMIENTOMARANGANI" ,
"UBIG_NACIMIENTOMARCONA" ,"UBIG_NACIMIENTOMARIANO MELGAR" ,
"UBIG_NACIMIENTOMARISCAL CACERES" ,"UBIG_NACIMIENTOMIRAFLORES" ,
"UBIG_NACIMIENTOMOLLENDO" ,"UBIG_NACIMIENTOMOQUEGUA" ,
"UBIG_NACIMIENTONAZCA" ,"UBIG_NACIMIENTONICOLAS DE PIEROLA" ,
"UBIG_NACIMIENTOORCOPAMPA" ,"UBIG_NACIMIENTOOTRO PAIS" ,
"UBIG_NACIMIENTOPACOCHA" ,"UBIG_NACIMIENTOPAMPACOLCA" ,
"UBIG_NACIMIENTOPARIÑAS" ,"UBIG_NACIMIENTOPARURO" ,
"UBIG_NACIMIENTOPAUCARPATA" ,"UBIG_NACIMIENTOPLATERIA" ,
"UBIG_NACIMIENTOPUNO" ,"UBIG_NACIMIENTOQUELLOUNO" ,
"UBIG_NACIMIENTOQUEQUEÑA" ,"UBIG_NACIMIENTOQUILLABAMBA" ,
"UBIG_NACIMIENTORIO GRANDE" ,"UBIG_NACIMIENTOSABANDIA" ,
"UBIG_NACIMIENTOSACHACA" ,"UBIG_NACIMIENTOSAMUEL PASTOR" ,
"UBIG_NACIMIENTOSAN ISIDRO" ,"UBIG_NACIMIENTOSAN JUAN DE MIRAFLORES" ,
"UBIG_NACIMIENTOSAN JUAN DE TARUCANI" ,"UBIG_NACIMIENTOSAN RAMON" ,
"UBIG_NACIMIENTOSANTA ROSA" ,"UBIG_NACIMIENTOSANTIAGO" ,
"UBIG_NACIMIENTOSANTIAGO DE SURCO" ,"UBIG_NACIMIENTOSANTO TOMAS" ,
"UBIG_NACIMIENTOSICUANI" ,"UBIG_NACIMIENTOSOCABAYA" ,
"UBIG_NACIMIENTOTACNA" ,"UBIG_NACIMIENTOTIABAYA" ,
"UBIG_NACIMIENTOTIRAPATA" ,"UBIG_NACIMIENTOTORATA" ,
"UBIG_NACIMIENTOTUMBES" ,"UBIG_NACIMIENTOUCHUMAYO" ,
"UBIG_NACIMIENTOURACA" ,"UBIG_NACIMIENTOVILLA MARIA DEL TRIUNFO" ,
"UBIG_NACIMIENTOWANCHAQ" ,"UBIG_NACIMIENTOYANAHUARA" ,
"UBIG_RESIDENCIAACORA" ,"UBIG_RESIDENCIAALTO SELVA ALEGRE" ,
"UBIG_RESIDENCIAAREQUIPA" ,"UBIG_RESIDENCIAAYACUCHO" ,
"UBIG_RESIDENCIAAZANGARO" ,"UBIG_RESIDENCIACAMANA" ,
"UBIG_RESIDENCIACAYMA" ,"UBIG_RESIDENCIACERRO COLORADO" ,
"UBIG_RESIDENCIACHALA" ,"UBIG_RESIDENCIACHALLHUAHUACHO" ,
"UBIG_RESIDENCIACHARACATO" ,"UBIG_RESIDENCIACOCACHACRA" ,
"UBIG_RESIDENCIADEAN VALDIVIA" ,"UBIG_RESIDENCIAILO" ,
"UBIG_RESIDENCIAIRAY" ,"UBIG_RESIDENCIAJACOBO HUNTER" ,
"UBIG_RESIDENCIAJOSE LUIS BUSTAMANTE Y RIVERO" ,"UBIG_RESIDENCIAJULIACA" ,
"UBIG_RESIDENCIALA JOYA" ,"UBIG_RESIDENCIAMAJES" ,
"UBIG_RESIDENCIAMARIANO MELGAR" ,"UBIG_RESIDENCIAMARISCAL CACERES" ,
"UBIG_RESIDENCIAMIRAFLORES" ,"UBIG_RESIDENCIAMOLLENDO" ,
"UBIG_RESIDENCIAMOQUEGUA" ,"UBIG_RESIDENCIANICOLAS DE PIEROLA" ,
"UBIG_RESIDENCIAOCOÑA" ,"UBIG_RESIDENCIAPACOCHA" ,
"UBIG_RESIDENCIAPAUCARPATA" ,"UBIG_RESIDENCIAPULLO" ,
"UBIG_RESIDENCIAPUNO" ,"UBIG_RESIDENCIAPUNTA DE BOMBON" ,
"UBIG_RESIDENCIAQUELLOUNO" ,"UBIG_RESIDENCIASABANDIA" ,
"UBIG_RESIDENCIASACHACA" ,"UBIG_RESIDENCIASAMEGUA" ,
"UBIG_RESIDENCIASAMUEL PASTOR" ,"UBIG_RESIDENCIASICUANI" ,
"UBIG_RESIDENCIASOCABAYA" ,"UBIG_RESIDENCIATIABAYA" ,
"UBIG_RESIDENCIAUCHUMAYO" ,"UBIG_RESIDENCIAWANCHAQ" ,
"UBIG_RESIDENCIAYANAHUARA" ,"TIPO_VIVIENDACASA" ,
"TIPO_VIVIENDADEPARTAMENTO" ,"TIPO_VIVIENDAVECINDAD" ,
"GradoInstruccionPapaDRMAGISTER ALTA ESPECIALIDAD" ,"GradoInstruccionPapaESTSUPNO UNIVERSITARIOS" ,
"GradoInstruccionPapaGRADUADO UNIVERSITARIO" ,"GradoInstruccionPapaNINGUNO" ,
"GradoInstruccionPapaNIVEL EDUCATIVO" ,"GradoInstruccionPapaOTROS" ,
"GradoInstruccionPapaPRIMARIA COMPLETA" ,"GradoInstruccionPapaPRIMARIA INCOMPLETA" ,
"GradoInstruccionPapaSECUNDARIA COMPLETA" ,"GradoInstruccionPapaSECUNDARIA INCOMPLETA" ,
"GradoInstruccionPapaSUPERIOR TECNICA COMPLETA" ,"GradoInstruccionPapaSUPERIOR TECNICA INCOMPLETA" ,
"GradoInstruccionPapaSUPERIOR UNIVCOMPLETA" ,"GradoInstruccionPapaSUPERIOR UNIVINCOMPLETA" ,
"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" ,
"ProfesionPapaVETERINARIO" ,"OcupacionPapaAGRICULTOR" ,
"OcupacionPapaAMA DE CASA" ,"OcupacionPapaCOMERCIANTE MAYORISTA" ,
"OcupacionPapaCOMERCIANTE MINORISTA" ,"OcupacionPapaCONDUCTOR DE VEHICULO" ,
"OcupacionPapaDISCAPACITADO" ,"OcupacionPapaEMPLEADO" ,
"OcupacionPapaEMPRESARIO" ,"OcupacionPapaFFPOLICIALES" ,
"OcupacionPapaFFAOFICIAL" ,"OcupacionPapaFFASUBALTERNO" ,
"OcupacionPapaJUBILADO CESANTE" ,"OcupacionPapaMICROEMPRESARIO" ,
"OcupacionPapaOBRERO" ,"OcupacionPapaOCUPACION" ,
"OcupacionPapaOTRO" ,"GradoInstruccionMama" ,
"GradoInstruccionMamaDRMAGISTER ALTA ESPECIALIDAD" ,"GradoInstruccionMamaESTSUPNO UNIVERSITARIOS" ,
"GradoInstruccionMamaGRADUADO UNIVERSITARIO" ,"GradoInstruccionMamaNINGUNO" ,
"GradoInstruccionMamaNIVEL EDUCATIVO" ,"GradoInstruccionMamaOTROS" ,
"GradoInstruccionMamaPRIMARIA COMPLETA" ,"GradoInstruccionMamaPRIMARIA INCOMPLETA" ,
"GradoInstruccionMamaSECUNDARIA COMPLETA" ,"GradoInstruccionMamaSECUNDARIA INCOMPLETA" ,
"GradoInstruccionMamaSUPERIOR TECNICA COMPLETA" ,"GradoInstruccionMamaSUPERIOR TECNICA INCOMPLETA" ,
"GradoInstruccionMamaSUPERIOR UNIVCOMPLETA" ,"GradoInstruccionMamaSUPERIOR UNIVINCOMPLETA" ,
"ProfesionMama" ,"ProfesionMamaABOGADO" ,
"ProfesionMamaADMINISTRADOR DE EMPRESAS" ,"ProfesionMamaANTROPOLOGO ARQUEOLOGO HISTORIADOR SOCIOLOGO Y ",
"ProfesionMamaARQUITECTO URBANISTA E INGENIERO DE TRANSITO" ,"ProfesionMamaBIOLOGO" ,
"ProfesionMamaCONTADOR" ,"ProfesionMamaECONOMISTA" ,
"ProfesionMamaENFERMERA" ,"ProfesionMamaFARMACEUTICO" ,
"ProfesionMamaINGENIERO CIVIL" ,"ProfesionMamaINGENIERO DE MINAS METALURGICO Y AFINES" ,
"ProfesionMamaINGENIERO DE SISTEMAS" ,"ProfesionMamaINGENIERO INDUSTRIAL" ,
"ProfesionMamaINGENIERO PESQUERO" ,"ProfesionMamaINGENIERO QUIMICO" ,
"ProfesionMamaMEDICO" ,"ProfesionMamaOBSTETRIZ" ,
"ProfesionMamaODONTOLOGO" ,"ProfesionMamaOTROS" ,
"ProfesionMamaPROFESION" ,"ProfesionMamaPROFESOR" ,
"ProfesionMamaPROFESOR DE EDUCACION INICIAL O PRE_ESCOLAR" ,"ProfesionMamaPROFESOR DE EDUCACION SECUNDARIA Y BASICA" ,
"ProfesionMamaPROFESOR Y O MAESTRO DE PRIMARIA" ,"ProfesionMamaPSICOLOGO" ,
"ProfesionMamaTRABAJADOR SOCIAL" ,"OcupacionMama" ,
"OcupacionMamaAGRICULTOR" ,"OcupacionMamaAMA DE CASA" ,
"OcupacionMamaCOMERCIANTE MAYORISTA" ,"OcupacionMamaCOMERCIANTE MINORISTA" ,
"OcupacionMamaCONDUCTOR DE VEHICULO" ,"OcupacionMamaEMPLEADO" ,
"OcupacionMamaEMPRESARIO" ,"OcupacionMamaFFPOLICIALES" ,
"OcupacionMamaJUBILADO CESANTE" ,"OcupacionMamaMICROEMPRESARIO" ,
"OcupacionMamaOBRERO" ,"OcupacionMamaOCUPACION" ,
"OcupacionMamaOTRO" ,"categoriaBinarizada" )
#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
2836 211
##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
2067 145
##### 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
769 66
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 766 57
SI 3 9
cm_RF <- confusionMatrix(predict(RF_MDL,x_testRF), y_testRF,positive="SI")
cm_RF$byClass
Sensitivity Specificity Pos Pred Value
0.13636364 0.99609883 0.75000000
Neg Pred Value Precision Recall
0.93074119 0.75000000 0.13636364
F1 Prevalence Detection Rate
0.23076923 0.07904192 0.01077844
Detection Prevalence Balanced Accuracy
0.01437126 0.56623123
#########################################################
#########################################################
# 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.838e-05 4.838e-05 4.838e-05 4.521e-04 4.838e-05 6.207e-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 766 57
SI 3 9
cm_RF_Weight <- confusionMatrix(predict(RF_Weight_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Weight$byClass
Sensitivity Specificity Pos Pred Value
0.13636364 0.99609883 0.75000000
Neg Pred Value Precision Recall
0.93074119 0.75000000 0.13636364
F1 Prevalence Detection Rate
0.23076923 0.07904192 0.01077844
Detection Prevalence Balanced Accuracy
0.01437126 0.56623123
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 594 17
SI 175 49
cm_RF_Under <- confusionMatrix(predict(RF_Under_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Under$byClass
Sensitivity Specificity Pos Pred Value
0.74242424 0.77373212 0.21973094
Neg Pred Value Precision Recall
0.97222222 0.21973094 0.74242424
F1 Prevalence Detection Rate
0.33910035 0.07904192 0.05868263
Detection Prevalence Balanced Accuracy
0.26706587 0.75807818
#
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 765 58
SI 4 8
cm_RF_Over <- confusionMatrix(predict(RF_Over_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Over$byClass
Sensitivity Specificity Pos Pred Value
0.121212121 0.994798440 0.666666667
Neg Pred Value Precision Recall
0.929526124 0.666666667 0.121212121
F1 Prevalence Detection Rate
0.205128205 0.079041916 0.009580838
Detection Prevalence Balanced Accuracy
0.014371257 0.558005280
# 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 749 47
SI 20 19
cm_RF_Smote <- confusionMatrix(predict(RF_Smote_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Smote$byClass
Sensitivity Specificity Pos Pred Value
0.28787879 0.97529259 0.50000000
Neg Pred Value Precision Recall
0.94102886 0.50000000 0.28787879
F1 Prevalence Detection Rate
0.36538462 0.07904192 0.02275449
Detection Prevalence Balanced Accuracy
0.04550898 0.63158569
#################### #################### ####################
#################### 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 769 66
SI 0 0
cm_RF_Scale <- confusionMatrix(predict(RF_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Scale
Confusion Matrix and Statistics
Reference
Prediction NO SI
NO 769 66
SI 0 0
Accuracy : 0.921
95% CI : (0.9005, 0.9383)
No Information Rate : 0.921
P-Value [Acc > NIR] : 0.5327
Kappa : 0
Mcnemar's Test P-Value : 1.235e-15
Sensitivity : 0.00000
Specificity : 1.00000
Pos Pred Value : NaN
Neg Pred Value : 0.92096
Prevalence : 0.07904
Detection Rate : 0.00000
Detection Prevalence : 0.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
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 682 41
SI 87 25
cm_RF_Under_Scale <- confusionMatrix(predict(RF_Under_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Under_Scale
Confusion Matrix and Statistics
Reference
Prediction NO SI
NO 681 41
SI 88 25
Accuracy : 0.8455
95% CI : (0.8192, 0.8694)
No Information Rate : 0.921
P-Value [Acc > NIR] : 1
Kappa : 0.1994
Mcnemar's Test P-Value : 5.12e-05
Sensitivity : 0.37879
Specificity : 0.88557
Pos Pred Value : 0.22124
Neg Pred Value : 0.94321
Prevalence : 0.07904
Detection Rate : 0.02994
Detection Prevalence : 0.13533
Balanced Accuracy : 0.63218
'Positive' Class : SI
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 759 56
SI 10 10
cm_RF_Over_Scale <- confusionMatrix(predict(RF_Over_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Over_Scale
Confusion Matrix and Statistics
Reference
Prediction NO SI
NO 759 56
SI 10 10
Accuracy : 0.921
95% CI : (0.9005, 0.9383)
No Information Rate : 0.921
P-Value [Acc > NIR] : 0.5327
Kappa : 0.2033
Mcnemar's Test P-Value : 3.04e-08
Sensitivity : 0.15152
Specificity : 0.98700
Pos Pred Value : 0.50000
Neg Pred Value : 0.93129
Prevalence : 0.07904
Detection Rate : 0.01198
Detection Prevalence : 0.02395
Balanced Accuracy : 0.56926
'Positive' Class : SI
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 769 66
SI 0 0
cm_RF_Smote_Scale <- confusionMatrix(predict(RF_Smote_Scale_MDL,x_testRF), y_testRF,positive="SI")
cm_RF_Smote_Scale
Confusion Matrix and Statistics
Reference
Prediction NO SI
NO 769 66
SI 0 0
Accuracy : 0.921
95% CI : (0.9005, 0.9383)
No Information Rate : 0.921
P-Value [Acc > NIR] : 0.5327
Kappa : 0
Mcnemar's Test P-Value : 1.235e-15
Sensitivity : 0.00000
Specificity : 1.00000
Pos Pred Value : NaN
Neg Pred Value : 0.92096
Prevalence : 0.07904
Detection Rate : 0.00000
Detection Prevalence : 0.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
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 769 61
SI 0 5
cm_ADj48_Lcaret <- confusionMatrix(predict(ADj48_Lcaret_MDL,x_testRF), y_testRF,positive="SI")
cm_ADj48_Lcaret$byClass
Sensitivity Specificity Pos Pred Value
0.075757576 1.000000000 1.000000000
Neg Pred Value Precision Recall
0.926506024 1.000000000 0.075757576
F1 Prevalence Detection Rate
0.140845070 0.079041916 0.005988024
Detection Prevalence Balanced Accuracy
0.005988024 0.537878788
###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 661 27
SI 108 39
cm_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.59090909 0.85955787 0.26530612
Neg Pred Value Precision Recall
0.96075581 0.26530612 0.59090909
F1 Prevalence Detection Rate
0.36619718 0.07904192 0.04670659
Detection Prevalence Balanced Accuracy
0.17604790 0.72523348
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 769 66
cm_NaiveBayes <- confusionMatrix(predict(NaiveBayes_MDL,x_testRF), y_testRF,positive="SI")
cm_NaiveBayes
Confusion Matrix and Statistics
Reference
Prediction NO SI
NO 0 0
SI 769 66
Accuracy : 0.079
95% CI : (0.0617, 0.0995)
No Information Rate : 0.921
P-Value [Acc > NIR] : 1
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.00000
Specificity : 0.00000
Pos Pred Value : 0.07904
Neg Pred Value : NaN
Prevalence : 0.07904
Detection Rate : 0.07904
Detection Prevalence : 1.00000
Balanced Accuracy : 0.50000
'Positive' Class : SI
#################################################################################################################
################################### 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"]
}
comparison
colnames(comparison) <- c(" model","Sensitivity","Specificity"," Precision"," Recall"," F1");
write.csv(comparison[,1:6],file="UPRIVADA_IngMinas2020.csv", sep=",",row.names = FALSE)