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)
#CARGAS DATOS PARA TRABAJAR MODELO PREDICTIVO
############################################
ruta <- 'C:/Users/Jhampier/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto'
setwd('C:/Users/Jhampier/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto')
#ruta <- 'C:/Users/jtapiasu/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto'
#setwd('C:/Users/jtapiasu/Google Drive/Maestria/TESIS DE MAESTRIA/Proyecto')
#C:\Users\Administrador\Desktop
#ruta <- 'C:/Users/Administrador/Desktop'
#setwd('C:/Users/Administrador/Desktop')
#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" ...View(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) CodAlumno SemestresEstudiadosAcum
"character" "numeric"
CantCursosLlevadosAcum CursosLlevadosFueraCarreraAcum
"numeric" "numeric"
AvgSinAplzAcum AvgConAplzAcum
"character" "character"
CantCursosAplzAcum SumCredTeoAcum
"numeric" "numeric"
SumCredPraAcum edad
"numeric" "numeric"
SEXO AvgVezMatriAcum
"character" "character"
CarreraProfesional MODALIDAD_INGRESO
"character" "character"
ANIO_INGRESO UBIG_NACIMIENTO
"numeric" "character"
UBIG_RESIDENCIA TIPO_VIVIENDA
"character" "character"
GradoInstruccionPapa ProfesionPapa
"character" "character"
OcupacionPapa GradoInstruccionMama
"character" "character"
ProfesionMama OcupacionMama
"character" "character"
CantCursosAnulados categoria
"numeric" "character"
categoriaBinarizada ProbabDesercion
"numeric" "character" summary(DataSetUprivada)#PODEMOS OBSERVAR EN EL POWER CodAlumno SemestresEstudiadosAcum CantCursosLlevadosAcum
Length:35693 Min. : 1.000 Min. : 1.00
Class :character 1st Qu.: 2.000 1st Qu.:11.00
Mode :character Median : 4.000 Median :20.00
Mean : 4.187 Mean :23.17
3rd Qu.: 6.000 3rd Qu.:33.00
Max. :12.000 Max. :81.00
CursosLlevadosFueraCarreraAcum AvgSinAplzAcum AvgConAplzAcum
Min. : 1.000 Length:35693 Length:35693
1st Qu.: 2.000 Class :character Class :character
Median : 4.000 Mode :character Mode :character
Mean : 4.306
3rd Qu.: 6.000
Max. :18.000
CantCursosAplzAcum SumCredTeoAcum SumCredPraAcum edad
Min. : 0.000 Min. : 1.0 Min. : 0.00 Min. : 14.00
1st Qu.: 1.000 1st Qu.: 27.0 1st Qu.: 7.00 1st Qu.: 18.00
Median : 3.000 Median : 50.0 Median :15.00 Median : 20.00
Mean : 5.247 Mean : 59.4 Mean :17.78 Mean : 20.55
3rd Qu.: 8.000 3rd Qu.: 85.0 3rd Qu.:25.00 3rd Qu.: 22.00
Max. :48.000 Max. :200.0 Max. :80.00 Max. :113.00
SEXO AvgVezMatriAcum CarreraProfesional MODALIDAD_INGRESO
Length:35693 Length:35693 Length:35693 Length:35693
Class :character Class :character Class :character Class :character
Mode :character Mode :character Mode :character Mode :character
ANIO_INGRESO UBIG_NACIMIENTO UBIG_RESIDENCIA TIPO_VIVIENDA
Min. :2009 Length:35693 Length:35693 Length:35693
1st Qu.:2011 Class :character Class :character Class :character
Median :2012 Mode :character Mode :character Mode :character
Mean :2012
3rd Qu.:2014
Max. :2017
GradoInstruccionPapa ProfesionPapa OcupacionPapa
Length:35693 Length:35693 Length:35693
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
GradoInstruccionMama ProfesionMama OcupacionMama CantCursosAnulados
Length:35693 Length:35693 Length:35693 Min. : 0.0000
Class :character Class :character Class :character 1st Qu.: 0.0000
Mode :character Mode :character Mode :character Median : 0.0000
Mean : 0.2907
3rd Qu.: 0.0000
Max. :16.0000
categoria categoriaBinarizada ProbabDesercion
Length:35693 Min. :0.0000 Length:35693
Class :character 1st Qu.:0.0000 Class :character
Mode :character Median :0.0000 Mode :character
Mean :0.0773
3rd Qu.:0.0000
Max. :1.0000 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
############################################################################
### ANTES
View(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) CodAlumno SemestresEstudiadosAcum CantCursosLlevadosAcum
Length:35693 Min. : 1.000 Min. : 1.00
Class :character 1st Qu.: 2.000 1st Qu.:11.00
Mode :character Median : 4.000 Median :20.00
Mean : 4.187 Mean :23.17
3rd Qu.: 6.000 3rd Qu.:33.00
Max. :12.000 Max. :81.00
CursosLlevadosFueraCarreraAcum AvgSinAplzAcum AvgConAplzAcum
Min. : 1.000 Min. : 0.00 Min. : 0.00
1st Qu.: 2.000 1st Qu.: 8.91 1st Qu.: 9.36
Median : 4.000 Median :10.63 Median :11.06
Mean : 4.306 Mean :10.54 Mean :10.84
3rd Qu.: 6.000 3rd Qu.:12.32 3rd Qu.:12.52
Max. :18.000 Max. :19.66 Max. :19.66
CantCursosAplzAcum SumCredTeoAcum SumCredPraAcum edad SEXO
Min. : 0.000 Min. : 1.0 Min. : 0.00 Min. : 14.00 F: 9994
1st Qu.: 1.000 1st Qu.: 27.0 1st Qu.: 7.00 1st Qu.: 18.00 M:25699
Median : 3.000 Median : 50.0 Median :15.00 Median : 20.00
Mean : 5.247 Mean : 59.4 Mean :17.78 Mean : 20.55
3rd Qu.: 8.000 3rd Qu.: 85.0 3rd Qu.:25.00 3rd Qu.: 22.00
Max. :48.000 Max. :200.0 Max. :80.00 Max. :113.00
AvgVezMatriAcum CarreraProfesional
Min. :1.000 INGENIERIA INDUSTRIAL :8791
1st Qu.:1.000 INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA:8528
Median :1.000 INGENIERIA DE SISTEMAS :4537
Mean :1.138 INGENIERIA ELECTRONICA :3699
3rd Qu.:1.170 MEDICINA VETERINARIA Y ZOOTECNIA :3124
Max. :4.000 INGENIERIA DE MINAS :3119
(Other) :3895
MODALIDAD_INGRESO ANIO_INGRESO UBIG_NACIMIENTO
Tercer Examen General :8524 Min. :2009 AREQUIPA :21072
Segundo Examen General :6259 1st Qu.:2011 PAUCARPATA: 1444
Primer Examen General :5818 Median :2012 JULIACA : 869
Centro Preuniversitario III:3417 Mean :2012 YANAHUARA : 707
Centro Preuniversitario I :2962 3rd Qu.:2014 ILO : 701
Centro Preuniversitario II :2962 Max. :2017 MOLLENDO : 655
(Other) :5751 (Other) :10245
UBIG_RESIDENCIA TIPO_VIVIENDA
JOSE LUIS BUSTAMANTE Y RIVERO: 5274 CASA :29859
CERRO COLORADO : 3949 DEPARTAMENTO: 5484
AREQUIPA : 3931 VECINDAD : 350
PAUCARPATA : 3272
CAYMA : 2701
YANAHUARA : 2381
(Other) :14185
GradoInstruccionPapa ProfesionPapa
SECUNDARIA COMPLETA :7703 OTROS :13173
SUPERIOR UNIV. COMPLETA :6279 PROFESION ... : 6469
SUPERIOR TECNICA COMPLETA:5469 CONTADOR : 2238
GRADUADO UNIVERSITARIO :4493 ADMINISTRADOR DE EMPRESAS: 1550
SUPERIOR UNIV. INCOMPLETA:4372 PROFESOR : 1479
NIVEL EDUCATIVO ... :1770 ABOGADO : 1313
(Other) :5607 (Other) : 9471
OcupacionPapa GradoInstruccionMama
EMPLEADO :10711 SECUNDARIA COMPLETA :8926
OTRO : 5305 SUPERIOR UNIV. COMPLETA :6048
OCUPACION ... : 3028 SUPERIOR TECNICA COMPLETA :5695
MICROEMPRESARIO : 2396 GRADUADO UNIVERSITARIO :4726
FF. POLICIALES : 2185 SUPERIOR UNIV. INCOMPLETA :3464
CONDUCTOR DE VEHICULO: 2182 EST. SUP. NO UNIVERSITARIOS:1674
(Other) : 9886 (Other) :5160
ProfesionMama OcupacionMama
OTROS :13518 AMA DE CASA :14746
PROFESION ... : 5909 EMPLEADO : 8825
ENFERMERA : 2976 OTRO : 3767
PROFESOR : 2966 COMERCIANTE MINORISTA: 2208
CONTADOR : 2400 OCUPACION ... : 1576
ADMINISTRADOR DE EMPRESAS: 871 MICROEMPRESARIO : 1558
(Other) : 7053 (Other) : 3013
CantCursosAnulados categoria categoriaBinarizada ProbabDesercion
Min. : 0.0000 Length:35693 0:32934 Min. : 0.000
1st Qu.: 0.0000 Class :character 1: 2759 1st Qu.: 5.190
Median : 0.0000 Mode :character Median : 5.870
Mean : 0.2907 Mean : 7.729
3rd Qu.: 0.0000 3rd Qu.:10.240
Max. :16.0000 Max. :14.240
SortUltimaFila SortUltimaFila2
Min. :0 Min. :0
1st Qu.:0 1st Qu.:0
Median :0 Median :0
Mean :0 Mean :0
3rd Qu.:0 3rd Qu.:0
Max. :0 Max. :0
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),]
View(SortNuevoDataSetUPRIVADAFRMTO)
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<-SortNuevoDataSetUPRIVADAFRMTOObservamos el DATASET ordenado cronologicamente
# Resultado DESPUES
View(DataSetUPRIVADAFRMTO) #### EL NUEVO DATA SET SE ENCUENTRA ORDENADO CRONOLOGICAMENTE
ncol(DataSetUPRIVADAFRMTO)[1] 28Configuración para el modelo de entrenamiento
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 DataSetUPRIVADAFRMTO.RF <-DataSetUPRIVADAFRMTO[,Var.TodasUprivada] %>% filter(gsub("^\\s+|\\s+$", "",CarreraProfesional) =="INGENIERIA DE SISTEMAS" ) %>% droplevels
#Para que las variables se visualicen correctamente
for (variable in ListVar.Categ) { levels(DataSetUPRIVADAFRMTO.RF[,variable]) }
nrow(DataSetUPRIVADAFRMTO.RF)[1] 4537summary(DataSetUPRIVADAFRMTO.RF$CarreraProfesional)INGENIERIA DE SISTEMAS
4537 DataSetUPRIVADAFRMTO.RF$CarreraProfesional <- NULL
# configurar función de control para Training
ctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 10, summaryFunction = twoClassSummary, classProbs = TRUE)
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada <- as.character(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada[DataSetUPRIVADAFRMTO.RF$categoriaBinarizada == "0"] <- "C0"### LOS QUE CONTINUAN
DataSetUPRIVADAFRMTO.RF$categoriaBinarizada[DataSetUPRIVADAFRMTO.RF$categoriaBinarizada == "1"] <- "C1"### 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))
C0 C1
91.117479 8.882521 summary(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada) C0 C1
4134 403 ##calculamos las filas para el entrenamiento
TotalFilas <- nrow(DataSetUPRIVADAFRMTO.RF)
#####Se tomara el 50% de las de la data para entremiento y el otro 50% sera para TEST
TrainFilas <- round(TotalFilas*0.5)
##VEMOS EL DATASET QUE SE UTILIZARA PARA ENTRENAR
View(DataSetUPRIVADAFRMTO.RF)AQUI SE APLICAN LOS MODELOS Y SE MUESTRA SUS MATRICES DE CONFUSIÓN COMO REFERENCIA
##DENIFIMOS LOS NODOS DE ENTRENAMIENTP
x_trainRF <- DataSetUPRIVADAFRMTO.RF[ (1:TrainFilas),]
y_trainRF <- DataSetUPRIVADAFRMTO.RF[ (1:TrainFilas),'categoriaBinarizada']
##### DATOS PARA ENTRENAMIENTO
View(x_trainRF)
x_testRF <- DataSetUPRIVADAFRMTO.RF[ ((TrainFilas+1):TotalFilas),]
y_testRF <- DataSetUPRIVADAFRMTO.RF[((TrainFilas+1):TotalFilas),'categoriaBinarizada']## configurarmos un paramtro de RamdomForest para tunear el modelo.
##### DATOS PARA TESTING
View(x_testRF)
tunegrid <- expand.grid(.mtry = c(sqrt(ncol(DataSetUPRIVADAFRMTO.RF))))
orig_fit <- caret::train(categoriaBinarizada ~ ., data = x_trainRF,verbose = FALSE
, method = "rf", metric = "ROC", tuneGrid = tunegrid
, trControl = ctrl)
summary(y_testRF) C0 C1
2061 208 mc_PredictOrigTuneGrid<- table(predict(orig_fit,x_testRF),y_testRF)
mc_PredictOrigTuneGrid y_testRF
C0 C1
C0 2061 203
C1 0 5cm_originalRF1 <- confusionMatrix(predict(orig_fit,x_testRF), y_testRF)
cm_originalRF1$byClass Sensitivity Specificity Pos Pred Value
1.00000000 0.02403846 0.91033569
Neg Pred Value Precision Recall
1.00000000 0.91033569 1.00000000
F1 Prevalence Detection Rate
0.95306358 0.90832966 0.90832966
Detection Prevalence Balanced Accuracy
0.99779639 0.51201923 #########################################################
#########################################################
# Create model weights (they sum to one)
model_weights <- ifelse(x_trainRF$categoriaBinarizada == "C0",
(1/table(x_trainRF$categoriaBinarizada)[1]) * 0.5,
(1/table(x_trainRF$categoriaBinarizada)[2]) * 0.5)
summary(model_weights) Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0002412 0.0002412 0.0002412 0.0004409 0.0002412 0.0025641 # Use the same seed to ensure same cross-validation splits
ctrl$seeds <- orig_fit$control$seeds
# Build weighted model
weighted_fit <- train(categoriaBinarizada ~ .,
data = x_trainRF,
method = "rf",
verbose = FALSE,
weights = model_weights,
metric = "ROC",
tuneGrid = tunegrid,
trControl = ctrl)
summary(y_testRF) C0 C1
2061 208 mc_PredictWeightTuneGrid<- table(predict(weighted_fit,x_testRF),y_testRF)
mc_PredictWeightTuneGrid y_testRF
C0 C1
C0 2061 203
C1 0 5cm_WeightRF1 <- confusionMatrix(predict(weighted_fit,x_testRF), y_testRF)
cm_WeightRF1$byClass Sensitivity Specificity Pos Pred Value
1.00000000 0.02403846 0.91033569
Neg Pred Value Precision Recall
1.00000000 0.91033569 1.00000000
F1 Prevalence Detection Rate
0.95306358 0.90832966 0.90832966
Detection Prevalence Balanced Accuracy
0.99779639 0.51201923 # Build down-sampled model
ctrl$sampling <- "down"
down_fit <- train(categoriaBinarizada ~ .,
data = x_trainRF,
method = "rf",
verbose = FALSE,
tuneGrid = tunegrid,
metric = "ROC",
trControl = ctrl)
summary(y_testRF) C0 C1
2061 208 mc_PredictDownTuneGrid<- table(predict(down_fit,x_testRF),y_testRF)
mc_PredictDownTuneGrid y_testRF
C0 C1
C0 1825 97
C1 236 111cm_DownRF1 <- confusionMatrix(predict(down_fit,x_testRF), y_testRF)
cm_DownRF1$byClass Sensitivity Specificity Pos Pred Value
0.8850073 0.5336538 0.9495055
Neg Pred Value Precision Recall
0.3189655 0.9495055 0.8850073
F1 Prevalence Detection Rate
0.9161226 0.9083297 0.8038784
Detection Prevalence Balanced Accuracy
0.8466285 0.7093306 # Build up-sampled model
ctrl$sampling <- "up"
up_fit <- train(categoriaBinarizada ~ .,
data = x_trainRF,
method = "rf",
verbose = FALSE,
metric = "ROC",
tuneGrid = tunegrid,
trControl = ctrl)
summary(y_testRF) C0 C1
2061 208 mc_PredictUpTuneGrid<- table(predict(up_fit,x_testRF),y_testRF)
mc_PredictUpTuneGrid y_testRF
C0 C1
C0 1894 111
C1 167 97cm_UpRF1 <- confusionMatrix(predict(up_fit,x_testRF), y_testRF)
cm_UpRF1$byClass Sensitivity Specificity Pos Pred Value
0.9184862 0.4615385 0.9441397
Neg Pred Value Precision Recall
0.3636364 0.9441397 0.9184862
F1 Prevalence Detection Rate
0.9311363 0.9083297 0.8342882
Detection Prevalence Balanced Accuracy
0.8836492 0.6900123 # Build smote model
ctrl$sampling <- "smote"
smote_fit <- train(categoriaBinarizada ~ .,
data = x_trainRF,
method = "rf",
verbose = FALSE,
metric = "ROC",
tuneGrid = tunegrid,
trControl = ctrl)
summary(y_testRF) C0 C1
2061 208 mc_PredictSmoteTuneGrid<- table(predict(smote_fit,x_testRF),y_testRF)
mc_PredictSmoteTuneGrid y_testRF
C0 C1
C0 2046 186
C1 15 22cm_SmoteRF1 <- confusionMatrix(predict(smote_fit,x_testRF), y_testRF)cm_SmoteRF1$byClass Sensitivity Specificity Pos Pred Value
0.9927220 0.1105769 0.9170775
Neg Pred Value Precision Recall
0.6052632 0.9170775 0.9927220
F1 Prevalence Detection Rate
0.9534017 0.9083297 0.9017188
Detection Prevalence Balanced Accuracy
0.9832525 0.5516495 #################### #################### ####################
#################### NUEVOS
ctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 10, verboseIter = FALSE)
# summary( DataSetUPRIVADAFRMTO.RF$categoriaBinarizada)
# summary(x_trainRF$categoriaBinarizada)
# summary(x_testRF$categoriaBinarizada)
set.seed(5627)
model_rf <- caret::train(categoriaBinarizada ~ ., data = x_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_original<- table(predict(model_rf,x_testRF), y_testRF)
mc_original y_testRF
C0 C1
C0 2038 157
C1 23 51cm_original <- confusionMatrix(predict(model_rf,x_testRF), y_testRF)
cm_originalConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 2038 156
C1 23 52
Accuracy : 0.9211
95% CI : (0.9092, 0.9319)
No Information Rate : 0.9083
P-Value [Acc > NIR] : 0.01749
Kappa : 0.3352
Mcnemar's Test P-Value : < 2e-16
Sensitivity : 0.9888
Specificity : 0.2500
Pos Pred Value : 0.9289
Neg Pred Value : 0.6933
Prevalence : 0.9083
Detection Rate : 0.8982
Detection Prevalence : 0.9669
Balanced Accuracy : 0.6194
'Positive' Class : C0
ctrl$sampling <- "down"
set.seed(5627)
model_rf_under <- caret::train(categoriaBinarizada ~ ., data = x_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalUnder<- table(predict(model_rf_under,x_testRF), y_testRF)
mc_originalUnder y_testRF
C0 C1
C0 1422 52
C1 639 156cm_originalUnder <- confusionMatrix(predict(model_rf_under,x_testRF), y_testRF)
cm_originalUnderConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1421 53
C1 640 155
Accuracy : 0.6946
95% CI : (0.6752, 0.7135)
No Information Rate : 0.9083
P-Value [Acc > NIR] : 1
Kappa : 0.1916
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.6895
Specificity : 0.7452
Pos Pred Value : 0.9640
Neg Pred Value : 0.1950
Prevalence : 0.9083
Detection Rate : 0.6263
Detection Prevalence : 0.6496
Balanced Accuracy : 0.7173
'Positive' Class : C0
ctrl$sampling <- "up"
set.seed(5627)
model_rf_over <- caret::train(categoriaBinarizada ~ ., data = x_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalOver<- table(predict(model_rf_over,x_testRF), y_testRF)
mc_originalOver y_testRF
C0 C1
C0 1995 152
C1 66 56cm_originalOver <- confusionMatrix(predict(model_rf_over,x_testRF), y_testRF)
cm_originalOverConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1997 152
C1 64 56
Accuracy : 0.9048
95% CI : (0.892, 0.9166)
No Information Rate : 0.9083
P-Value [Acc > NIR] : 0.7339
Kappa : 0.2941
Mcnemar's Test P-Value : 3.227e-09
Sensitivity : 0.9689
Specificity : 0.2692
Pos Pred Value : 0.9293
Neg Pred Value : 0.4667
Prevalence : 0.9083
Detection Rate : 0.8801
Detection Prevalence : 0.9471
Balanced Accuracy : 0.6191
'Positive' Class : C0
ctrl$sampling <- "smote"
set.seed(5627)
model_rf_smote <- caret::train(categoriaBinarizada ~ ., data = x_trainRF,
method = "rf", preProcess = c("scale", "center"),
trControl = ctrl)
mc_originalSmote<- table(predict(model_rf_smote,x_testRF), y_testRF)
mc_originalSmote y_testRF
C0 C1
C0 2061 208
C1 0 0cm_originalSmote <- confusionMatrix(predict(model_rf_smote,x_testRF), y_testRF)
cm_originalSmoteConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 2061 208
C1 0 0
Accuracy : 0.9083
95% CI : (0.8957, 0.9199)
No Information Rate : 0.9083
P-Value [Acc > NIR] : 0.5185
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.9083
Neg Pred Value : NaN
Prevalence : 0.9083
Detection Rate : 0.9083
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : C0
###PRUEBA
ccmodelBayes <- caret::train(categoriaBinarizada ~ ., data=x_trainRF,'nb')
mc_ccmodelBayesCaret<- table(predict(ccmodelBayes,x_testRF), y_testRF)mc_ccmodelBayesCaret y_testRF
C0 C1
C0 2061 208
C1 0 0cm_ccmodelBayesCaret <- confusionMatrix(predict(ccmodelBayes,x_testRF), y_testRF)
cm_ccmodelBayesCaret$byClass Sensitivity Specificity Pos Pred Value
1.0000000 0.0000000 0.9083297
Neg Pred Value Precision Recall
NaN 0.9083297 1.0000000
F1 Prevalence Detection Rate
0.9519630 0.9083297 0.9083297
Detection Prevalence Balanced Accuracy
1.0000000 0.5000000 ##### NAIVE BAYES ########
x_trainRF$categoriaBinarizada <- NULL
x_testRF$categoriaBinarizada <- NULL###CON CARET
library(e1071)
modelBayes <- caret::train(x_trainRF,y_trainRF,'nb')
mc_modelBayesCaret<- table(predict(modelBayes,x_testRF), y_testRF)
mc_modelBayesCaret y_testRF
C0 C1
C0 1692 124
C1 369 84cm_modelBayesCaret <- confusionMatrix(predict(modelBayes,x_testRF), y_testRF)
cm_modelBayesCaret$byClass Sensitivity Specificity Pos Pred Value
0.8209607 0.4038462 0.9317181
Neg Pred Value Precision Recall
0.1854305 0.9317181 0.8209607
F1 Prevalence Detection Rate
0.8728398 0.9083297 0.7457030
Detection Prevalence Balanced Accuracy
0.8003526 0.6124034 classificadorBayesiano <- naiveBayes(x_trainRF,y_trainRF)
mc_originalBayesiano<- table(predict(classificadorBayesiano,x_testRF), y_testRF)
mc_originalBayesiano y_testRF
C0 C1
C0 1855 116
C1 206 92cm_originalBayesiano <- confusionMatrix(predict(classificadorBayesiano,x_testRF), y_testRF)
cm_originalBayesianoConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1855 116
C1 206 92
Accuracy : 0.8581
95% CI : (0.843, 0.8722)
No Information Rate : 0.9083
P-Value [Acc > NIR] : 1
Kappa : 0.2866
Mcnemar's Test P-Value : 7.057e-07
Sensitivity : 0.9000
Specificity : 0.4423
Pos Pred Value : 0.9411
Neg Pred Value : 0.3087
Prevalence : 0.9083
Detection Rate : 0.8175
Detection Prevalence : 0.8687
Balanced Accuracy : 0.6712
'Positive' Class : C0
View(x_trainRF)
#################################################################################################################
################################### RESUMEN DE RESULTADOS #######################################################
# #################################################################################################################
# View(x_trainRF)
# View(y_trainRF)
# View(x_testRF)
# View(y_testRF)
# summary(x_testRF)
# summary(y_testRF)
# mc_originalBayesianomodels <- list( originalRF1 = orig_fit,
WeightRF1 = weighted_fit,
DownRF1 = down_fit,
UpRF1 = up_fit,
SmoteRF1 = smote_fit,
original = model_rf,
originalUnder = model_rf_under,
originalOver = model_rf_over,
originalSmote = model_rf_smote,
ccmodelBayesCaret = ccmodelBayes,
modelBayesCaret = modelBayes,
originalBayesiano = classificadorBayesiano
)
# 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,
originalRF1={rowModel<- 1},
WeightRF1 ={rowModel<- 2},
DownRF1 ={rowModel<- 3},
UpRF1 ={rowModel<- 4}, #smote
SmoteRF1 ={rowModel<- 5}, #Bayesiano
original ={rowModel<- 6},
originalUnder ={rowModel<- 7},
originalOver ={rowModel<- 8},
originalSmote = {rowModel<- 9},
ccmodelBayesCaret = {rowModel<- 10},
modelBayesCaret = {rowModel<- 11},
originalBayesiano = {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