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("C:/Users/Administrador/Desktop/DataSetUprivadaBinarizadaSinRuidoFuturo.csv",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
Length:35693 Length:35693 Length:35693
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
MODALIDAD_INGRESO ANIO_INGRESO UBIG_NACIMIENTO UBIG_RESIDENCIA
Length:35693 Min. :2009 Length:35693 Length:35693
Class :character 1st Qu.:2011 Class :character Class :character
Mode :character Median :2012 Mode :character Mode :character
Mean :2012
3rd Qu.:2014
Max. :2017
TIPO_VIVIENDA GradoInstruccionPapa ProfesionPapa
Length:35693 Length:35693 Length:35693
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
OcupacionPapa GradoInstruccionMama ProfesionMama
Length:35693 Length:35693 Length:35693
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
OcupacionMama CantCursosAnulados categoria
Length:35693 Min. : 0.0000 Length:35693
Class :character 1st Qu.: 0.0000 Class :character
Mode :character Median : 0.0000 Mode :character
Mean : 0.2907
3rd Qu.: 0.0000
Max. :16.0000
categoriaBinarizada ProbabDesercion
Min. :0.0000 Length:35693
1st Qu.:0.0000 Class :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
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
F: 9994 Min. :1.000
M:25699 1st Qu.:1.000
Median :1.000
Mean :1.138
3rd Qu.:1.170
Max. :4.000
CarreraProfesional
INGENIERIA INDUSTRIAL :8791
INGENIERIA MECANICA, MECANICA-ELECTRICA Y MECATRONICA:8528
INGENIERIA DE SISTEMAS :4537
INGENIERIA ELECTRONICA :3699
MEDICINA VETERINARIA Y ZOOTECNIA :3124
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
Min. : 0.0000 Length:35693 0:32934
1st Qu.: 0.0000 Class :character 1: 2759
Median : 0.0000 Mode :character
Mean : 0.2907
3rd Qu.: 0.0000
Max. :16.0000
ProbabDesercion SortUltimaFila SortUltimaFila2
Min. : 0.000 Min. :0 Min. :0
1st Qu.: 5.190 1st Qu.:0 1st Qu.:0
Median : 5.870 Median :0 Median :0
Mean : 7.729 Mean :0 Mean :0
3rd Qu.:10.240 3rd Qu.:0 3rd Qu.:0
Max. :14.240 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 INDUSTRIA ALIMENTARIA" ) %>% droplevels
#Para que las variables se visualicen correctamente
for (variable in ListVar.Categ) { levels(DataSetUPRIVADAFRMTO.RF[,variable]) }
nrow(DataSetUPRIVADAFRMTO.RF)[1] 2392summary(DataSetUPRIVADAFRMTO.RF$CarreraProfesional)INGENIERIA DE INDUSTRIA ALIMENTARIA
2392 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
92.22408 7.77592 summary(DataSetUPRIVADAFRMTO.RF$categoriaBinarizada) C0 C1
2206 186 ##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
1103 93 mc_PredictOrigTuneGrid<- table(predict(orig_fit,x_testRF),y_testRF)
mc_PredictOrigTuneGrid y_testRF
C0 C1
C0 1103 92
C1 0 1cm_originalRF1 <- confusionMatrix(predict(orig_fit,x_testRF), y_testRF)
cm_originalRF1$byClass Sensitivity Specificity Pos Pred Value
1.00000000 0.01075269 0.92301255
Neg Pred Value Precision Recall
1.00000000 0.92301255 1.00000000
F1 Prevalence Detection Rate
0.95996519 0.92224080 0.92224080
Detection Prevalence Balanced Accuracy
0.99916388 0.50537634 #########################################################
#########################################################
# 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.0004533 0.0004533 0.0004533 0.0008361 0.0004533 0.0053763 # 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
1103 93 mc_PredictWeightTuneGrid<- table(predict(weighted_fit,x_testRF),y_testRF)
mc_PredictWeightTuneGrid y_testRF
C0 C1
C0 1103 92
C1 0 1cm_WeightRF1 <- confusionMatrix(predict(weighted_fit,x_testRF), y_testRF)
cm_WeightRF1$byClass Sensitivity Specificity Pos Pred Value
1.00000000 0.01075269 0.92301255
Neg Pred Value Precision Recall
1.00000000 0.92301255 1.00000000
F1 Prevalence Detection Rate
0.95996519 0.92224080 0.92224080
Detection Prevalence Balanced Accuracy
0.99916388 0.50537634 # 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
1103 93 mc_PredictDownTuneGrid<- table(predict(down_fit,x_testRF),y_testRF)
mc_PredictDownTuneGrid y_testRF
C0 C1
C0 881 47
C1 222 46cm_DownRF1 <- confusionMatrix(predict(down_fit,x_testRF), y_testRF)
cm_DownRF1$byClass Sensitivity Specificity Pos Pred Value
0.7987307 0.4946237 0.9493534
Neg Pred Value Precision Recall
0.1716418 0.9493534 0.7987307
F1 Prevalence Detection Rate
0.8675529 0.9222408 0.7366221
Detection Prevalence Balanced Accuracy
0.7759197 0.6466772 # 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
1103 93 mc_PredictUpTuneGrid<- table(predict(up_fit,x_testRF),y_testRF)
mc_PredictUpTuneGrid y_testRF
C0 C1
C0 1023 62
C1 80 31cm_UpRF1 <- confusionMatrix(predict(up_fit,x_testRF), y_testRF)
cm_UpRF1$byClass Sensitivity Specificity Pos Pred Value
0.9283772 0.3333333 0.9429098
Neg Pred Value Precision Recall
0.2818182 0.9429098 0.9283772
F1 Prevalence Detection Rate
0.9355870 0.9222408 0.8561873
Detection Prevalence Balanced Accuracy
0.9080268 0.6308552 # 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
1103 93 mc_PredictSmoteTuneGrid<- table(predict(smote_fit,x_testRF),y_testRF)
mc_PredictSmoteTuneGrid y_testRF
C0 C1
C0 1098 84
C1 5 9cm_SmoteRF1 <- confusionMatrix(predict(smote_fit,x_testRF), y_testRF)cm_SmoteRF1$byClass Sensitivity Specificity Pos Pred Value
0.99546691 0.09677419 0.92893401
Neg Pred Value Precision Recall
0.64285714 0.92893401 0.99546691
F1 Prevalence Detection Rate
0.96105033 0.92224080 0.91806020
Detection Prevalence Balanced Accuracy
0.98829431 0.54612055 #################### #################### ####################
#################### 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 1103 93
C1 0 0cm_original <- confusionMatrix(predict(model_rf,x_testRF), y_testRF)
cm_originalConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1103 93
C1 0 0
Accuracy : 0.9222
95% CI : (0.9056, 0.9368)
No Information Rate : 0.9222
P-Value [Acc > NIR] : 0.5276
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.9222
Neg Pred Value : NaN
Prevalence : 0.9222
Detection Rate : 0.9222
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'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 823 34
C1 280 59cm_originalUnder <- confusionMatrix(predict(model_rf_under,x_testRF), y_testRF)
cm_originalUnderConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 825 34
C1 278 59
Accuracy : 0.7391
95% CI : (0.7133, 0.7638)
No Information Rate : 0.9222
P-Value [Acc > NIR] : 1
Kappa : 0.1737
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.7480
Specificity : 0.6344
Pos Pred Value : 0.9604
Neg Pred Value : 0.1751
Prevalence : 0.9222
Detection Rate : 0.6898
Detection Prevalence : 0.7182
Balanced Accuracy : 0.6912
'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 1085 79
C1 18 14cm_originalOver <- confusionMatrix(predict(model_rf_over,x_testRF), y_testRF)
cm_originalOverConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1084 79
C1 19 14
Accuracy : 0.9181
95% CI : (0.901, 0.933)
No Information Rate : 0.9222
P-Value [Acc > NIR] : 0.727
Kappa : 0.1892
Mcnemar's Test P-Value : 2.524e-09
Sensitivity : 0.9828
Specificity : 0.1505
Pos Pred Value : 0.9321
Neg Pred Value : 0.4242
Prevalence : 0.9222
Detection Rate : 0.9064
Detection Prevalence : 0.9724
Balanced Accuracy : 0.5667
'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 1102 93
C1 1 0cm_originalSmote <- confusionMatrix(predict(model_rf_smote,x_testRF), y_testRF)
cm_originalSmoteConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 1102 93
C1 1 0
Accuracy : 0.9214
95% CI : (0.9047, 0.936)
No Information Rate : 0.9222
P-Value [Acc > NIR] : 0.5701
Kappa : -0.0017
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.9991
Specificity : 0.0000
Pos Pred Value : 0.9222
Neg Pred Value : 0.0000
Prevalence : 0.9222
Detection Rate : 0.9214
Detection Prevalence : 0.9992
Balanced Accuracy : 0.4995
'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 1103 93
C1 0 0cm_ccmodelBayesCaret <- confusionMatrix(predict(ccmodelBayes,x_testRF), y_testRF)
cm_ccmodelBayesCaret$byClass Sensitivity Specificity Pos Pred Value
1.0000000 0.0000000 0.9222408
Neg Pred Value Precision Recall
NaN 0.9222408 1.0000000
F1 Prevalence Detection Rate
0.9595476 0.9222408 0.9222408
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 915 65
C1 188 28cm_modelBayesCaret <- confusionMatrix(predict(modelBayes,x_testRF), y_testRF)
cm_modelBayesCaret$byClass Sensitivity Specificity Pos Pred Value
0.8295558 0.3010753 0.9336735
Neg Pred Value Precision Recall
0.1296296 0.9336735 0.8295558
F1 Prevalence Detection Rate
0.8785406 0.9222408 0.7650502
Detection Prevalence Balanced Accuracy
0.8193980 0.5653155 classificadorBayesiano <- naiveBayes(x_trainRF,y_trainRF)
mc_originalBayesiano<- table(predict(classificadorBayesiano,x_testRF), y_testRF)
mc_originalBayesiano y_testRF
C0 C1
C0 955 62
C1 148 31cm_originalBayesiano <- confusionMatrix(predict(classificadorBayesiano,x_testRF), y_testRF)
cm_originalBayesianoConfusion Matrix and Statistics
Reference
Prediction C0 C1
C0 955 62
C1 148 31
Accuracy : 0.8244
95% CI : (0.8016, 0.8456)
No Information Rate : 0.9222
P-Value [Acc > NIR] : 1
Kappa : 0.1399
Mcnemar's Test P-Value : 4.476e-09
Sensitivity : 0.8658
Specificity : 0.3333
Pos Pred Value : 0.9390
Neg Pred Value : 0.1732
Prevalence : 0.9222
Detection Rate : 0.7985
Detection Prevalence : 0.8503
Balanced Accuracy : 0.5996
'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