1 TAREA 1: PREPROCESADO

1.1 Lectura de datos

library(foreign)
library(tidyverse)
library(vcd)
library(funModeling)
library(formattable)
library(caret)
library(sampling)
library(corrplot)
library(randomForest)
library(bnclassify)
library(ROCR)
library(pROC)
library(yardstick)
library(patchwork)
library(arules)

datos<-read.spss("datos.sav",to.data.frame = TRUE)
str(datos)

## 'data.frame':    6400 obs. of  29 variables:
##  $ edad    : num  55 56 28 24 25 45 42 35 46 34 ...
##  $ marital : Factor w/ 2 levels "Sin casar","Casado": 2 1 2 2 1 2 1 1 1 2 ...
##  $ direcc  : num  12 29 9 4 2 9 19 15 26 0 ...
##  $ ingres  : num  72 153 28 26 23 76 40 57 24 89 ...
##  $ ingcat  : Factor w/ 4 levels "Menos de $25",..: 3 4 2 2 1 4 2 3 1 4 ...
##  $ coche   : num  36.2 76.9 13.7 12.5 11.3 37.2 19.8 28.2 12.2 46.1 ...
##  $ cochecat: Factor w/ 3 levels "Económico","Estándar",..: 3 3 1 1 1 3 2 2 1 3 ...
##  $ educ    : Factor w/ 5 levels "No completó el bachillerato",..: 1 1 3 4 2 3 3 2 1 3 ...
##  $ empleo  : num  23 35 4 0 5 13 10 1 11 12 ...
##  $ retirado: Factor w/ 2 levels "No","Sí": 1 1 1 1 1 1 1 1 1 1 ...
##  $ empcat  : Factor w/ 3 levels "Menos de 5","5 a 15",..: 3 3 1 1 2 2 2 1 2 2 ...
##  $ satlab  : Factor w/ 5 levels "Muy insatisfecho",..: 5 4 3 1 2 2 2 1 5 4 ...
##  $ genero  : Factor w/ 2 levels "Hombre","Mujer": 2 1 2 1 1 1 1 2 2 1 ...
##  $ residen : num  4 1 3 3 2 2 1 1 2 6 ...
##  $ inalam  : Factor w/ 2 levels "Sí","No": 1 2 2 2 1 1 2 1 1 2 ...
##  $ multline: Factor w/ 2 levels "Sí","No": 1 1 1 2 1 2 2 1 1 1 ...
##  $ voz     : Factor w/ 2 levels "Sí","No": 2 2 2 2 1 2 2 1 2 2 ...
##  $ busca   : Factor w/ 2 levels "Sí","No": 1 2 1 1 1 2 1 1 1 1 ...
##  $ internet: Factor w/ 2 levels "Sí","No": 1 1 1 1 1 1 2 1 1 1 ...
##  $ idllam  : Factor w/ 2 levels "Sí","No": 1 2 2 1 2 1 2 1 2 2 ...
##  $ espera  : Factor w/ 2 levels "Sí","No": 1 2 2 2 1 1 1 1 1 2 ...
##  $ tv      : Factor w/ 2 levels "Sí","No": 2 2 2 2 2 2 2 2 2 2 ...
##  $ video   : Factor w/ 2 levels "Sí","No": 2 2 2 2 2 2 2 2 2 2 ...
##  $ cd      : Factor w/ 2 levels "Sí","No": 2 2 2 2 2 2 2 2 2 2 ...
##  $ pda     : Factor w/ 2 levels "Sí","No": 1 1 2 2 1 1 1 1 1 1 ...
##  $ pc      : Factor w/ 2 levels "Sí","No": 1 1 2 2 1 2 1 2 1 1 ...
##  $ fax     : Factor w/ 2 levels "Sí","No": 1 1 1 2 1 1 1 1 1 2 ...
##  $ noticias: Factor w/ 2 levels "Sí","No": 1 1 2 2 2 1 1 1 2 2 ...
##  $ respuest: Factor w/ 2 levels "Sí","No": 2 1 2 2 2 2 2 2 2 1 ...
##  - attr(*, "variable.labels")= Named chr [1:29] "Edad en años" "Estado civil" "Años en la dirección actual" "Ingresos del hogar en miles" ...
##   ..- attr(*, "names")= chr [1:29] "edad" "marital" "direcc" "ingres" ...
##  - attr(*, "codepage")= int 65001

summary(datos)

##       edad            marital         direcc          ingres       
##  Min.   :18.00   Sin casar:3224   Min.   : 0.00   Min.   :   9.00  
##  1st Qu.:33.00   Casado   :3176   1st Qu.: 3.00   1st Qu.:  28.00  
##  Median :41.00                    Median : 9.00   Median :  45.00  
##  Mean   :42.06                    Mean   :11.56   Mean   :  69.47  
##  3rd Qu.:51.00                    3rd Qu.:17.00   3rd Qu.:  79.00  
##  Max.   :77.00                    Max.   :56.00   Max.   :1116.00  
##           ingcat         coche            cochecat   
##  Menos de $25:1174   Min.   : 4.20   Económico:1841  
##  $25 - $49   :2388   1st Qu.:13.90   Estándar :2275  
##  $50 - $74   :1120   Median :22.20   Lujo     :2284  
##  $75+        :1718   Mean   :30.13                   
##                      3rd Qu.:39.50                   
##                      Max.   :99.90                   
##                           educ          empleo      retirado         empcat    
##  No completó el bachillerato:1390   Min.   : 0.00   No:6092   Menos de 5:2216  
##  Bachillerato               :1936   1st Qu.: 3.00   Sí: 308   5 a 15    :2364  
##  Universitarios parciales   :1360   Median : 8.00             Más de 15 :1820  
##  Universitarios             :1355   Mean   :10.57                              
##  Post-universitarios        : 359   3rd Qu.:16.00                              
##                                     Max.   :57.00                              
##                satlab        genero        residen     inalam    multline 
##  Muy insatisfecho :1109   Hombre:3221   Min.   :1.00   Sí:3853   Sí:3709  
##  Algo insatisfecho:1268   Mujer :3179   1st Qu.:1.00   No:2547   No:2691  
##  Neutro           :1393                 Median :2.00                      
##  Algo satisfecho  :1406                 Mean   :2.35                      
##  Muy satisfecho   :1224                 3rd Qu.:3.00                      
##                                         Max.   :9.00                      
##  voz       busca     internet    idllam    espera     tv       video    
##  Sí:3645   Sí:4819   Sí  :4509   Sí:3133   Sí:3153   Sí:  63   Sí: 255  
##  No:2755   No:1581   No  :1636   No:3267   No:3247   No:6337   No:6145  
##                      NA's: 255                                          
##                                                                         
##                                                                         
##                                                                         
##   cd       pda        pc       fax       noticias  respuest 
##  Sí: 194   Sí:5093   Sí:3589   Sí:5198   Sí:2768   Sí: 679  
##  No:6206   No:1307   No:2811   No:1202   No:3632   No:5721  
##                                                             
##                                                             
##                                                             
##

A la vista de las salidas anteriores podemos señalar los siguientes aspectos:

Hay variables que están tanto en versión numérica como categorica (ingresos, precio del coche actual, años en la empresa actual), por lo que habrá que optar por una u otra.
Existen 255 (4%) valores perdidos en la variable internet.
La variable residen es susceptible de ser categorizada debido al reducido número de valores únicos.
La variable respuesta presenta un fuerte desbalanceo de clases (10,6% vs 89,4%).
Las variables ingres, empleo, coche y direcc contienen valores extremos, ya que sus valores máximos se separan mucho de su tercer cuartil.

Factorizamos la variable residen en tres grupos:

Soltero: una única persona en el hogar.
Pareja: dos convivientes en el hogar, entendiendo que en la mayoría de casos se tratará de parejas (aunque pueden darse otras situaciones como, por ejemplo, padre/madre e hijo ).
Familia: cuando son más de dos convivientes.

datos<-datos %>% mutate(residen=case_when(residen==1~"soltero",
                                residen==2~ "pareja",
                                TRUE~ "familia"))
datos$residen<-as.factor(datos$residen)
datos %>% group_by(residen) %>% count() %>% formattable()

residen	n
familia	2283
pareja	1651
soltero	2466

La variable residen es importante porque la variable ingresos (que como veremos más adelante es la más importante) está medida como los ingresos del hogar, por lo que normalmente a mayor número de miembros en el hogar mayor serán los ingresos. Podríamos crear una nueva variable mediante el cociente entre los ingresos y el número de miembros en el hogar, sin embargo, las dejaremos como están.

1.2 Análisis descriptivo y gráfico

plot_num(datos)

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

En las variables numércias se aprecia una fuerte asimetría positiva con valores extremos en la cola derecha, especialmente en el caso de la variable ingresos.

Realizamos ahora un análisis de bivariante de las variables numéricas mediante graficos de dispersión, creados a través de la función gráfico_dispersión, cuya especificación se encuentra en el anexo que hay al final del documento.

p1<-grafico_dispersion(datos,"edad","ingres",0.98)
p2<-grafico_dispersion(datos,"edad","coche",0.98)
p3<-grafico_dispersion(datos,"edad","empleo",0.98)
p4<-grafico_dispersion(datos,"edad","direcc",0.98)
p5<-grafico_dispersion(datos,"ingres","coche",0.98)
p6<-grafico_dispersion(datos,"ingres","empleo",0.98)
p7<-grafico_dispersion(datos,"ingres","direcc",0.98)
p8<-grafico_dispersion(datos,"coche","empleo",0.98)
p9<-grafico_dispersion(datos,"coche","direcc",0.98)
p10<-grafico_dispersion(datos,"empleo","direcc",0.98)


(p1+p2)/(p3+p4)

(p5+p6)/(p7+p8)

p9+p10

La variable edad tiene una relación positiva con las otras cuatro variables, aunque respecto de las variables ingresos y coche, a partir de los 55 años aproximadamente la relación se convierte en negativa, es decir, que a partir de esa edad se reducen los ingresos en media. Es ovbio que, salvo este último matiz, a mayor edad más probable es llevar más tiempo viviendo en el domicilio actual y trabajando en la empresa actual, lo que tambien hace que los ingresos sean mayores y el valor del coche también.
Las variables ingresos y coche (que como veremos más adelante y como ya se muestra en el gráfico de dispersión de estas variable, están fuertemente correlacionadas) mantienen una relación positiva con empleo y direcc (con esta última un poco más debil) como ya hemos explicado.
Y por último, las variables direcc y empleo también estan positivamente relacionadas.
Llama mucho la atención el gráfico entre las variables ingresos y coche. Lo volvemos a hacer sin filtrado de outliers:

grafico_dispersion(datos,"ingres","coche")

## `geom_smooth()` using formula 'y ~ x'

Hasta apróximadamente 200 unidades de ingresos, la correlación es prácticamente de 1, sin embargo, a partir de dicho umbral, el valor del coche disminuye y hay una mayor dispersión y no se observa correlación alguna.

Ahora realizaremos gráficos de densidad, confrontando las variables numéricas con la variable objetivo, para evaluar el poder discriminante univariante de estas variables:

p11<-grafico_densidad(datos,"ingres","respuest",0.98)

## Warning: Ignoring unknown aesthetics: na.rm

p12<-grafico_densidad(datos,"edad","respuest")

## Warning: Ignoring unknown aesthetics: na.rm

p13<-grafico_densidad(datos,"coche","respuest",0.98)

## Warning: Ignoring unknown aesthetics: na.rm

p14<-grafico_densidad(datos,"empleo","respuest")

## Warning: Ignoring unknown aesthetics: na.rm

p15<-grafico_densidad(datos,"direcc","respuest")

## Warning: Ignoring unknown aesthetics: na.rm

(p11+p12)/(p13+p14)+plot_layout(guides = 'collect')

p15

La variable edad parece indicar que las las personas mayores de aproximadamente 58 años son más susceptibles de responder. Las variables ingres y coche también discriminan y nos indican que las personas con menores ingresos o menor valor de su vehículo son más susceptibles de responder. Por su parte, las variables direcc y empleo no discriminan prácticamente nada.

Respecto a las variables categóricas, las cruzaremos con la variable objetivo para analizar si las proporciones de personas que responden o no varían entre los diferentes niveles de cada factor:

cross_plot(select_if(datos,is.factor),target = "respuest")

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

Destacan como variables que más discriminan las siguientes: ingcat, cochecat, educ, retirado, noticias, internet y pc. También parecen discriminar bastante bien las variables tv, cd y video, sin embargo, se trata de variables que tienen un número demasiado reducido de su clase minoritaria, por lo que los resultados no son muy fiables. Las variables marital, empcat, satlab, genero, residen, inalam, pda y fax apenas tienen poder discriminatorio.

Según lo anterior, podriamos caracterizar las personas que son más susceptibles de contestar a las ofertas como persona con bajos ingresos (y bajo valor de su vehículo), con poca formación, de edad avanzada (especialmente retirados), que están suscritos a un periódico y que tienen contratados los servicios de internet y pc.
Hay que señalar que cuando se habla de que una variable tenga o no tenga poder discriminante, es de forma univariante, sin embargo, puede ocurrir que una variable que no tiene poder discriminante de forma univariante al interaccionar con otras variables sí lo sea, y viceversa.

1.3 Valores ausentes

La variable internet contiene 255 valores ausentes. Teniendo en cuenta el fuerte desbalanceo de la muestra respecto a la variable objetivo y el número reducido de observaciones de la clase minoritaría, podemos permitirnos prescindir de registros de la clase mayoritaria (de hecho es lo que haremos posteriormente para balancear la muestra), pero no podemos permitirnos prescindir de registros de la clase minoritaria. Es más, si internet fuese una variable con poco poder discriminatorio sería máss aconsejable eliminarla que prescindir de los registros con datos ausentes. Teniendo en cuenta lo anterior llevaremos a cabo la siguiente estrategia respecto a los valores ausentes: eliminación de los registros donde la variable respuesta es igual a “No” e imputación mediante random forest de los registros donde la variable respuesta es igual a “Sí”.

# Número de resgitros con valores ausentes por respuesta
filter(datos,is.na(internet)) %>% group_by(respuest) %>% count()

## # A tibble: 2 x 2
## # Groups:   respuest [2]
##   respuest     n
##   <fct>    <int>
## 1 Sí          29
## 2 No         226

# Imputación a registros con respuest=="Sí"
datos<-datos %>% filter(!(is.na(internet))|respuest=="Sí")
datos<-rfImpute(respuest~.,data=datos)

sum(is.na(datos))

## [1] 0

1.4 Análisis de correlaciones

Para este análisis utilizaremos el coeficiente de correlación de Pearson para variable numéricas y la V de Cramer para variables categóricas.

var_cat<- datos %>% select_if(is.factor) # Variables categóricas
var_num<-datos %>% select_if(is.numeric) # Variables numéricas

#Partimos de una matriz vacía con las dimensiones apropiadas
empty_m <- matrix(ncol = length(var_cat),
                  nrow = length(var_cat),
                  dimnames = list(names(var_cat),
                  names(var_cat)))

# Creamos la función para rellenar la matriz vacía con el estadístico de Cramer
calculate_cramer <- function(m, df) {
                      for (r in seq(nrow(m))){
                          for (c in seq(ncol(m))){
                            m[[r, c]] <- assocstats(table(df[[r]], df[[c]]))$cramer
}
}
return(m)
}

asoc_matrix <- calculate_cramer(empty_m ,var_cat) # Matriz de asociación de  variables categóricas
corrplot(asoc_matrix,type = "upper",diag = FALSE,method = "number",number.cex = 0.75,tl.cex = 0.7,addCoefasPercent = TRUE)

cor_matrix<-cor(var_num) # Matriz de correlación de variables numéricas
corrplot(cor_matrix,method = "number",type="upper",diag = FALSE)

Existen altas correlaciones entre varias variables. Por ejemplo, entre las variables ingresos, precio del coche actual y años en la empresa actual, lo cual es lógico ya que a mayor tiempo en una empresa mayor será el salario y cuanto mayores sean los ingresos mayor será el valor de tu vehículo. Eliminaremos la variable coche y cochecat por la fuerte correlación que tiene con ingresos y la extraña relación que hemos comentado antes en el análisis gráfico. Por otro lado, existe una alta correlación entre residen y marital, y es que es obvio que los que no esten casados normalmente vivirán solos y si estás casado vivirán en la residencia actual 2 o más personas.La variable residen contiene más información que marital, por lo que nos quedaremos con la primera.
Por últimmo, es evidente que las variables edad y retirado estarán también fuertemente correlacionadas. Eliminaremos la variable retirado, ya que la variable edad contiene más imformación.

datos<-select(datos,-c(coche,cochecat,marital,retirado))

1.5 Equilibrado de la muestra

El balanceo de la muestra es necesario, porque de lo contrario, la mayoría de modelos simplemente se limitarán a predecir todas las observaciones como pertenecientes a la clase mayoritaria, consiguiendo un alto valor de accuracy pero un bajísimo valor de sensibilidad, es decir, no son capaces de identificar la clase de interés.

round(prop.table(table(datos$respuest)),2)

## 
##   Sí   No 
## 0.11 0.89

Para equilibrar la muestra emplearemos el método del cubo, reduciendo la clase mayoritaria hasta un número igual al de la clase minoritaria. Usaremos todas las variables disponibles como variables auxiliares, excepto cd, video y tv.

datos<- datos %>% filter(!is.na(internet))

# Creamos un dataframe que contenga sólo las observaciones de clientes que no han contestado (clase mayoritaria)
datos.no<-datos[datos$respuest=="No",]

# Seleccionamos las variables numéricas
VNUM<-as.matrix(datos.no[,c("edad","direcc","ingres","empleo")])
colnames(VNUM)<-c("edad","direcc","ingres","empleo")

# Creamos variables dummies para las variables categóricas

X1<-disjunctive(datos.no$educ)
colnames(X1)<-levels(datos.no$educ)

X2<-disjunctive(datos.no$genero)
colnames(X2)<-levels(datos.no$genero)

X3<-disjunctive(datos.no$residen)
colnames(X3)<-levels(datos.no$residen)

X4<-disjunctive(datos.no$noticias)
colnames(X4)<-c("noticias.si","noticias.no")

X5<-disjunctive(datos.no$satlab)
colnames(X5)<-levels(datos.no$satlab)

X6<-disjunctive(datos.no$inalam)
colnames(X6)<-c("inalam.si","inalam.no")

X7<-disjunctive(datos.no$multline)
colnames(X7)<-c("multline.si","multline.no")

X8<-disjunctive(datos.no$voz)
colnames(X8)<-c("voz.si","voz.no")

X9<-disjunctive(datos.no$busca)
colnames(X9)<-c("busca.si","busca.no")

X10<-disjunctive(datos.no$internet)
colnames(X10)<-c("internet.si","internet.no")

X11<-disjunctive(datos.no$idllam)
colnames(X11)<-c("idllam.si","idllam.no")

X12<-disjunctive(datos.no$espera)
colnames(X12)<-c("espera.si","espera.no")

X13<-disjunctive(datos.no$pda)
colnames(X13)<-c("pda.si","pda.no")

X14<-disjunctive(datos.no$pc)
colnames(X14)<-c("pc.si","pc.no")

X15<-disjunctive(datos.no$fax)
colnames(X15)<-c("fax.si","fax.no")

# Creamos un vector de unos que servirá para comprobar la estimación del tamaño poblacional
UNO<-rep(1,dim(datos.no)[1])

# Creamos la matriz de diseño, uniendo las variables dummies creadas con las variables numéricas
X<- cbind(UNO,VNUM,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15)

# Calculamos el vector de probabilidades de inclusión
nB<-nrow(filter(datos,respuest=="Sí"))
nA<-nrow(datos.no)
pik<-rep(nB/nA,nA)

# Seleccionamos la muestra
set.seed(1234)
s<-samplecube(X,pik,order = 2,comment = FALSE,method = 2)
muestra.no<-cbind(datos.no,s)
muestra.no<-subset(datos.no,s==1)
muestra.no$s<-NULL

# Examinamos la calidad del muestreo realizado
Totales<-round(apply(X, 2, sum),0)
Horvitz.Thompson<-round(apply(X*s/pik,2,sum),0)
calidad<-cbind.data.frame(Totales, Horvitz.Thompson)
calidad$Desv.Abs.<-round(calidad$Totales - calidad$Horvitz.Thompson,2)
calidad$Desv.Rel.<-round((calidad$Totales / calidad$Horvitz.Thompson - 1)*100,2)

formattable(calidad)

	Totales	Horvitz.Thompson	Desv.Abs.	Desv.Rel.
UNO	5495	5495	0	0.00
edad	230670	230628	42	0.02
direcc	63670	63642	28	0.04
ingres	389957	390024	-67	-0.02
empleo	58506	58487	19	0.03
No completó el bachillerato	1138	1141	-3	-0.26
Bachillerato	1656	1659	-3	-0.18
Universitarios parciales	1174	1173	1	0.09
Universitarios	1204	1198	6	0.50
Post-universitarios	323	324	-1	-0.31
Hombre	2761	2760	1	0.04
Mujer	2734	2735	-1	-0.04
familia	1943	1950	-7	-0.36
pareja	1427	1432	-5	-0.35
soltero	2125	2112	13	0.62
noticias.si	2295	2298	-3	-0.13
noticias.no	3200	3197	3	0.09
Muy insatisfecho	960	963	-3	-0.31
Algo insatisfecho	1075	1068	7	0.66
Neutro	1195	1190	5	0.42
Algo satisfecho	1215	1222	-7	-0.57
Muy satisfecho	1050	1052	-2	-0.19
inalam.si	3276	3269	7	0.21
inalam.no	2219	2226	-7	-0.31
multline.si	3133	3124	9	0.29
multline.no	2362	2371	-9	-0.38
voz.si	3179	3172	7	0.22
voz.no	2316	2323	-7	-0.30
busca.si	4168	4168	0	0.00
busca.no	1327	1327	0	0.00
internet.si	3965	3965	0	0.00
internet.no	1530	1530	0	0.00
idllam.si	2727	2719	8	0.29
idllam.no	2768	2776	-8	-0.29
espera.si	2749	2743	6	0.22
espera.no	2746	2752	-6	-0.22
pda.si	4350	4346	4	0.09
pda.no	1145	1149	-4	-0.35
pc.si	3015	3019	-4	-0.13
pc.no	2480	2476	4	0.16
fax.si	4452	4443	9	0.20
fax.no	1043	1052	-9	-0.86

Como se puede apreciar en la tabla, las desviaciones relativas de las variables son muy reducidas, por lo que podemos concluir que la muestra obtenida es representativa.

datos.balanceados<-rbind(filter(datos,respuest=="Sí"),muestra.no)

# Necesitamos que la variable respuesta aparezca en la última columna. Cambiamos también su nombre por "y", para evitar problemas con caret 

datos_sinrespuest<-datos.balanceados %>% select(-respuest)
datos.balanceados<-cbind(datos_sinrespuest,datos.balanceados$respuest)
colnames(datos.balanceados)<-c(colnames(datos_sinrespuest),"y")

2 TAREA 2: ESTIMACIÓN DE MODELOS

Crearemos dos datasets: uno para aplicar los algoritmos bayesianos, donde todas las variables serán categóricas(método de igual frecuencia), y otro para aplicar los modelos XGBoost, donde todas las variables serán numéricas.

datos_bayes<-datos.balanceados %>% select(-c(ingres,empleo)) %>% mutate(edad=discretize(edad,breaks = 4),direcc=discretize(direcc,breaks = 4))

datos_xgboost<-datos.balanceados %>% select(-c(ingcat,empcat,y)) %>% select_if(is.factor) %>% conversion()
datos_xgboost<-cbind(datos_xgboost,datos.balanceados[c("edad","ingres","direcc","empleo","y")])

Creamos los sets de entrenamiento (80%) y test (20%), tanto para los modelos bayesianos como para los de XGBoost:

set.seed(107)

indices <- createDataPartition(datos_bayes$y, p = 0.80, list = FALSE)

train_bayes <- datos_bayes[ indices, ]
test_bayes <- datos_bayes[ -indices, ]

train_xgboost <- datos_xgboost[ indices, ]
test_xgboost <- datos_xgboost[ -indices, ]

Durante el entrenamiento se realizará una validación cruzada con 10 pliegues y 5 repeticiones:

fiveStats = function(...) c (twoClassSummary(...), defaultSummary(...))
control <- trainControl( method = "repeatedcv", 
                         number = 10,
                         repeats = 5,
                         classProbs = TRUE, 
                         summaryFunction = fiveStats,
                         returnResamp = "final",
                         allowParallel = TRUE )
metrica <- "ROC"

2.1 Modelos Bayesianos

Entrenaremos cuatro modelos bayesianos diferentes: Naive Bayes, TAN, TAN Hill Climbing y AODE. Estos dos últimos han sido incorporados mediante las funciones que aparecen en el anexo.
En principio entrenamos los modelos sin especificar ningún hiperparámetro:

# Naive Bayes
# ==============================================================================
fitted.nb <- train(train_bayes[-length(train_bayes)],
                   train_bayes$y,
                         method = "nbDiscrete",
                         metric = metrica,
                         trControl = control,
                    )
# TAN
# ==============================================================================
fitted.tan <- train(train_bayes[-length(train_bayes)],
                   train_bayes$y,
                         method = "tan",
                         metric = metrica,
                         trControl = control,
                    )
# TAN Hill Climbing 
# ==============================================================================
fitted.tanhc <- train(train_bayes,
                   train_bayes$y,
                         method = modeloTANHC,
                         metric = metrica,
                         trControl = control,
                    )
# AODE
# ==============================================================================
fitted.aode <- train(train_bayes,
                   train_bayes$y,
                         method = modeloAODE,
                         metric = metrica,
                         trControl = control,
                    )

Evaluamos los resultados para cada uno de los modelos:

resultados(fitted.nb)

## [1] "Mejores hiperparámetros:"
##   smooth
## 3      2

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
0	0.64	0.63	0.59	0.61	0.22	0.05	0.07	0.06	0.04	0.08
1	0.64	0.63	0.59	0.61	0.22	0.05	0.07	0.06	0.04	0.08
2	0.64	0.63	0.59	0.61	0.22	0.05	0.07	0.06	0.04	0.08

grafico_confusion(fitted.nb,train_bayes,test_bayes)

grafico_roc(fitted.nb,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6728

plot(varImp(fitted.nb))

resultados(fitted.tan)

## [1] "Mejores hiperparámetros:"
##   score smooth
## 6   bic      2

score	smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
loglik	0	0.60	0.58	0.58	0.58	0.16	0.05	0.07	0.08	0.05	0.10
loglik	1	0.61	0.58	0.58	0.58	0.16	0.05	0.06	0.08	0.05	0.10
loglik	2	0.61	0.58	0.58	0.58	0.16	0.05	0.06	0.08	0.05	0.10
bic	0	0.61	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
bic	1	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
bic	2	0.62	0.58	0.60	0.59	0.18	0.05	0.05	0.08	0.05	0.10
aic	0	0.61	0.57	0.59	0.58	0.16	0.05	0.06	0.08	0.05	0.10
aic	1	0.61	0.58	0.59	0.58	0.17	0.05	0.06	0.08	0.05	0.10
aic	2	0.62	0.58	0.59	0.59	0.17	0.05	0.06	0.08	0.05	0.09

grafico_confusion(fitted.tan,train_bayes,test_bayes)

grafico_roc(fitted.tan,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.7042

plot(varImp(fitted.tan))

resultados(fitted.tanhc)

## [1] "Mejores hiperparámetros:"
##   smooth
## 3      2

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
0	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.05	0.09
1	0.63	0.61	0.59	0.6	0.20	0.06	0.06	0.07	0.05	0.10
2	0.63	0.62	0.59	0.6	0.21	0.05	0.05	0.06	0.05	0.09

grafico_confusion(fitted.tanhc,train_bayes,test_bayes)

grafico_roc(fitted.tanhc,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6742

plot(varImp(fitted.tanhc))

resultados(fitted.aode)

## [1] "Mejores hiperparámetros:"
##   smooth
## 3      2

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
0	0.62	0.58	0.6	0.59	0.19	0.05	0.07	0.07	0.05	0.11
1	0.62	0.59	0.6	0.59	0.19	0.05	0.07	0.06	0.05	0.10
2	0.62	0.59	0.6	0.59	0.19	0.05	0.07	0.07	0.05	0.10

grafico_confusion(fitted.aode,train_bayes,test_bayes)

grafico_roc(fitted.aode,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.7252

plot(varImp(fitted.aode))

El AUC de test de los diferentes modelos está entre el 63 y el 64%. El mejor modelo a este respecto es el modelo AODE(64,6%).
Respecto a los mejores hiperparámetros, todos los modelos coinciden en señalar un valor de smooth de 2. El modelo TAN, además, escoge como mejor métrica de evaluación el BIC.
Respecto a la importancia de las variables, todos los modelos coinciden en la ordenación de las mismas, destacando como las más importantes el nivel educativo, si está o no suscrito a un periódico y los ingresos. Como menos importantes se encuentran la tenencia o no de pda,cd y tv, la satisfacción laboral y la edad.

Llama la atención que la variable edad no sea nada importante cuando en el análisis gráfico se veía como sí tenía cierto poder discriminante de forma univariante. Sin embargo, al estar bastante correlacionado con las variables empcat y direcc (que sí tienen cierta importancia en el modelo), hace que tras considerar estas últimas variables, la variable edad ya no sea importante para el modelo.

Volvemos a estimar los modelos estableciendo una rejilla de posibles valores de smooth (también las diferentes opciones del parámetro score del modelo TAN):

# Naive Bayes
# ==============================================================================
grid_nb<-expand.grid(smooth=seq(1,20,1))
  
fitted.nb2 <- train(train_bayes[-length(train_bayes)],
                   train_bayes$y,
                         method = "nbDiscrete",
                        tuneGrid = grid_nb,
                         metric = metrica,
                         trControl = control,
                    )
# TAN
# ==============================================================================
grid_tan<-expand.grid(score=c("aic","bic","loglik"),smooth=seq(1,20,1))

fitted.tan2 <- train(train_bayes[-length(train_bayes)],
                   train_bayes$y,
                         method = "tan",
                        tuneGrid = grid_tan,
                         metric = metrica,
                         trControl = control
                    )
# TAN Hill Climbing 
# ==============================================================================
grid_tanhc<-expand.grid(smooth=seq(1,20,1))

fitted.tanhc2 <- train(train_bayes,
                   train_bayes$y,
                         method = modeloTANHC,
                        tuneGrid = grid_tanhc,
                         metric = metrica,
                         trControl = control,
                    )
# AODE
# ==============================================================================
grid_aode<-expand.grid(smooth=seq(1,20,1))

fitted.aode2 <- train(train_bayes,
                   train_bayes$y,
                         method = modeloAODE,
                        tuneGrid = grid_tanhc,
                         metric = metrica,
                         trControl = control,
                    )

Evaluamos los modelos:

resultados(fitted.nb2)

## [1] "Mejores hiperparámetros:"
##    smooth
## 20     20

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.10
2	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.10
3	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.10
4	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.10
5	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.10
6	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.09
7	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.09
8	0.64	0.63	0.59	0.61	0.22	0.06	0.06	0.06	0.05	0.09
9	0.64	0.63	0.59	0.61	0.23	0.06	0.06	0.06	0.05	0.09
10	0.64	0.64	0.59	0.61	0.23	0.06	0.06	0.06	0.04	0.09
11	0.64	0.64	0.59	0.61	0.23	0.06	0.06	0.06	0.05	0.09
12	0.64	0.64	0.59	0.61	0.23	0.06	0.06	0.07	0.05	0.09
13	0.64	0.64	0.59	0.61	0.23	0.06	0.06	0.06	0.04	0.09
14	0.64	0.64	0.59	0.61	0.22	0.06	0.06	0.06	0.04	0.09
15	0.64	0.64	0.59	0.61	0.22	0.06	0.06	0.06	0.04	0.09
16	0.64	0.64	0.59	0.61	0.22	0.06	0.06	0.06	0.04	0.09
17	0.64	0.64	0.59	0.61	0.22	0.06	0.06	0.06	0.04	0.09
18	0.64	0.64	0.58	0.61	0.22	0.06	0.06	0.06	0.04	0.09
19	0.64	0.64	0.58	0.61	0.22	0.06	0.06	0.06	0.04	0.09
20	0.64	0.64	0.58	0.61	0.22	0.06	0.06	0.06	0.04	0.09

grafico_confusion(fitted.nb2,train_bayes,test_bayes)

grafico_roc(fitted.nb2,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6738

plot(varImp(fitted.nb2))

params(fitted.nb2$finalModel)

## $edad
##          .outcome
## edad             Sí        No
##   [18,32) 0.2371795 0.2323718
##   [32,41) 0.2596154 0.2516026
##   [41,52) 0.2371795 0.2820513
##   [52,76] 0.2660256 0.2339744
## 
## $direcc
##          .outcome
## direcc           Sí        No
##   [0,3)   0.2067308 0.2003205
##   [3,9)   0.2996795 0.2772436
##   [9,17)  0.2548077 0.2676282
##   [17,56] 0.2387821 0.2548077
## 
## $ingcat
##               .outcome
## ingcat                Sí        No
##   Menos de $25 0.2724359 0.1778846
##   $25 - $49    0.3846154 0.3814103
##   $50 - $74    0.1314103 0.1923077
##   $75+         0.2115385 0.2483974
## 
## $educ
##                              .outcome
## educ                                  Sí         No
##   No completó el bachillerato 0.29503106 0.21118012
##   Bachillerato                0.29347826 0.28571429
##   Universitarios parciales    0.18944099 0.20186335
##   Universitarios              0.15838509 0.22049689
##   Post-universitarios         0.06366460 0.08074534
## 
## $empcat
##             .outcome
## empcat              Sí        No
##   Menos de 5 0.3658940 0.3377483
##   5 a 15     0.3725166 0.3807947
##   Más de 15  0.2615894 0.2814570
## 
## $satlab
##                    .outcome
## satlab                     Sí        No
##   Muy insatisfecho  0.1739130 0.1894410
##   Algo insatisfecho 0.2127329 0.2018634
##   Neutro            0.2158385 0.2049689
##   Algo satisfecho   0.2096273 0.2173913
##   Muy satisfecho    0.1878882 0.1863354
## 
## $genero
##         .outcome
## genero          Sí        No
##   Hombre 0.5273973 0.5119863
##   Mujer  0.4726027 0.4880137
## 
## $residen
##          .outcome
## residen          Sí        No
##   familia 0.3824503 0.3526490
##   pareja  0.2516556 0.2649007
##   soltero 0.3658940 0.3824503
## 
## $inalam
##       .outcome
## inalam        Sí        No
##     Sí 0.6352740 0.6010274
##     No 0.3647260 0.3989726
## 
## $multline
##         .outcome
## multline        Sí        No
##       Sí 0.6575342 0.5650685
##       No 0.3424658 0.4349315
## 
## $voz
##     .outcome
## voz         Sí        No
##   Sí 0.4982877 0.5787671
##   No 0.5017123 0.4212329
## 
## $busca
##      .outcome
## busca        Sí        No
##    Sí 0.6729452 0.7465753
##    No 0.3270548 0.2534247
## 
## $internet
##         .outcome
## internet        Sí        No
##       Sí 0.7979452 0.7208904
##       No 0.2020548 0.2791096
## 
## $idllam
##       .outcome
## idllam        Sí        No
##     Sí 0.4452055 0.4948630
##     No 0.5547945 0.5051370
## 
## $espera
##       .outcome
## espera        Sí        No
##     Sí 0.4126712 0.5119863
##     No 0.5873288 0.4880137
## 
## $tv
##     .outcome
## tv           Sí         No
##   Sí 0.04965753 0.04623288
##   No 0.95034247 0.95376712
## 
## $video
##      .outcome
## video         Sí         No
##    Sí 0.08904110 0.07363014
##    No 0.91095890 0.92636986
## 
## $cd
##     .outcome
## cd           Sí         No
##   Sí 0.07191781 0.06506849
##   No 0.92808219 0.93493151
## 
## $pda
##     .outcome
## pda         Sí        No
##   Sí 0.7979452 0.7893836
##   No 0.2020548 0.2106164
## 
## $pc
##     .outcome
## pc          Sí        No
##   Sí 0.6558219 0.5428082
##   No 0.3441781 0.4571918
## 
## $fax
##     .outcome
## fax         Sí        No
##   Sí 0.8133562 0.7910959
##   No 0.1866438 0.2089041
## 
## $noticias
##         .outcome
## noticias        Sí        No
##       Sí 0.5530822 0.4126712
##       No 0.4469178 0.5873288
## 
## $.outcome
## .outcome
##  Sí  No 
## 0.5 0.5

families(fitted.nb2$finalModel)

## $edad
## [1] "edad"     ".outcome"
## 
## $direcc
## [1] "direcc"   ".outcome"
## 
## $ingcat
## [1] "ingcat"   ".outcome"
## 
## $educ
## [1] "educ"     ".outcome"
## 
## $empcat
## [1] "empcat"   ".outcome"
## 
## $satlab
## [1] "satlab"   ".outcome"
## 
## $genero
## [1] "genero"   ".outcome"
## 
## $residen
## [1] "residen"  ".outcome"
## 
## $inalam
## [1] "inalam"   ".outcome"
## 
## $multline
## [1] "multline" ".outcome"
## 
## $voz
## [1] "voz"      ".outcome"
## 
## $busca
## [1] "busca"    ".outcome"
## 
## $internet
## [1] "internet" ".outcome"
## 
## $idllam
## [1] "idllam"   ".outcome"
## 
## $espera
## [1] "espera"   ".outcome"
## 
## $tv
## [1] "tv"       ".outcome"
## 
## $video
## [1] "video"    ".outcome"
## 
## $cd
## [1] "cd"       ".outcome"
## 
## $pda
## [1] "pda"      ".outcome"
## 
## $pc
## [1] "pc"       ".outcome"
## 
## $fax
## [1] "fax"      ".outcome"
## 
## $noticias
## [1] "noticias" ".outcome"
## 
## $.outcome
## [1] ".outcome"

resultados(fitted.tan2)

## [1] "Mejores hiperparámetros:"
##    score smooth
## 40   bic     20

score	smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
aic	1	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	2	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	3	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	4	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	5	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.09
aic	6	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	7	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	8	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	9	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	10	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	11	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	12	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	13	0.62	0.59	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	14	0.62	0.59	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	15	0.62	0.59	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	16	0.62	0.59	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
aic	17	0.62	0.59	0.59	0.59	0.18	0.05	0.07	0.07	0.05	0.09
aic	18	0.62	0.59	0.59	0.59	0.18	0.05	0.07	0.07	0.05	0.09
aic	19	0.62	0.59	0.59	0.59	0.18	0.05	0.07	0.07	0.05	0.09
aic	20	0.62	0.59	0.59	0.59	0.18	0.05	0.07	0.07	0.05	0.09
bic	1	0.62	0.57	0.60	0.58	0.17	0.05	0.07	0.06	0.04	0.09
bic	2	0.62	0.57	0.60	0.58	0.17	0.05	0.07	0.07	0.04	0.09
bic	3	0.62	0.57	0.59	0.58	0.17	0.05	0.07	0.07	0.04	0.09
bic	4	0.62	0.57	0.59	0.58	0.17	0.05	0.07	0.07	0.04	0.09
bic	5	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	6	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	7	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	8	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	9	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	10	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	11	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	12	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	13	0.62	0.58	0.59	0.58	0.17	0.05	0.07	0.07	0.04	0.08
bic	14	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	15	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	16	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.08
bic	17	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	18	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	19	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.04	0.09
bic	20	0.62	0.58	0.59	0.59	0.17	0.05	0.07	0.07	0.05	0.09
loglik	1	0.61	0.59	0.58	0.58	0.16	0.05	0.07	0.06	0.05	0.09
loglik	2	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.05	0.09
loglik	3	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.05	0.09
loglik	4	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.05	0.09
loglik	5	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	6	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.05	0.09
loglik	7	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	8	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.07	0.05	0.09
loglik	9	0.61	0.59	0.58	0.58	0.17	0.05	0.06	0.07	0.05	0.09
loglik	10	0.61	0.59	0.57	0.58	0.16	0.05	0.07	0.07	0.05	0.09
loglik	11	0.61	0.59	0.57	0.58	0.16	0.05	0.06	0.06	0.05	0.09
loglik	12	0.61	0.59	0.58	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	13	0.62	0.60	0.57	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	14	0.62	0.59	0.57	0.58	0.17	0.05	0.07	0.06	0.05	0.09
loglik	15	0.62	0.59	0.57	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	16	0.62	0.59	0.57	0.58	0.17	0.05	0.07	0.06	0.04	0.09
loglik	17	0.62	0.59	0.57	0.58	0.17	0.05	0.07	0.07	0.04	0.09
loglik	18	0.62	0.60	0.57	0.58	0.17	0.05	0.06	0.07	0.04	0.09
loglik	19	0.62	0.60	0.57	0.58	0.17	0.05	0.07	0.07	0.04	0.09
loglik	20	0.62	0.60	0.57	0.58	0.17	0.05	0.07	0.07	0.04	0.09

grafico_confusion(fitted.tan2,train_bayes,test_bayes)

grafico_roc(fitted.tan2,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.7006

plot(varImp(fitted.tan2))

params(fitted.tan2$finalModel)

## $edad
##          .outcome
## edad             Sí        No
##   [18,32) 0.2371795 0.2323718
##   [32,41) 0.2596154 0.2516026
##   [41,52) 0.2371795 0.2820513
##   [52,76] 0.2660256 0.2339744
## 
## $direcc
## , , .outcome = Sí
## 
##          edad
## direcc       [18,32)    [32,41)    [41,52)    [52,76]
##   [0,3)   0.36057692 0.20270270 0.16346154 0.15486726
##   [3,9)   0.37019231 0.32432432 0.25961538 0.19469027
##   [9,17)  0.17307692 0.33333333 0.28846154 0.21681416
##   [17,56] 0.09615385 0.13963964 0.28846154 0.43362832
## 
## , , .outcome = No
## 
##          edad
## direcc       [18,32)    [32,41)    [41,52)    [52,76]
##   [0,3)   0.36097561 0.20737327 0.15677966 0.14077670
##   [3,9)   0.36585366 0.29032258 0.25000000 0.17475728
##   [9,17)  0.17560976 0.37327189 0.27542373 0.21844660
##   [17,56] 0.09756098 0.12903226 0.31779661 0.46601942
## 
## 
## $ingcat
## , , .outcome = Sí
## 
##               empcat
## ingcat         Menos de 5     5 a 15  Más de 15
##   Menos de $25 0.39501779 0.22456140 0.16055046
##   $25 - $49    0.40569395 0.43508772 0.19266055
##   $50 - $74    0.10320285 0.18596491 0.18348624
##   $75+         0.09608541 0.15438596 0.46330275
## 
## , , .outcome = No
## 
##               empcat
## ingcat         Menos de 5     5 a 15  Más de 15
##   Menos de $25 0.29545455 0.14827586 0.13043478
##   $25 - $49    0.43181818 0.43448276 0.16521739
##   $50 - $74    0.15909091 0.23793103 0.21304348
##   $75+         0.11363636 0.17931034 0.49130435
## 
## 
## $educ
## , , .outcome = Sí
## 
##                              pc
## educ                                  Sí         No
##   No completó el bachillerato 0.36069114 0.15302491
##   Bachillerato                0.30453564 0.24199288
##   Universitarios parciales    0.17062635 0.22419929
##   Universitarios              0.11015119 0.25266904
##   Post-universitarios         0.05399568 0.12811388
## 
## , , .outcome = No
## 
##                              pc
## educ                                  Sí         No
##   No completó el bachillerato 0.29471033 0.11239193
##   Bachillerato                0.30478589 0.23919308
##   Universitarios parciales    0.17884131 0.22766571
##   Universitarios              0.15617128 0.28818444
##   Post-universitarios         0.06549118 0.13256484
## 
## 
## $empcat
## , , .outcome = Sí
## 
##             edad
## empcat         [18,32)   [32,41)   [41,52)   [52,76]
##   Menos de 5 0.5851064 0.3564356 0.3351064 0.1747573
##   5 a 15     0.3085106 0.4455446 0.3563830 0.3398058
##   Más de 15  0.1063830 0.1980198 0.3085106 0.4854369
## 
## , , .outcome = No
## 
##             edad
## empcat         [18,32)   [32,41)   [41,52)   [52,76]
##   Menos de 5 0.6324324 0.3299492 0.2314815 0.1720430
##   5 a 15     0.2594595 0.5279188 0.3842593 0.2956989
##   Más de 15  0.1081081 0.1421320 0.3842593 0.5322581
## 
## 
## $satlab
## , , .outcome = Sí
## 
##                    empcat
## satlab              Menos de 5     5 a 15  Más de 15
##   Muy insatisfecho  0.29235880 0.12131148 0.11344538
##   Algo insatisfecho 0.26578073 0.21311475 0.13445378
##   Neutro            0.21926910 0.24918033 0.15546218
##   Algo satisfecho   0.12956811 0.22295082 0.28571429
##   Muy satisfecho    0.09302326 0.19344262 0.31092437
## 
## , , .outcome = No
## 
##                    empcat
## satlab              Menos de 5     5 a 15  Más de 15
##   Muy insatisfecho  0.33098592 0.13870968 0.10000000
##   Algo insatisfecho 0.23591549 0.19677419 0.16800000
##   Neutro            0.18309859 0.21290323 0.21600000
##   Algo satisfecho   0.15140845 0.25161290 0.23600000
##   Muy satisfecho    0.09859155 0.20000000 0.28000000
## 
## 
## $residen
## , , .outcome = Sí
## 
##          edad
## residen     [18,32)   [32,41)   [41,52)   [52,76]
##   familia 0.5159574 0.4207921 0.3404255 0.2184466
##   pareja  0.2021277 0.2277228 0.2765957 0.3689320
##   soltero 0.2819149 0.3514851 0.3829787 0.4126214
## 
## , , .outcome = No
## 
##          edad
## residen     [18,32)   [32,41)   [41,52)   [52,76]
##   familia 0.4540541 0.4060914 0.3287037 0.2043011
##   pareja  0.2162162 0.2538071 0.2962963 0.3548387
##   soltero 0.3297297 0.3401015 0.3750000 0.4408602
## 
## 
## $inalam
## , , .outcome = Sí
## 
##       multline
## inalam        Sí        No
##     Sí 0.7004950 0.4909091
##     No 0.2995050 0.5090909
## 
## , , .outcome = No
## 
##       multline
## inalam        Sí        No
##     Sí 0.7114286 0.4452555
##     No 0.2885714 0.5547445
## 
## 
## $multline
## , , .outcome = Sí
## 
##         noticias
## multline        Sí        No
##       Sí 0.5655977 0.7473310
##       No 0.4344023 0.2526690
## 
## , , .outcome = No
## 
##         noticias
## multline        Sí        No
##       Sí 0.4291188 0.6556474
##       No 0.5708812 0.3443526
## 
## 
## $voz
## , , .outcome = Sí
## 
##     busca
## voz         Sí        No
##   Sí 0.5641646 0.3696682
##   No 0.4358354 0.6303318
## 
## , , .outcome = No
## 
##     busca
## voz         Sí        No
##   Sí 0.6359649 0.4047619
##   No 0.3640351 0.5952381
## 
## 
## $busca
## , , .outcome = Sí
## 
##      idllam
## busca        Sí        No
##    Sí 0.7535714 0.5872093
##    No 0.2464286 0.4127907
## 
## , , .outcome = No
## 
##      idllam
## busca        Sí        No
##    Sí 0.8155340 0.6476190
##    No 0.1844660 0.3523810
## 
## 
## $internet
## , , .outcome = Sí
## 
##         pc
## internet        Sí        No
##       Sí 0.8908189 0.5746606
##       No 0.1091811 0.4253394
## 
## , , .outcome = No
## 
##         pc
## internet        Sí        No
##       Sí 0.8189911 0.5749129
##       No 0.1810089 0.4250871
## 
## 
## $idllam
## , , .outcome = Sí
## 
##       espera
## idllam        Sí        No
##     Sí 0.6321839 0.3168044
##     No 0.3678161 0.6831956
## 
## , , .outcome = No
## 
##       espera
## idllam        Sí        No
##     Sí 0.6426332 0.3409836
##     No 0.3573668 0.6590164
## 
## 
## $espera
## , , .outcome = Sí
## 
##       inalam
## espera        Sí        No
##     Sí 0.5191816 0.2489270
##     No 0.4808184 0.7510730
## 
## , , .outcome = No
## 
##       inalam
## espera        Sí        No
##     Sí 0.6064690 0.3715415
##     No 0.3935310 0.6284585
## 
## 
## $tv
## , , .outcome = Sí
## 
##     video
## tv           Sí         No
##   Sí 0.37500000 0.03985507
##   No 0.62500000 0.96014493
## 
## , , .outcome = No
## 
##     video
## tv           Sí         No
##   Sí 0.39682540 0.03921569
##   No 0.60317460 0.96078431
## 
## 
## $video
## , , .outcome = Sí
## 
##      ingcat
## video Menos de $25 $25 - $49 $50 - $74      $75+
##    Sí    0.2315789 0.1076923 0.1960784 0.1315789
##    No    0.7684211 0.8923077 0.8039216 0.8684211
## 
## , , .outcome = No
## 
##      ingcat
## video Menos de $25 $25 - $49 $50 - $74      $75+
##    Sí    0.2748092 0.1046512 0.1428571 0.1142857
##    No    0.7251908 0.8953488 0.8571429 0.8857143
## 
## 
## $cd
## , , .outcome = Sí
## 
##     video
## cd           Sí         No
##   Sí 0.48611111 0.04891304
##   No 0.51388889 0.95108696
## 
## , , .outcome = No
## 
##     video
## cd           Sí         No
##   Sí 0.46031746 0.05169340
##   No 0.53968254 0.94830660
## 
## 
## $pda
## , , .outcome = Sí
## 
##     inalam
## pda         Sí        No
##   Sí 0.8797954 0.6094421
##   No 0.1202046 0.3905579
## 
## , , .outcome = No
## 
##     inalam
## pda         Sí        No
##   Sí 0.8814016 0.6086957
##   No 0.1185984 0.3913043
## 
## 
## $pc
## , , .outcome = Sí
## 
##     inalam
## pc          Sí        No
##   Sí 0.7340153 0.4978541
##   No 0.2659847 0.5021459
## 
## , , .outcome = No
## 
##     inalam
## pc          Sí        No
##   Sí 0.6549865 0.3715415
##   No 0.3450135 0.6284585
## 
## 
## $fax
## , , .outcome = Sí
## 
##     inalam
## fax         Sí        No
##   Sí 0.8976982 0.6180258
##   No 0.1023018 0.3819742
## 
## , , .outcome = No
## 
##     inalam
## fax         Sí        No
##   Sí 0.8948787 0.5928854
##   No 0.1051213 0.4071146
## 
## 
## $noticias
## , , .outcome = Sí
## 
##         empcat
## noticias Menos de 5    5 a 15 Más de 15
##       Sí  0.5062241 0.4775510 0.6966292
##       No  0.4937759 0.5224490 0.3033708
## 
## , , .outcome = No
## 
##         empcat
## noticias Menos de 5    5 a 15 Más de 15
##       Sí  0.3437500 0.3640000 0.5947368
##       No  0.6562500 0.6360000 0.4052632
## 
## 
## $genero
##         .outcome
## genero          Sí        No
##   Hombre 0.5273973 0.5119863
##   Mujer  0.4726027 0.4880137
## 
## $.outcome
## .outcome
##  Sí  No 
## 0.5 0.5

families(fitted.tan2$finalModel)

## $edad
## [1] "edad"     ".outcome"
## 
## $direcc
## [1] "direcc"   "edad"     ".outcome"
## 
## $ingcat
## [1] "ingcat"   "empcat"   ".outcome"
## 
## $educ
## [1] "educ"     "pc"       ".outcome"
## 
## $empcat
## [1] "empcat"   "edad"     ".outcome"
## 
## $satlab
## [1] "satlab"   "empcat"   ".outcome"
## 
## $residen
## [1] "residen"  "edad"     ".outcome"
## 
## $inalam
## [1] "inalam"   "multline" ".outcome"
## 
## $multline
## [1] "multline" "noticias" ".outcome"
## 
## $voz
## [1] "voz"      "busca"    ".outcome"
## 
## $busca
## [1] "busca"    "idllam"   ".outcome"
## 
## $internet
## [1] "internet" "pc"       ".outcome"
## 
## $idllam
## [1] "idllam"   "espera"   ".outcome"
## 
## $espera
## [1] "espera"   "inalam"   ".outcome"
## 
## $tv
## [1] "tv"       "video"    ".outcome"
## 
## $video
## [1] "video"    "ingcat"   ".outcome"
## 
## $cd
## [1] "cd"       "video"    ".outcome"
## 
## $pda
## [1] "pda"      "inalam"   ".outcome"
## 
## $pc
## [1] "pc"       "inalam"   ".outcome"
## 
## $fax
## [1] "fax"      "inalam"   ".outcome"
## 
## $noticias
## [1] "noticias" "empcat"   ".outcome"
## 
## $genero
## [1] "genero"   ".outcome"
## 
## $.outcome
## [1] ".outcome"

resultados(fitted.tanhc2)

## [1] "Mejores hiperparámetros:"
##    smooth
## 18     18

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.63	0.62	0.58	0.60	0.21	0.06	0.07	0.07	0.05	0.09
2	0.63	0.62	0.59	0.60	0.21	0.06	0.07	0.07	0.05	0.10
3	0.64	0.62	0.58	0.60	0.21	0.06	0.07	0.06	0.05	0.10
4	0.64	0.62	0.59	0.60	0.21	0.06	0.07	0.08	0.05	0.10
5	0.64	0.63	0.58	0.61	0.21	0.06	0.07	0.07	0.05	0.10
6	0.63	0.62	0.59	0.60	0.21	0.06	0.07	0.07	0.05	0.10
7	0.64	0.63	0.59	0.61	0.21	0.06	0.07	0.07	0.05	0.10
8	0.63	0.63	0.58	0.60	0.21	0.06	0.07	0.06	0.05	0.10
9	0.64	0.63	0.59	0.61	0.21	0.06	0.07	0.07	0.05	0.10
10	0.64	0.62	0.58	0.60	0.20	0.07	0.07	0.07	0.05	0.11
11	0.64	0.63	0.58	0.60	0.21	0.06	0.07	0.07	0.05	0.09
12	0.64	0.63	0.58	0.60	0.21	0.06	0.08	0.06	0.05	0.10
13	0.64	0.63	0.58	0.60	0.21	0.06	0.08	0.07	0.05	0.10
14	0.64	0.63	0.58	0.61	0.21	0.06	0.07	0.07	0.05	0.10
15	0.64	0.63	0.58	0.61	0.22	0.06	0.07	0.06	0.05	0.10
16	0.64	0.63	0.58	0.61	0.21	0.06	0.08	0.07	0.05	0.10
17	0.64	0.63	0.58	0.60	0.21	0.07	0.07	0.06	0.05	0.10
18	0.64	0.63	0.58	0.61	0.21	0.06	0.07	0.07	0.05	0.09
19	0.64	0.63	0.58	0.61	0.21	0.06	0.07	0.07	0.04	0.09
20	0.64	0.64	0.58	0.61	0.22	0.06	0.07	0.08	0.05	0.10

grafico_confusion(fitted.tanhc2,train_bayes,test_bayes)

grafico_roc(fitted.tanhc2,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6738

plot(varImp(fitted.tanhc2))

params(fitted.tanhc2$finalModel)

## $edad
##          y
## edad             Sí        No
##   [18,32) 0.2370130 0.2321429
##   [32,41) 0.2597403 0.2516234
##   [41,52) 0.2370130 0.2824675
##   [52,76] 0.2662338 0.2337662
## 
## $direcc
##          y
## direcc           Sí        No
##   [0,3)   0.2061688 0.1996753
##   [3,9)   0.3003247 0.2775974
##   [9,17)  0.2548701 0.2678571
##   [17,56] 0.2386364 0.2548701
## 
## $ingcat
##               y
## ingcat                Sí        No
##   Menos de $25 0.2727273 0.1769481
##   $25 - $49    0.3863636 0.3831169
##   $50 - $74    0.1298701 0.1915584
##   $75+         0.2110390 0.2483766
## 
## $educ
##                              y
## educ                                  Sí         No
##   No completó el bachillerato 0.29652997 0.21135647
##   Bachillerato                0.29495268 0.28706625
##   Universitarios parciales    0.18927445 0.20189274
##   Universitarios              0.15772871 0.22082019
##   Post-universitarios         0.06151420 0.07886435
## 
## $empcat
##             y
## empcat              Sí        No
##   Menos de 5 0.3662207 0.3377926
##   5 a 15     0.3729097 0.3812709
##   Más de 15  0.2608696 0.2809365
## 
## $satlab
##                    y
## satlab                     Sí        No
##   Muy insatisfecho  0.1735016 0.1892744
##   Algo insatisfecho 0.2129338 0.2018927
##   Neutro            0.2160883 0.2050473
##   Algo satisfecho   0.2097792 0.2176656
##   Muy satisfecho    0.1876972 0.1861199
## 
## $genero
##         y
## genero          Sí        No
##   Hombre 0.5275862 0.5120690
##   Mujer  0.4724138 0.4879310
## 
## $residen
##          y
## residen          Sí        No
##   familia 0.3829431 0.3528428
##   pareja  0.2508361 0.2642140
##   soltero 0.3662207 0.3829431
## 
## $inalam
##       y
## inalam        Sí        No
##     Sí 0.6362069 0.6017241
##     No 0.3637931 0.3982759
## 
## $multline
##         y
## multline        Sí        No
##       Sí 0.6586207 0.5655172
##       No 0.3413793 0.4344828
## 
## $voz
##     y
## voz         Sí        No
##   Sí 0.4982759 0.5793103
##   No 0.5017241 0.4206897
## 
## $busca
##      y
## busca        Sí        No
##    Sí 0.6741379 0.7482759
##    No 0.3258621 0.2517241
## 
## $internet
##         y
## internet        Sí        No
##       Sí 0.8000000 0.7224138
##       No 0.2000000 0.2775862
## 
## $idllam
##       y
## idllam        Sí        No
##     Sí 0.4448276 0.4948276
##     No 0.5551724 0.5051724
## 
## $espera
##       y
## espera       Sí       No
##     Sí 0.412069 0.512069
##     No 0.587931 0.487931
## 
## $tv
##     y
## tv           Sí         No
##   Sí 0.04655172 0.04310345
##   No 0.95344828 0.95689655
## 
## $video
##      y
## video         Sí         No
##    Sí 0.08620690 0.07068966
##    No 0.91379310 0.92931034
## 
## $cd
##     y
## cd           Sí         No
##   Sí 0.06896552 0.06206897
##   No 0.93103448 0.93793103
## 
## $pda
##     y
## pda         Sí        No
##   Sí 0.8000000 0.7913793
##   No 0.2000000 0.2086207
## 
## $pc
##     y
## pc          Sí        No
##   Sí 0.6568966 0.5431034
##   No 0.3431034 0.4568966
## 
## $fax
##     y
## fax         Sí        No
##   Sí 0.8155172 0.7931034
##   No 0.1844828 0.2068966
## 
## $noticias
##         y
## noticias        Sí        No
##       Sí 0.5534483 0.4120690
##       No 0.4465517 0.5879310
## 
## $y
## y
##  Sí  No 
## 0.5 0.5

families(fitted.tanhc2$finalModel)

## $edad
## [1] "edad" "y"   
## 
## $direcc
## [1] "direcc" "y"     
## 
## $ingcat
## [1] "ingcat" "y"     
## 
## $educ
## [1] "educ" "y"   
## 
## $empcat
## [1] "empcat" "y"     
## 
## $satlab
## [1] "satlab" "y"     
## 
## $genero
## [1] "genero" "y"     
## 
## $residen
## [1] "residen" "y"      
## 
## $inalam
## [1] "inalam" "y"     
## 
## $multline
## [1] "multline" "y"       
## 
## $voz
## [1] "voz" "y"  
## 
## $busca
## [1] "busca" "y"    
## 
## $internet
## [1] "internet" "y"       
## 
## $idllam
## [1] "idllam" "y"     
## 
## $espera
## [1] "espera" "y"     
## 
## $tv
## [1] "tv" "y" 
## 
## $video
## [1] "video" "y"    
## 
## $cd
## [1] "cd" "y" 
## 
## $pda
## [1] "pda" "y"  
## 
## $pc
## [1] "pc" "y" 
## 
## $fax
## [1] "fax" "y"  
## 
## $noticias
## [1] "noticias" "y"       
## 
## $y
## [1] "y"

resultados(fitted.aode2)

## [1] "Mejores hiperparámetros:"
##    smooth
## 20     20

smooth	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.63	0.59	0.62	0.6	0.21	0.05	0.06	0.06	0.04	0.09
2	0.63	0.59	0.61	0.6	0.20	0.05	0.06	0.06	0.05	0.09
3	0.63	0.59	0.61	0.6	0.20	0.05	0.07	0.06	0.05	0.09
4	0.63	0.59	0.61	0.6	0.20	0.05	0.07	0.06	0.04	0.09
5	0.63	0.59	0.61	0.6	0.20	0.05	0.07	0.06	0.04	0.09
6	0.63	0.60	0.60	0.6	0.20	0.05	0.07	0.06	0.04	0.09
7	0.63	0.60	0.60	0.6	0.20	0.05	0.06	0.06	0.04	0.09
8	0.63	0.60	0.60	0.6	0.19	0.05	0.06	0.06	0.04	0.09
9	0.63	0.60	0.60	0.6	0.20	0.05	0.07	0.06	0.04	0.08
10	0.63	0.60	0.60	0.6	0.20	0.05	0.06	0.06	0.04	0.08
11	0.63	0.60	0.60	0.6	0.20	0.05	0.06	0.06	0.04	0.08
12	0.63	0.60	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.09
13	0.63	0.60	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.09
14	0.63	0.60	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.08
15	0.63	0.61	0.59	0.6	0.20	0.05	0.07	0.06	0.04	0.08
16	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.08
17	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.09
18	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.09
19	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.05	0.09
20	0.63	0.61	0.59	0.6	0.20	0.05	0.06	0.06	0.04	0.09

grafico_confusion(fitted.aode2,train_bayes,test_bayes)

grafico_roc(fitted.aode2,train_bayes,test_bayes)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.7098

plot(varImp(fitted.aode2))

Los resultados apenas varían manteniendo nuevamente niveles de AUC de test de entre 63 y 65%, siendo nuevamente el mejor modelo el AODE(64,8%).
El mejor valor del hiperparámetro smooth es 20 en todos los modelos (excepto en el TAN que es 18).
La importancia de las variables no ha variado.

En este caso además hemos imprimido las probabilidades condicionadas a los padres de cada una de las variables, así como su estructura, para los modelos NB, TAN y TANHC. Se puede observar en la estructura de los mismos que, por ejemplo, en el modelo NB las variables tienen un único padre (que es la propia variable respuesta) y en el modelo TAN algunas variables tienen como padre, además de la variable respuesta, otra variable.

2.2 Modelo XgBoost

Estimaremos diferentes modelos de XGBoost variando secuencialmente sus hiperparámetros.Para el entrenamiento de estos modelos se incorpora tambien el argumento que realiza un centrado y escalado de las variables.
En primer lugar, entrenamos un modelo base sin especificar ningún hiperparámetro:

modelo_xgboost <- train( x = train_xgboost[-length(train_xgboost)],
                       y = train_xgboost$y,
                       method = "xgbTree",
                       trControl = control,
                      preProc=c("center","scale"),
                       verbose = TRUE )

resultados(modelo_xgboost)

## [1] "Mejores hiperparámetros:"
##   nrounds max_depth eta gamma colsample_bytree min_child_weight subsample
## 4      50         1 0.3     0              0.6                1      0.75

	eta	max_depth	colsample_bytree	min_child_weight	subsample	nrounds	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.3	1	0.6	1	0.50	50	0.62	0.57	0.60	0.59	0.17	0.06	0.07	0.06	0.04	0.08
4	0.3	1	0.6	1	0.75	50	0.63	0.58	0.61	0.60	0.19	0.05	0.07	0.06	0.04	0.09
7	0.3	1	0.6	1	1.00	50	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.05	0.09
10	0.3	1	0.8	1	0.50	50	0.63	0.59	0.59	0.59	0.18	0.05	0.07	0.06	0.05	0.09
13	0.3	1	0.8	1	0.75	50	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.05	0.04	0.08
16	0.3	1	0.8	1	1.00	50	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.05	0.04	0.09
55	0.4	1	0.6	1	0.50	50	0.62	0.56	0.60	0.58	0.17	0.05	0.08	0.06	0.05	0.10
58	0.4	1	0.6	1	0.75	50	0.62	0.57	0.60	0.58	0.16	0.05	0.07	0.06	0.05	0.09
61	0.4	1	0.6	1	1.00	50	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.05	0.04	0.09
64	0.4	1	0.8	1	0.50	50	0.62	0.57	0.59	0.58	0.16	0.06	0.09	0.05	0.05	0.11
67	0.4	1	0.8	1	0.75	50	0.62	0.57	0.60	0.58	0.16	0.05	0.07	0.05	0.04	0.08
70	0.4	1	0.8	1	1.00	50	0.63	0.57	0.60	0.59	0.18	0.05	0.07	0.05	0.04	0.09
19	0.3	2	0.6	1	0.50	50	0.60	0.55	0.59	0.57	0.15	0.06	0.07	0.07	0.05	0.10
22	0.3	2	0.6	1	0.75	50	0.60	0.56	0.58	0.57	0.14	0.06	0.07	0.06	0.05	0.11
25	0.3	2	0.6	1	1.00	50	0.60	0.56	0.58	0.57	0.14	0.06	0.07	0.06	0.05	0.10
28	0.3	2	0.8	1	0.50	50	0.60	0.54	0.58	0.56	0.12	0.05	0.07	0.07	0.05	0.10
31	0.3	2	0.8	1	0.75	50	0.60	0.56	0.58	0.57	0.14	0.06	0.08	0.06	0.05	0.10
34	0.3	2	0.8	1	1.00	50	0.59	0.55	0.58	0.57	0.13	0.06	0.07	0.06	0.05	0.10
73	0.4	2	0.6	1	0.50	50	0.59	0.56	0.57	0.56	0.12	0.06	0.07	0.07	0.05	0.10
76	0.4	2	0.6	1	0.75	50	0.59	0.55	0.58	0.56	0.12	0.05	0.07	0.07	0.05	0.09
79	0.4	2	0.6	1	1.00	50	0.59	0.54	0.59	0.57	0.13	0.06	0.06	0.07	0.04	0.09
82	0.4	2	0.8	1	0.50	50	0.59	0.55	0.57	0.56	0.12	0.06	0.07	0.07	0.05	0.10
85	0.4	2	0.8	1	0.75	50	0.59	0.56	0.57	0.56	0.12	0.06	0.07	0.07	0.05	0.09
88	0.4	2	0.8	1	1.00	50	0.59	0.55	0.58	0.56	0.12	0.06	0.07	0.06	0.04	0.09
37	0.3	3	0.6	1	0.50	50	0.58	0.54	0.58	0.56	0.12	0.06	0.06	0.06	0.04	0.09
40	0.3	3	0.6	1	0.75	50	0.59	0.55	0.57	0.56	0.12	0.05	0.06	0.07	0.05	0.09
43	0.3	3	0.6	1	1.00	50	0.58	0.55	0.58	0.56	0.12	0.06	0.07	0.06	0.05	0.09
46	0.3	3	0.8	1	0.50	50	0.59	0.57	0.56	0.57	0.13	0.06	0.07	0.06	0.05	0.09
49	0.3	3	0.8	1	0.75	50	0.58	0.56	0.56	0.56	0.12	0.05	0.07	0.07	0.04	0.09
52	0.3	3	0.8	1	1.00	50	0.58	0.55	0.57	0.56	0.12	0.05	0.07	0.07	0.05	0.10
91	0.4	3	0.6	1	0.50	50	0.58	0.55	0.57	0.56	0.12	0.05	0.08	0.06	0.05	0.10
94	0.4	3	0.6	1	0.75	50	0.58	0.55	0.56	0.56	0.12	0.06	0.08	0.06	0.05	0.11
97	0.4	3	0.6	1	1.00	50	0.57	0.55	0.56	0.55	0.10	0.06	0.07	0.06	0.05	0.10
100	0.4	3	0.8	1	0.50	50	0.58	0.56	0.56	0.56	0.12	0.06	0.07	0.07	0.04	0.09
103	0.4	3	0.8	1	0.75	50	0.58	0.56	0.56	0.56	0.12	0.06	0.07	0.08	0.06	0.12
106	0.4	3	0.8	1	1.00	50	0.58	0.55	0.56	0.55	0.11	0.06	0.08	0.06	0.05	0.10
2	0.3	1	0.6	1	0.50	100	0.61	0.56	0.59	0.58	0.15	0.05	0.07	0.05	0.05	0.09
5	0.3	1	0.6	1	0.75	100	0.62	0.58	0.59	0.59	0.17	0.06	0.08	0.05	0.05	0.10
8	0.3	1	0.6	1	1.00	100	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.05	0.05	0.10
11	0.3	1	0.8	1	0.50	100	0.62	0.57	0.59	0.58	0.17	0.05	0.08	0.06	0.05	0.09
14	0.3	1	0.8	1	0.75	100	0.62	0.57	0.59	0.58	0.17	0.05	0.07	0.07	0.05	0.10
17	0.3	1	0.8	1	1.00	100	0.62	0.57	0.60	0.59	0.17	0.05	0.07	0.05	0.05	0.10
56	0.4	1	0.6	1	0.50	100	0.61	0.56	0.59	0.58	0.15	0.05	0.07	0.06	0.04	0.09
59	0.4	1	0.6	1	0.75	100	0.61	0.57	0.59	0.58	0.15	0.06	0.07	0.05	0.04	0.09
62	0.4	1	0.6	1	1.00	100	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.10
65	0.4	1	0.8	1	0.50	100	0.61	0.56	0.58	0.57	0.14	0.06	0.08	0.06	0.05	0.11
68	0.4	1	0.8	1	0.75	100	0.61	0.58	0.60	0.59	0.17	0.06	0.06	0.06	0.05	0.09
71	0.4	1	0.8	1	1.00	100	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.05	0.05	0.10
20	0.3	2	0.6	1	0.50	100	0.59	0.57	0.58	0.57	0.14	0.06	0.08	0.07	0.05	0.11
23	0.3	2	0.6	1	0.75	100	0.59	0.56	0.58	0.57	0.13	0.05	0.07	0.06	0.04	0.09
26	0.3	2	0.6	1	1.00	100	0.58	0.55	0.57	0.56	0.12	0.06	0.07	0.06	0.05	0.10
29	0.3	2	0.8	1	0.50	100	0.58	0.55	0.57	0.56	0.12	0.05	0.06	0.06	0.04	0.08
32	0.3	2	0.8	1	0.75	100	0.58	0.55	0.57	0.56	0.12	0.06	0.07	0.06	0.05	0.09
35	0.3	2	0.8	1	1.00	100	0.58	0.55	0.57	0.56	0.12	0.06	0.06	0.06	0.04	0.09
74	0.4	2	0.6	1	0.50	100	0.57	0.56	0.56	0.56	0.12	0.06	0.07	0.06	0.04	0.09
77	0.4	2	0.6	1	0.75	100	0.58	0.56	0.57	0.56	0.13	0.05	0.07	0.06	0.05	0.09
80	0.4	2	0.6	1	1.00	100	0.57	0.54	0.57	0.55	0.11	0.06	0.06	0.07	0.05	0.10
83	0.4	2	0.8	1	0.50	100	0.57	0.55	0.55	0.55	0.11	0.06	0.07	0.07	0.05	0.10
86	0.4	2	0.8	1	0.75	100	0.58	0.55	0.56	0.56	0.12	0.05	0.06	0.07	0.05	0.09
89	0.4	2	0.8	1	1.00	100	0.57	0.54	0.56	0.55	0.10	0.05	0.06	0.06	0.04	0.09
38	0.3	3	0.6	1	0.50	100	0.57	0.55	0.56	0.56	0.12	0.06	0.08	0.06	0.05	0.10
41	0.3	3	0.6	1	0.75	100	0.57	0.54	0.55	0.55	0.10	0.05	0.07	0.07	0.05	0.09
44	0.3	3	0.6	1	1.00	100	0.57	0.54	0.56	0.55	0.10	0.06	0.07	0.06	0.05	0.10
47	0.3	3	0.8	1	0.50	100	0.58	0.56	0.55	0.56	0.11	0.06	0.07	0.07	0.04	0.09
50	0.3	3	0.8	1	0.75	100	0.57	0.55	0.57	0.56	0.11	0.06	0.07	0.07	0.05	0.10
53	0.3	3	0.8	1	1.00	100	0.57	0.55	0.55	0.55	0.10	0.05	0.08	0.06	0.05	0.09
92	0.4	3	0.6	1	0.50	100	0.56	0.55	0.55	0.55	0.10	0.06	0.09	0.06	0.05	0.11
95	0.4	3	0.6	1	0.75	100	0.56	0.55	0.54	0.54	0.09	0.06	0.08	0.07	0.05	0.09
98	0.4	3	0.6	1	1.00	100	0.56	0.55	0.55	0.55	0.10	0.06	0.06	0.07	0.05	0.10
101	0.4	3	0.8	1	0.50	100	0.57	0.55	0.55	0.55	0.10	0.06	0.07	0.06	0.05	0.09
104	0.4	3	0.8	1	0.75	100	0.56	0.55	0.54	0.54	0.09	0.07	0.07	0.07	0.05	0.10
107	0.4	3	0.8	1	1.00	100	0.57	0.55	0.55	0.55	0.10	0.06	0.07	0.07	0.05	0.10
3	0.3	1	0.6	1	0.50	150	0.61	0.56	0.59	0.58	0.16	0.06	0.07	0.05	0.05	0.10
6	0.3	1	0.6	1	0.75	150	0.61	0.58	0.59	0.58	0.16	0.06	0.08	0.06	0.05	0.11
9	0.3	1	0.6	1	1.00	150	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.10
12	0.3	1	0.8	1	0.50	150	0.61	0.58	0.58	0.58	0.16	0.05	0.07	0.06	0.05	0.10
15	0.3	1	0.8	1	0.75	150	0.61	0.57	0.58	0.58	0.15	0.06	0.08	0.06	0.05	0.10
18	0.3	1	0.8	1	1.00	150	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.10
57	0.4	1	0.6	1	0.50	150	0.60	0.57	0.56	0.56	0.13	0.06	0.08	0.06	0.05	0.10
60	0.4	1	0.6	1	0.75	150	0.61	0.57	0.58	0.58	0.15	0.05	0.07	0.06	0.05	0.09
63	0.4	1	0.6	1	1.00	150	0.61	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.10
66	0.4	1	0.8	1	0.50	150	0.60	0.56	0.58	0.57	0.13	0.06	0.08	0.06	0.05	0.10
69	0.4	1	0.8	1	0.75	150	0.61	0.57	0.58	0.58	0.15	0.05	0.08	0.07	0.05	0.10
72	0.4	1	0.8	1	1.00	150	0.61	0.57	0.58	0.58	0.15	0.06	0.07	0.06	0.05	0.10
21	0.3	2	0.6	1	0.50	150	0.58	0.55	0.57	0.56	0.12	0.06	0.08	0.07	0.05	0.11
24	0.3	2	0.6	1	0.75	150	0.58	0.55	0.57	0.56	0.12	0.05	0.07	0.07	0.05	0.09
27	0.3	2	0.6	1	1.00	150	0.58	0.56	0.56	0.56	0.11	0.06	0.06	0.06	0.05	0.10
30	0.3	2	0.8	1	0.50	150	0.58	0.55	0.57	0.56	0.12	0.05	0.06	0.06	0.04	0.08
33	0.3	2	0.8	1	0.75	150	0.58	0.54	0.56	0.55	0.10	0.06	0.08	0.07	0.05	0.11
36	0.3	2	0.8	1	1.00	150	0.58	0.54	0.56	0.55	0.10	0.06	0.07	0.07	0.05	0.10
75	0.4	2	0.6	1	0.50	150	0.56	0.54	0.55	0.55	0.09	0.06	0.07	0.07	0.05	0.10
78	0.4	2	0.6	1	0.75	150	0.57	0.55	0.56	0.56	0.12	0.06	0.06	0.06	0.05	0.09
81	0.4	2	0.6	1	1.00	150	0.57	0.55	0.55	0.55	0.10	0.06	0.06	0.07	0.05	0.09
84	0.4	2	0.8	1	0.50	150	0.56	0.55	0.54	0.54	0.09	0.05	0.06	0.07	0.04	0.09
87	0.4	2	0.8	1	0.75	150	0.58	0.56	0.56	0.56	0.12	0.05	0.07	0.06	0.05	0.09
90	0.4	2	0.8	1	1.00	150	0.57	0.54	0.55	0.55	0.09	0.05	0.06	0.06	0.04	0.09
39	0.3	3	0.6	1	0.50	150	0.57	0.55	0.57	0.56	0.12	0.05	0.07	0.05	0.04	0.09
42	0.3	3	0.6	1	0.75	150	0.56	0.54	0.55	0.54	0.08	0.05	0.06	0.07	0.04	0.09
45	0.3	3	0.6	1	1.00	150	0.56	0.54	0.56	0.55	0.09	0.06	0.07	0.06	0.05	0.10
48	0.3	3	0.8	1	0.50	150	0.57	0.55	0.54	0.55	0.09	0.05	0.07	0.06	0.04	0.08
51	0.3	3	0.8	1	0.75	150	0.56	0.55	0.55	0.55	0.09	0.06	0.07	0.07	0.05	0.10
54	0.3	3	0.8	1	1.00	150	0.57	0.55	0.55	0.55	0.10	0.05	0.07	0.07	0.05	0.10
93	0.4	3	0.6	1	0.50	150	0.56	0.54	0.54	0.54	0.09	0.05	0.07	0.06	0.04	0.08
96	0.4	3	0.6	1	0.75	150	0.56	0.54	0.54	0.54	0.08	0.06	0.09	0.06	0.05	0.11
99	0.4	3	0.6	1	1.00	150	0.56	0.54	0.55	0.55	0.09	0.06	0.06	0.07	0.05	0.10
102	0.4	3	0.8	1	0.50	150	0.55	0.54	0.54	0.54	0.08	0.06	0.07	0.07	0.05	0.11
105	0.4	3	0.8	1	0.75	150	0.56	0.54	0.54	0.54	0.08	0.07	0.07	0.07	0.05	0.11
108	0.4	3	0.8	1	1.00	150	0.56	0.54	0.55	0.55	0.10	0.06	0.07	0.07	0.05	0.10

grafico_confusion(modelo_xgboost,train_xgboost,test_xgboost)

grafico_roc(modelo_xgboost,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6917

plot(varImp(modelo_xgboost))

Conseguimos un AUC de test del 64,1%.
A partir de la mejor combinación de hiperparámetros del modelo anterior (nrounds=50; max_depth=1; eta=0,3; gamma=0; colsample_bytree=0,6; min_child_weight=1, subsample=0,75) ampliamos la rejilla de cada uno de ellos secuencialmente.
Primero, lo hacemos con nrounds, eta y max_depth, dejando el resto con los valores por defecto. Con ello tratamos de buscar una tasa de aprendizaje (eta) adecuada.

tune_grid <- expand.grid( nrounds = c(30,50,100,150,200,300,400,500),
                          eta = c( 0.025,0.05, 0.1, 0.3,0.5),
                          max_depth = c(1,2, 3, 4, 5),
                          gamma = 0,
                          colsample_bytree = 1,
                          min_child_weight = 1,
                          subsample = 1 )

modelo_xgboost2 <- train( x = train_xgboost[-length(train_xgboost)],
                       y = train_xgboost$y,
                       method = "xgbTree",
                      tuneGrid= tune_grid,
                       trControl = control,
                       preProc=c("center","scale"),
                       verbose = TRUE )

resultados(modelo_xgboost2)

## [1] "Mejores hiperparámetros:"
##    nrounds max_depth eta gamma colsample_bytree min_child_weight subsample
## 81      30         1 0.1     0                1                1         1

	eta	max_depth	colsample_bytree	min_child_weight	subsample	nrounds	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.03	1	1	1	1	30	0.60	0.59	0.52	0.56	0.12	0.06	0.09	0.10	0.06	0.12
41	0.05	1	1	1	1	30	0.61	0.59	0.57	0.58	0.16	0.06	0.08	0.06	0.05	0.10
81	0.10	1	1	1	1	30	0.63	0.59	0.60	0.59	0.19	0.06	0.07	0.06	0.05	0.09
121	0.30	1	1	1	1	30	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.09
161	0.50	1	1	1	1	30	0.63	0.57	0.61	0.59	0.18	0.05	0.07	0.07	0.04	0.09
9	0.03	2	1	1	1	30	0.60	0.51	0.63	0.57	0.14	0.06	0.08	0.06	0.05	0.10
49	0.05	2	1	1	1	30	0.61	0.54	0.62	0.58	0.16	0.06	0.08	0.05	0.04	0.09
89	0.10	2	1	1	1	30	0.62	0.56	0.62	0.59	0.18	0.05	0.08	0.06	0.04	0.08
129	0.30	2	1	1	1	30	0.61	0.56	0.60	0.58	0.16	0.05	0.07	0.07	0.04	0.08
169	0.50	2	1	1	1	30	0.59	0.54	0.59	0.56	0.12	0.05	0.07	0.08	0.05	0.09
17	0.03	3	1	1	1	30	0.61	0.56	0.62	0.59	0.17	0.05	0.07	0.05	0.04	0.08
57	0.05	3	1	1	1	30	0.60	0.55	0.60	0.58	0.15	0.05	0.07	0.06	0.04	0.08
97	0.10	3	1	1	1	30	0.60	0.55	0.60	0.57	0.14	0.05	0.06	0.06	0.03	0.07
137	0.30	3	1	1	1	30	0.58	0.54	0.57	0.56	0.12	0.05	0.06	0.07	0.04	0.08
177	0.50	3	1	1	1	30	0.57	0.54	0.55	0.55	0.10	0.05	0.07	0.07	0.04	0.09
25	0.03	4	1	1	1	30	0.60	0.56	0.60	0.58	0.17	0.05	0.06	0.06	0.04	0.09
65	0.05	4	1	1	1	30	0.60	0.56	0.58	0.57	0.14	0.05	0.06	0.06	0.04	0.08
105	0.10	4	1	1	1	30	0.59	0.56	0.57	0.57	0.13	0.05	0.06	0.07	0.04	0.08
145	0.30	4	1	1	1	30	0.57	0.55	0.56	0.55	0.10	0.04	0.07	0.07	0.04	0.07
185	0.50	4	1	1	1	30	0.56	0.55	0.53	0.54	0.08	0.05	0.07	0.07	0.04	0.09
33	0.03	5	1	1	1	30	0.60	0.57	0.58	0.58	0.15	0.05	0.06	0.06	0.04	0.09
73	0.05	5	1	1	1	30	0.59	0.57	0.57	0.57	0.14	0.05	0.06	0.07	0.05	0.09
113	0.10	5	1	1	1	30	0.58	0.56	0.56	0.56	0.12	0.05	0.06	0.08	0.04	0.09
153	0.30	5	1	1	1	30	0.55	0.54	0.55	0.54	0.09	0.05	0.06	0.08	0.04	0.08
193	0.50	5	1	1	1	30	0.55	0.54	0.54	0.54	0.08	0.04	0.06	0.06	0.04	0.08
2	0.03	1	1	1	1	50	0.61	0.59	0.56	0.58	0.15	0.06	0.07	0.07	0.06	0.11
42	0.05	1	1	1	1	50	0.62	0.58	0.59	0.59	0.18	0.06	0.07	0.06	0.04	0.09
82	0.10	1	1	1	1	50	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.09
122	0.30	1	1	1	1	50	0.63	0.57	0.61	0.59	0.18	0.05	0.07	0.06	0.04	0.09
162	0.50	1	1	1	1	50	0.62	0.57	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.08
10	0.03	2	1	1	1	50	0.61	0.53	0.63	0.58	0.16	0.06	0.07	0.05	0.05	0.09
50	0.05	2	1	1	1	50	0.62	0.55	0.62	0.58	0.17	0.05	0.08	0.05	0.04	0.08
90	0.10	2	1	1	1	50	0.62	0.55	0.62	0.59	0.17	0.05	0.07	0.05	0.04	0.08
130	0.30	2	1	1	1	50	0.60	0.55	0.59	0.57	0.15	0.05	0.06	0.08	0.04	0.08
170	0.50	2	1	1	1	50	0.58	0.55	0.57	0.56	0.12	0.05	0.08	0.08	0.05	0.10
18	0.03	3	1	1	1	50	0.60	0.55	0.61	0.58	0.15	0.05	0.07	0.06	0.04	0.09
58	0.05	3	1	1	1	50	0.60	0.55	0.59	0.57	0.14	0.05	0.06	0.06	0.03	0.07
98	0.10	3	1	1	1	50	0.60	0.55	0.59	0.57	0.14	0.05	0.07	0.06	0.03	0.07
138	0.30	3	1	1	1	50	0.57	0.54	0.55	0.54	0.09	0.05	0.06	0.07	0.04	0.09
178	0.50	3	1	1	1	50	0.56	0.55	0.55	0.55	0.09	0.05	0.08	0.07	0.05	0.10
26	0.03	4	1	1	1	50	0.60	0.55	0.59	0.57	0.14	0.05	0.07	0.06	0.04	0.09
66	0.05	4	1	1	1	50	0.59	0.55	0.57	0.56	0.12	0.05	0.06	0.07	0.04	0.09
106	0.10	4	1	1	1	50	0.58	0.55	0.56	0.56	0.11	0.05	0.05	0.07	0.04	0.08
146	0.30	4	1	1	1	50	0.56	0.54	0.55	0.54	0.09	0.04	0.06	0.06	0.03	0.07
186	0.50	4	1	1	1	50	0.55	0.54	0.54	0.54	0.07	0.05	0.07	0.06	0.04	0.07
34	0.03	5	1	1	1	50	0.60	0.57	0.58	0.57	0.14	0.05	0.07	0.06	0.04	0.09
74	0.05	5	1	1	1	50	0.59	0.56	0.57	0.56	0.13	0.05	0.06	0.07	0.04	0.09
114	0.10	5	1	1	1	50	0.57	0.55	0.56	0.55	0.11	0.05	0.06	0.08	0.04	0.08
154	0.30	5	1	1	1	50	0.55	0.52	0.54	0.53	0.06	0.05	0.07	0.07	0.04	0.07
194	0.50	5	1	1	1	50	0.55	0.53	0.54	0.54	0.08	0.04	0.06	0.06	0.04	0.07
3	0.03	1	1	1	1	100	0.62	0.58	0.59	0.59	0.18	0.06	0.07	0.06	0.05	0.09
43	0.05	1	1	1	1	100	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.09
83	0.10	1	1	1	1	100	0.63	0.57	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.08
123	0.30	1	1	1	1	100	0.62	0.57	0.60	0.58	0.17	0.05	0.06	0.06	0.04	0.08
163	0.50	1	1	1	1	100	0.61	0.57	0.59	0.58	0.16	0.05	0.07	0.07	0.04	0.09
11	0.03	2	1	1	1	100	0.62	0.55	0.62	0.58	0.17	0.05	0.08	0.06	0.04	0.08
51	0.05	2	1	1	1	100	0.62	0.55	0.61	0.58	0.16	0.05	0.07	0.05	0.04	0.08
91	0.10	2	1	1	1	100	0.60	0.56	0.60	0.58	0.16	0.05	0.07	0.06	0.04	0.09
131	0.30	2	1	1	1	100	0.58	0.54	0.56	0.55	0.11	0.05	0.07	0.08	0.04	0.09
171	0.50	2	1	1	1	100	0.56	0.54	0.54	0.54	0.08	0.05	0.07	0.07	0.04	0.08
19	0.03	3	1	1	1	100	0.60	0.55	0.59	0.57	0.14	0.05	0.07	0.06	0.04	0.07
59	0.05	3	1	1	1	100	0.59	0.55	0.59	0.57	0.13	0.05	0.07	0.07	0.04	0.08
99	0.10	3	1	1	1	100	0.58	0.54	0.58	0.56	0.12	0.05	0.06	0.07	0.04	0.08
139	0.30	3	1	1	1	100	0.56	0.53	0.55	0.54	0.08	0.05	0.07	0.07	0.04	0.08
179	0.50	3	1	1	1	100	0.55	0.53	0.54	0.53	0.07	0.05	0.07	0.07	0.04	0.08
27	0.03	4	1	1	1	100	0.59	0.55	0.57	0.56	0.12	0.05	0.06	0.07	0.04	0.08
67	0.05	4	1	1	1	100	0.58	0.55	0.57	0.56	0.12	0.05	0.07	0.07	0.04	0.09
107	0.10	4	1	1	1	100	0.57	0.54	0.56	0.55	0.10	0.05	0.06	0.08	0.04	0.08
147	0.30	4	1	1	1	100	0.55	0.53	0.54	0.54	0.08	0.05	0.07	0.06	0.04	0.07
187	0.50	4	1	1	1	100	0.55	0.53	0.53	0.53	0.07	0.04	0.07	0.07	0.04	0.08
35	0.03	5	1	1	1	100	0.59	0.56	0.56	0.56	0.13	0.05	0.07	0.07	0.04	0.08
75	0.05	5	1	1	1	100	0.58	0.56	0.56	0.56	0.12	0.05	0.07	0.07	0.04	0.09
115	0.10	5	1	1	1	100	0.56	0.54	0.55	0.54	0.09	0.04	0.06	0.07	0.04	0.08
155	0.30	5	1	1	1	100	0.55	0.53	0.53	0.53	0.07	0.05	0.07	0.07	0.04	0.07
195	0.50	5	1	1	1	100	0.55	0.53	0.54	0.54	0.07	0.04	0.06	0.07	0.04	0.08
4	0.03	1	1	1	1	150	0.63	0.58	0.60	0.59	0.18	0.06	0.06	0.06	0.04	0.08
44	0.05	1	1	1	1	150	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.06	0.04	0.08
84	0.10	1	1	1	1	150	0.63	0.57	0.61	0.59	0.17	0.05	0.08	0.06	0.05	0.09
124	0.30	1	1	1	1	150	0.62	0.57	0.59	0.58	0.16	0.05	0.06	0.07	0.04	0.08
164	0.50	1	1	1	1	150	0.61	0.57	0.58	0.57	0.15	0.05	0.08	0.07	0.04	0.09
12	0.03	2	1	1	1	150	0.62	0.55	0.62	0.59	0.17	0.05	0.07	0.06	0.04	0.08
52	0.05	2	1	1	1	150	0.61	0.56	0.61	0.58	0.17	0.05	0.07	0.06	0.04	0.08
92	0.10	2	1	1	1	150	0.60	0.55	0.59	0.57	0.14	0.05	0.07	0.07	0.04	0.09
132	0.30	2	1	1	1	150	0.57	0.54	0.55	0.54	0.09	0.05	0.08	0.08	0.05	0.10
172	0.50	2	1	1	1	150	0.55	0.53	0.54	0.53	0.07	0.05	0.08	0.07	0.05	0.09
20	0.03	3	1	1	1	150	0.60	0.55	0.59	0.57	0.13	0.05	0.07	0.06	0.04	0.07
60	0.05	3	1	1	1	150	0.59	0.55	0.58	0.56	0.13	0.05	0.06	0.07	0.03	0.07
100	0.10	3	1	1	1	150	0.57	0.55	0.56	0.55	0.10	0.05	0.08	0.08	0.04	0.09
140	0.30	3	1	1	1	150	0.56	0.53	0.54	0.54	0.08	0.05	0.07	0.07	0.04	0.08
180	0.50	3	1	1	1	150	0.55	0.53	0.54	0.53	0.06	0.05	0.07	0.07	0.04	0.08
28	0.03	4	1	1	1	150	0.59	0.55	0.57	0.56	0.12	0.05	0.06	0.07	0.04	0.08
68	0.05	4	1	1	1	150	0.57	0.54	0.56	0.55	0.10	0.05	0.07	0.07	0.04	0.09
108	0.10	4	1	1	1	150	0.56	0.53	0.55	0.54	0.07	0.04	0.06	0.06	0.03	0.07
148	0.30	4	1	1	1	150	0.56	0.54	0.54	0.54	0.08	0.04	0.06	0.06	0.04	0.08
188	0.50	4	1	1	1	150	0.55	0.53	0.54	0.53	0.07	0.04	0.07	0.06	0.04	0.08
36	0.03	5	1	1	1	150	0.58	0.56	0.56	0.56	0.12	0.05	0.06	0.07	0.04	0.09
76	0.05	5	1	1	1	150	0.57	0.55	0.55	0.55	0.11	0.05	0.07	0.08	0.04	0.08
116	0.10	5	1	1	1	150	0.56	0.54	0.54	0.54	0.07	0.04	0.06	0.07	0.04	0.08
156	0.30	5	1	1	1	150	0.55	0.54	0.54	0.54	0.08	0.04	0.06	0.07	0.04	0.07
196	0.50	5	1	1	1	150	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.04	0.08
5	0.03	1	1	1	1	200	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.08
45	0.05	1	1	1	1	200	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.06	0.04	0.08
85	0.10	1	1	1	1	200	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
125	0.30	1	1	1	1	200	0.61	0.57	0.59	0.58	0.16	0.05	0.07	0.07	0.05	0.09
165	0.50	1	1	1	1	200	0.60	0.57	0.59	0.58	0.16	0.05	0.08	0.07	0.05	0.09
13	0.03	2	1	1	1	200	0.62	0.56	0.61	0.58	0.17	0.05	0.07	0.06	0.04	0.09
53	0.05	2	1	1	1	200	0.60	0.56	0.60	0.58	0.16	0.05	0.07	0.07	0.04	0.08
93	0.10	2	1	1	1	200	0.59	0.55	0.58	0.57	0.13	0.05	0.07	0.07	0.04	0.09
133	0.30	2	1	1	1	200	0.56	0.54	0.54	0.54	0.08	0.05	0.08	0.08	0.05	0.10
173	0.50	2	1	1	1	200	0.55	0.53	0.54	0.53	0.07	0.05	0.08	0.07	0.04	0.09
21	0.03	3	1	1	1	200	0.59	0.54	0.59	0.56	0.13	0.05	0.07	0.06	0.04	0.08
61	0.05	3	1	1	1	200	0.58	0.55	0.57	0.56	0.12	0.05	0.07	0.08	0.04	0.08
101	0.10	3	1	1	1	200	0.57	0.54	0.55	0.55	0.09	0.05	0.07	0.08	0.04	0.08
141	0.30	3	1	1	1	200	0.55	0.53	0.54	0.53	0.07	0.05	0.08	0.07	0.04	0.08
181	0.50	3	1	1	1	200	0.54	0.53	0.54	0.53	0.06	0.05	0.07	0.07	0.04	0.09
29	0.03	4	1	1	1	200	0.58	0.55	0.57	0.56	0.11	0.05	0.06	0.07	0.04	0.08
69	0.05	4	1	1	1	200	0.57	0.54	0.55	0.55	0.09	0.04	0.06	0.07	0.04	0.07
109	0.10	4	1	1	1	200	0.56	0.54	0.54	0.54	0.07	0.04	0.07	0.06	0.04	0.07
149	0.30	4	1	1	1	200	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.04	0.07
189	0.50	4	1	1	1	200	0.55	0.53	0.54	0.53	0.07	0.04	0.07	0.06	0.04	0.07
37	0.03	5	1	1	1	200	0.58	0.56	0.56	0.56	0.12	0.05	0.07	0.08	0.04	0.08
77	0.05	5	1	1	1	200	0.57	0.54	0.55	0.55	0.09	0.05	0.07	0.07	0.04	0.08
117	0.10	5	1	1	1	200	0.55	0.53	0.54	0.54	0.07	0.04	0.06	0.07	0.04	0.08
157	0.30	5	1	1	1	200	0.55	0.54	0.53	0.54	0.08	0.04	0.06	0.06	0.04	0.07
197	0.50	5	1	1	1	200	0.55	0.54	0.53	0.54	0.07	0.04	0.07	0.06	0.04	0.08
6	0.03	1	1	1	1	300	0.63	0.58	0.60	0.59	0.18	0.05	0.07	0.06	0.04	0.08
46	0.05	1	1	1	1	300	0.63	0.57	0.61	0.59	0.18	0.05	0.07	0.06	0.04	0.08
86	0.10	1	1	1	1	300	0.62	0.57	0.60	0.58	0.17	0.05	0.07	0.07	0.04	0.08
126	0.30	1	1	1	1	300	0.61	0.57	0.58	0.57	0.15	0.05	0.07	0.07	0.05	0.09
166	0.50	1	1	1	1	300	0.60	0.57	0.58	0.58	0.15	0.05	0.07	0.08	0.05	0.09
14	0.03	2	1	1	1	300	0.61	0.56	0.61	0.59	0.17	0.05	0.07	0.06	0.04	0.09
54	0.05	2	1	1	1	300	0.60	0.55	0.59	0.57	0.15	0.05	0.07	0.07	0.04	0.08
94	0.10	2	1	1	1	300	0.58	0.55	0.57	0.56	0.12	0.05	0.08	0.08	0.05	0.09
134	0.30	2	1	1	1	300	0.56	0.54	0.54	0.54	0.08	0.05	0.08	0.07	0.04	0.09
174	0.50	2	1	1	1	300	0.55	0.53	0.54	0.53	0.06	0.05	0.07	0.07	0.04	0.08
22	0.03	3	1	1	1	300	0.59	0.55	0.58	0.56	0.12	0.05	0.06	0.07	0.03	0.07
62	0.05	3	1	1	1	300	0.57	0.54	0.56	0.55	0.09	0.05	0.06	0.08	0.04	0.08
102	0.10	3	1	1	1	300	0.56	0.53	0.55	0.54	0.08	0.05	0.07	0.07	0.04	0.08
142	0.30	3	1	1	1	300	0.55	0.53	0.54	0.53	0.06	0.05	0.08	0.06	0.04	0.08
182	0.50	3	1	1	1	300	0.54	0.53	0.54	0.54	0.07	0.05	0.08	0.06	0.05	0.09
30	0.03	4	1	1	1	300	0.57	0.55	0.56	0.55	0.11	0.05	0.06	0.07	0.04	0.08
70	0.05	4	1	1	1	300	0.56	0.54	0.54	0.54	0.08	0.04	0.07	0.07	0.04	0.07
110	0.10	4	1	1	1	300	0.55	0.54	0.54	0.54	0.07	0.04	0.06	0.07	0.03	0.07
150	0.30	4	1	1	1	300	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.04	0.08
190	0.50	4	1	1	1	300	0.55	0.53	0.54	0.54	0.07	0.04	0.06	0.07	0.04	0.07
38	0.03	5	1	1	1	300	0.57	0.55	0.55	0.55	0.10	0.05	0.07	0.07	0.04	0.08
78	0.05	5	1	1	1	300	0.56	0.54	0.55	0.54	0.08	0.05	0.07	0.07	0.04	0.08
118	0.10	5	1	1	1	300	0.55	0.53	0.53	0.53	0.07	0.04	0.07	0.06	0.04	0.08
158	0.30	5	1	1	1	300	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.04	0.07
198	0.50	5	1	1	1	300	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.04	0.08
7	0.03	1	1	1	1	400	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.06	0.04	0.08
47	0.05	1	1	1	1	400	0.63	0.57	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
87	0.10	1	1	1	1	400	0.62	0.57	0.60	0.58	0.16	0.05	0.07	0.07	0.04	0.09
127	0.30	1	1	1	1	400	0.60	0.57	0.58	0.57	0.15	0.05	0.07	0.08	0.05	0.09
167	0.50	1	1	1	1	400	0.60	0.57	0.58	0.57	0.15	0.05	0.07	0.08	0.05	0.09
15	0.03	2	1	1	1	400	0.60	0.56	0.60	0.58	0.16	0.05	0.07	0.06	0.04	0.09
55	0.05	2	1	1	1	400	0.59	0.55	0.58	0.56	0.13	0.05	0.07	0.07	0.04	0.08
95	0.10	2	1	1	1	400	0.57	0.54	0.56	0.55	0.11	0.05	0.08	0.08	0.04	0.09
135	0.30	2	1	1	1	400	0.55	0.54	0.54	0.54	0.07	0.05	0.07	0.07	0.04	0.09
175	0.50	2	1	1	1	400	0.54	0.53	0.54	0.53	0.07	0.05	0.07	0.07	0.04	0.08
23	0.03	3	1	1	1	400	0.58	0.54	0.57	0.56	0.11	0.05	0.07	0.07	0.04	0.07
63	0.05	3	1	1	1	400	0.56	0.53	0.55	0.54	0.08	0.05	0.07	0.08	0.04	0.08
103	0.10	3	1	1	1	400	0.56	0.53	0.54	0.54	0.08	0.04	0.07	0.07	0.04	0.08
143	0.30	3	1	1	1	400	0.54	0.53	0.54	0.53	0.07	0.05	0.07	0.05	0.04	0.08
183	0.50	3	1	1	1	400	0.54	0.53	0.54	0.54	0.07	0.05	0.08	0.07	0.04	0.09
31	0.03	4	1	1	1	400	0.57	0.54	0.56	0.55	0.10	0.05	0.06	0.07	0.04	0.07
71	0.05	4	1	1	1	400	0.56	0.54	0.54	0.54	0.08	0.04	0.07	0.07	0.03	0.07
111	0.10	4	1	1	1	400	0.55	0.53	0.54	0.53	0.07	0.04	0.06	0.07	0.03	0.07
151	0.30	4	1	1	1	400	0.55	0.54	0.54	0.54	0.07	0.04	0.07	0.07	0.04	0.08
191	0.50	4	1	1	1	400	0.55	0.53	0.54	0.54	0.07	0.05	0.07	0.06	0.04	0.08
39	0.03	5	1	1	1	400	0.57	0.55	0.55	0.55	0.09	0.04	0.07	0.07	0.04	0.09
79	0.05	5	1	1	1	400	0.56	0.54	0.54	0.54	0.08	0.04	0.07	0.07	0.04	0.07
119	0.10	5	1	1	1	400	0.55	0.53	0.53	0.53	0.06	0.04	0.07	0.07	0.04	0.07
159	0.30	5	1	1	1	400	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.06	0.03	0.07
199	0.50	5	1	1	1	400	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.07	0.04	0.09
8	0.03	1	1	1	1	500	0.63	0.57	0.60	0.59	0.17	0.05	0.08	0.06	0.04	0.08
48	0.05	1	1	1	1	500	0.62	0.57	0.60	0.59	0.17	0.05	0.07	0.07	0.04	0.09
88	0.10	1	1	1	1	500	0.62	0.56	0.59	0.58	0.16	0.05	0.06	0.07	0.04	0.09
128	0.30	1	1	1	1	500	0.60	0.57	0.58	0.57	0.15	0.05	0.08	0.08	0.05	0.10
168	0.50	1	1	1	1	500	0.59	0.57	0.57	0.57	0.14	0.05	0.07	0.08	0.04	0.09
16	0.03	2	1	1	1	500	0.60	0.55	0.59	0.57	0.15	0.05	0.07	0.07	0.04	0.09
56	0.05	2	1	1	1	500	0.58	0.55	0.57	0.56	0.12	0.05	0.07	0.07	0.05	0.09
96	0.10	2	1	1	1	500	0.57	0.55	0.56	0.55	0.10	0.05	0.08	0.08	0.05	0.09
136	0.30	2	1	1	1	500	0.55	0.53	0.54	0.54	0.07	0.05	0.07	0.07	0.04	0.09
176	0.50	2	1	1	1	500	0.54	0.52	0.54	0.53	0.06	0.05	0.07	0.06	0.04	0.07
24	0.03	3	1	1	1	500	0.57	0.54	0.57	0.56	0.11	0.05	0.07	0.07	0.04	0.09
64	0.05	3	1	1	1	500	0.56	0.54	0.55	0.54	0.08	0.05	0.07	0.07	0.04	0.08
104	0.10	3	1	1	1	500	0.56	0.54	0.54	0.54	0.08	0.05	0.08	0.06	0.04	0.07
144	0.30	3	1	1	1	500	0.54	0.53	0.54	0.53	0.07	0.05	0.07	0.06	0.04	0.08
184	0.50	3	1	1	1	500	0.55	0.53	0.54	0.53	0.07	0.05	0.08	0.07	0.04	0.09
32	0.03	4	1	1	1	500	0.57	0.54	0.55	0.54	0.09	0.05	0.06	0.07	0.03	0.07
72	0.05	4	1	1	1	500	0.55	0.53	0.54	0.54	0.07	0.04	0.07	0.06	0.03	0.06
112	0.10	4	1	1	1	500	0.55	0.52	0.53	0.53	0.06	0.04	0.07	0.07	0.03	0.07
152	0.30	4	1	1	1	500	0.55	0.54	0.53	0.54	0.07	0.04	0.07	0.06	0.04	0.07
192	0.50	4	1	1	1	500	0.55	0.53	0.54	0.54	0.08	0.05	0.07	0.06	0.04	0.09
40	0.03	5	1	1	1	500	0.56	0.54	0.55	0.55	0.09	0.04	0.06	0.07	0.04	0.08
80	0.05	5	1	1	1	500	0.55	0.54	0.53	0.54	0.07	0.04	0.07	0.07	0.04	0.07
120	0.10	5	1	1	1	500	0.55	0.53	0.53	0.53	0.06	0.04	0.06	0.07	0.04	0.07
160	0.30	5	1	1	1	500	0.55	0.54	0.54	0.54	0.08	0.04	0.07	0.07	0.04	0.08
200	0.50	5	1	1	1	500	0.55	0.54	0.53	0.54	0.08	0.04	0.07	0.07	0.04	0.09

grafico_confusion(modelo_xgboost2,train_xgboost,test_xgboost)

grafico_roc(modelo_xgboost2,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6648

plot(varImp(modelo_xgboost2))

El modelo empeora levemente con un AUC de test del 63,2%.
Una vez encontrada la mejor de las tasas de aprendizaje especificadas en el modelo anterior (0,1), la fijamos y establecemos una rejilla para nrounds, max_depth (mejor valor del modelo anterior, más y menos 1) y min_child_weight. Buscamos el mejor valor de este último hiperparámetro. Dejamos en el resto de hiperparámetros el valor por defecto.

tune_grid2 <- expand.grid( nrounds = c(30,50,100,150,200,300,400,500),
                          eta = modelo_xgboost2$bestTune$eta,
                          max_depth = ifelse( modelo_xgboost2$bestTune$max_depth == 2,
                                              c(modelo_xgboost2$bestTune$max_depth:4),
                                      modelo_xgboost2$bestTune$max_depth - 1:modelo_xgboost2$bestTune$max_depth + 1 ),
                          gamma = 0,
                          colsample_bytree = 1,
                          min_child_weight = c(1, 2, 3),
                          subsample = 1 )

modelo_xgboost3 <- train( x = train_xgboost[-length(train_xgboost)],
                       y = train_xgboost$y,
                       method = "xgbTree",
                      tuneGrid= tune_grid2,
                       trControl = control,
                      preProc=c("center","scale"),
                       verbose = TRUE )

resultados(modelo_xgboost3)

## [1] "Mejores hiperparámetros:"
##    nrounds max_depth eta gamma colsample_bytree min_child_weight subsample
## 19     100         1 0.1     0                1                3         1

	eta	max_depth	colsample_bytree	min_child_weight	subsample	nrounds	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.1	1	1	1	1	30	0.63	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
9	0.1	1	1	2	1	30	0.63	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
17	0.1	1	1	3	1	30	0.63	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
2	0.1	1	1	1	1	50	0.63	0.59	0.60	0.59	0.19	0.05	0.06	0.08	0.05	0.10
10	0.1	1	1	2	1	50	0.63	0.59	0.60	0.59	0.19	0.05	0.06	0.08	0.05	0.10
18	0.1	1	1	3	1	50	0.63	0.59	0.60	0.59	0.19	0.05	0.06	0.08	0.05	0.10
3	0.1	1	1	1	1	100	0.63	0.59	0.61	0.60	0.19	0.05	0.06	0.08	0.05	0.10
11	0.1	1	1	2	1	100	0.63	0.59	0.61	0.60	0.19	0.05	0.06	0.08	0.05	0.10
19	0.1	1	1	3	1	100	0.63	0.58	0.61	0.60	0.19	0.05	0.06	0.08	0.05	0.10
4	0.1	1	1	1	1	150	0.63	0.58	0.60	0.59	0.18	0.05	0.05	0.08	0.05	0.09
12	0.1	1	1	2	1	150	0.63	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.09
20	0.1	1	1	3	1	150	0.63	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.09
5	0.1	1	1	1	1	200	0.63	0.57	0.61	0.59	0.18	0.05	0.06	0.08	0.05	0.10
13	0.1	1	1	2	1	200	0.63	0.57	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
21	0.1	1	1	3	1	200	0.63	0.57	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.09
6	0.1	1	1	1	1	300	0.62	0.57	0.60	0.58	0.16	0.05	0.06	0.08	0.05	0.09
14	0.1	1	1	2	1	300	0.62	0.58	0.60	0.59	0.17	0.05	0.07	0.08	0.05	0.09
22	0.1	1	1	3	1	300	0.62	0.57	0.59	0.58	0.17	0.05	0.06	0.08	0.05	0.09
7	0.1	1	1	1	1	400	0.62	0.57	0.59	0.58	0.16	0.05	0.06	0.07	0.05	0.09
15	0.1	1	1	2	1	400	0.62	0.57	0.59	0.58	0.16	0.05	0.06	0.07	0.05	0.09
23	0.1	1	1	3	1	400	0.62	0.57	0.59	0.58	0.16	0.05	0.06	0.07	0.04	0.09
8	0.1	1	1	1	1	500	0.62	0.57	0.59	0.58	0.16	0.05	0.07	0.07	0.05	0.09
16	0.1	1	1	2	1	500	0.62	0.57	0.59	0.58	0.16	0.05	0.07	0.07	0.05	0.10
24	0.1	1	1	3	1	500	0.62	0.57	0.58	0.58	0.16	0.05	0.07	0.07	0.05	0.10

grafico_confusion(modelo_xgboost3,train_xgboost,test_xgboost)

grafico_roc(modelo_xgboost3,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6846

plot(varImp(modelo_xgboost3))

El nuevo modelo sigue siendo levemente peor que el modelo base, aunque algo mejor que el anterior, con un 63,5% de AUC de test.
Fijamos el mejor valor del modelo anterior del hiperparámetro min_child_weight y establecemos una nueva rejilla para buscar los mejores hiperparámetros relativos al muestreo tanto de observaciones como de variables (colsample_bytree y subsample). Dejamos gamma con su valor por defecto.

tune_grid3 <- expand.grid( nrounds = c(30,50,100,150,200,300,400,500),
                          eta = modelo_xgboost2$bestTune$eta,
                          max_depth = modelo_xgboost3$bestTune$max_depth,
                          gamma = 0,
                          colsample_bytree = c( 0.4, 0.6, 0.8, 1.0 ),
                          min_child_weight = modelo_xgboost3$bestTune$min_child_weight,
                          subsample = c(0.5,0.75,1) )

modelo_xgboost4 <- train( x = train_xgboost[-length(train_xgboost)],
                       y = train_xgboost$y,
                        method = "xgbTree",
                      tuneGrid= tune_grid3,
                       trControl = control,
                      preProc=c("center","scale"),
                       verbose = TRUE )

resultados(modelo_xgboost4)

## [1] "Mejores hiperparámetros:"
##    nrounds max_depth eta gamma colsample_bytree min_child_weight subsample
## 33      30         1 0.1     0              0.6                3      0.75

	eta	max_depth	colsample_bytree	min_child_weight	subsample	nrounds	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.1	1	0.4	3	0.50	30	0.63	0.59	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.10
9	0.1	1	0.4	3	0.75	30	0.63	0.59	0.60	0.60	0.20	0.06	0.08	0.07	0.05	0.09
17	0.1	1	0.4	3	1.00	30	0.63	0.58	0.61	0.60	0.19	0.06	0.08	0.07	0.05	0.10
25	0.1	1	0.6	3	0.50	30	0.63	0.58	0.61	0.60	0.19	0.06	0.08	0.07	0.05	0.11
33	0.1	1	0.6	3	0.75	30	0.63	0.59	0.61	0.60	0.20	0.06	0.08	0.08	0.05	0.11
41	0.1	1	0.6	3	1.00	30	0.63	0.58	0.61	0.60	0.19	0.06	0.08	0.07	0.05	0.10
49	0.1	1	0.8	3	0.50	30	0.63	0.59	0.59	0.59	0.19	0.06	0.08	0.06	0.06	0.11
57	0.1	1	0.8	3	0.75	30	0.63	0.59	0.61	0.60	0.19	0.06	0.07	0.08	0.05	0.10
65	0.1	1	0.8	3	1.00	30	0.63	0.59	0.61	0.60	0.19	0.06	0.08	0.07	0.05	0.10
73	0.1	1	1.0	3	0.50	30	0.63	0.58	0.61	0.59	0.19	0.06	0.07	0.08	0.05	0.10
81	0.1	1	1.0	3	0.75	30	0.63	0.59	0.61	0.60	0.19	0.06	0.08	0.07	0.06	0.11
89	0.1	1	1.0	3	1.00	30	0.63	0.59	0.61	0.60	0.19	0.06	0.08	0.07	0.05	0.10
2	0.1	1	0.4	3	0.50	50	0.64	0.59	0.60	0.59	0.19	0.06	0.07	0.07	0.05	0.10
10	0.1	1	0.4	3	0.75	50	0.64	0.59	0.60	0.60	0.20	0.06	0.09	0.07	0.05	0.11
18	0.1	1	0.4	3	1.00	50	0.63	0.58	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.10
26	0.1	1	0.6	3	0.50	50	0.64	0.59	0.60	0.60	0.19	0.06	0.08	0.07	0.05	0.11
34	0.1	1	0.6	3	0.75	50	0.64	0.58	0.61	0.59	0.19	0.06	0.08	0.07	0.05	0.10
42	0.1	1	0.6	3	1.00	50	0.63	0.59	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.10
50	0.1	1	0.8	3	0.50	50	0.63	0.59	0.60	0.59	0.18	0.06	0.07	0.06	0.05	0.09
58	0.1	1	0.8	3	0.75	50	0.63	0.58	0.60	0.59	0.19	0.06	0.08	0.07	0.05	0.10
66	0.1	1	0.8	3	1.00	50	0.63	0.59	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.10
74	0.1	1	1.0	3	0.50	50	0.64	0.59	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.11
82	0.1	1	1.0	3	0.75	50	0.63	0.58	0.60	0.59	0.19	0.06	0.08	0.08	0.05	0.11
90	0.1	1	1.0	3	1.00	50	0.63	0.59	0.61	0.60	0.20	0.06	0.08	0.07	0.05	0.10
3	0.1	1	0.4	3	0.50	100	0.63	0.59	0.60	0.60	0.19	0.06	0.07	0.06	0.05	0.09
11	0.1	1	0.4	3	0.75	100	0.64	0.59	0.60	0.59	0.19	0.06	0.08	0.06	0.05	0.10
19	0.1	1	0.4	3	1.00	100	0.63	0.59	0.60	0.60	0.19	0.06	0.08	0.07	0.05	0.10
27	0.1	1	0.6	3	0.50	100	0.64	0.59	0.60	0.60	0.19	0.06	0.08	0.07	0.05	0.10
35	0.1	1	0.6	3	0.75	100	0.63	0.58	0.61	0.60	0.19	0.06	0.07	0.07	0.05	0.10
43	0.1	1	0.6	3	1.00	100	0.63	0.59	0.60	0.60	0.19	0.06	0.08	0.07	0.05	0.10
51	0.1	1	0.8	3	0.50	100	0.63	0.60	0.60	0.60	0.20	0.06	0.09	0.06	0.05	0.10
59	0.1	1	0.8	3	0.75	100	0.63	0.58	0.61	0.60	0.19	0.06	0.08	0.06	0.05	0.09
67	0.1	1	0.8	3	1.00	100	0.63	0.59	0.60	0.60	0.19	0.06	0.08	0.07	0.05	0.10
75	0.1	1	1.0	3	0.50	100	0.63	0.59	0.60	0.59	0.18	0.06	0.08	0.07	0.05	0.10
83	0.1	1	1.0	3	0.75	100	0.63	0.57	0.61	0.59	0.18	0.06	0.08	0.07	0.05	0.10
91	0.1	1	1.0	3	1.00	100	0.63	0.59	0.60	0.59	0.19	0.06	0.08	0.07	0.05	0.10
4	0.1	1	0.4	3	0.50	150	0.63	0.59	0.60	0.59	0.18	0.06	0.08	0.06	0.05	0.09
12	0.1	1	0.4	3	0.75	150	0.63	0.58	0.60	0.59	0.18	0.06	0.08	0.06	0.05	0.09
20	0.1	1	0.4	3	1.00	150	0.63	0.58	0.60	0.59	0.19	0.06	0.08	0.06	0.05	0.10
28	0.1	1	0.6	3	0.50	150	0.63	0.58	0.60	0.59	0.18	0.06	0.08	0.07	0.05	0.09
36	0.1	1	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.18	0.06	0.08	0.07	0.05	0.10
44	0.1	1	0.6	3	1.00	150	0.63	0.58	0.61	0.59	0.19	0.06	0.08	0.07	0.05	0.10
52	0.1	1	0.8	3	0.50	150	0.63	0.59	0.60	0.59	0.19	0.06	0.08	0.06	0.06	0.11
60	0.1	1	0.8	3	0.75	150	0.63	0.59	0.60	0.59	0.19	0.06	0.08	0.06	0.05	0.10
68	0.1	1	0.8	3	1.00	150	0.63	0.58	0.60	0.59	0.19	0.06	0.08	0.07	0.05	0.10
76	0.1	1	1.0	3	0.50	150	0.63	0.58	0.60	0.59	0.18	0.06	0.08	0.07	0.05	0.10
84	0.1	1	1.0	3	0.75	150	0.63	0.58	0.60	0.59	0.17	0.06	0.08	0.06	0.05	0.09
92	0.1	1	1.0	3	1.00	150	0.63	0.58	0.61	0.59	0.19	0.06	0.08	0.07	0.05	0.10
5	0.1	1	0.4	3	0.50	200	0.63	0.58	0.59	0.58	0.17	0.06	0.07	0.07	0.05	0.10
13	0.1	1	0.4	3	0.75	200	0.63	0.58	0.59	0.59	0.17	0.06	0.07	0.06	0.04	0.09
21	0.1	1	0.4	3	1.00	200	0.63	0.58	0.61	0.59	0.18	0.06	0.07	0.07	0.05	0.10
29	0.1	1	0.6	3	0.50	200	0.63	0.58	0.59	0.59	0.17	0.06	0.07	0.07	0.04	0.09
37	0.1	1	0.6	3	0.75	200	0.62	0.57	0.60	0.59	0.17	0.06	0.07	0.07	0.05	0.09
45	0.1	1	0.6	3	1.00	200	0.63	0.58	0.60	0.59	0.18	0.06	0.07	0.06	0.05	0.09
53	0.1	1	0.8	3	0.50	200	0.62	0.58	0.59	0.59	0.17	0.06	0.08	0.06	0.05	0.10
61	0.1	1	0.8	3	0.75	200	0.63	0.58	0.59	0.58	0.17	0.06	0.07	0.07	0.05	0.10
69	0.1	1	0.8	3	1.00	200	0.63	0.58	0.61	0.59	0.18	0.06	0.07	0.06	0.05	0.09
77	0.1	1	1.0	3	0.50	200	0.62	0.58	0.58	0.58	0.16	0.06	0.08	0.06	0.05	0.09
85	0.1	1	1.0	3	0.75	200	0.62	0.58	0.60	0.59	0.17	0.06	0.08	0.07	0.05	0.10
93	0.1	1	1.0	3	1.00	200	0.63	0.57	0.60	0.59	0.18	0.06	0.07	0.06	0.05	0.09
6	0.1	1	0.4	3	0.50	300	0.62	0.58	0.59	0.58	0.17	0.06	0.08	0.07	0.05	0.10
14	0.1	1	0.4	3	0.75	300	0.62	0.57	0.58	0.58	0.15	0.06	0.08	0.07	0.05	0.10
22	0.1	1	0.4	3	1.00	300	0.62	0.57	0.60	0.59	0.17	0.06	0.07	0.06	0.04	0.09
30	0.1	1	0.6	3	0.50	300	0.62	0.58	0.59	0.59	0.17	0.06	0.07	0.07	0.05	0.10
38	0.1	1	0.6	3	0.75	300	0.62	0.58	0.59	0.58	0.16	0.06	0.07	0.07	0.05	0.10
46	0.1	1	0.6	3	1.00	300	0.62	0.57	0.60	0.59	0.18	0.06	0.07	0.06	0.04	0.09
54	0.1	1	0.8	3	0.50	300	0.62	0.58	0.59	0.58	0.16	0.06	0.08	0.06	0.05	0.10
62	0.1	1	0.8	3	0.75	300	0.62	0.58	0.59	0.59	0.17	0.06	0.07	0.07	0.05	0.09
70	0.1	1	0.8	3	1.00	300	0.62	0.57	0.60	0.59	0.17	0.06	0.07	0.07	0.04	0.09
78	0.1	1	1.0	3	0.50	300	0.62	0.57	0.58	0.58	0.16	0.06	0.08	0.07	0.05	0.10
86	0.1	1	1.0	3	0.75	300	0.62	0.57	0.59	0.58	0.16	0.06	0.08	0.07	0.05	0.10
94	0.1	1	1.0	3	1.00	300	0.62	0.57	0.60	0.59	0.17	0.06	0.07	0.06	0.04	0.09
7	0.1	1	0.4	3	0.50	400	0.62	0.58	0.59	0.58	0.16	0.06	0.08	0.07	0.05	0.10
15	0.1	1	0.4	3	0.75	400	0.62	0.57	0.58	0.58	0.16	0.06	0.08	0.07	0.05	0.10
23	0.1	1	0.4	3	1.00	400	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.07	0.04	0.09
31	0.1	1	0.6	3	0.50	400	0.62	0.58	0.58	0.58	0.16	0.06	0.06	0.07	0.05	0.09
39	0.1	1	0.6	3	0.75	400	0.62	0.57	0.58	0.58	0.15	0.06	0.08	0.07	0.05	0.10
47	0.1	1	0.6	3	1.00	400	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.07	0.04	0.09
55	0.1	1	0.8	3	0.50	400	0.61	0.57	0.58	0.58	0.15	0.06	0.08	0.06	0.05	0.09
63	0.1	1	0.8	3	0.75	400	0.62	0.57	0.58	0.58	0.16	0.06	0.07	0.07	0.05	0.09
71	0.1	1	0.8	3	1.00	400	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.04	0.09
79	0.1	1	1.0	3	0.50	400	0.61	0.57	0.58	0.58	0.15	0.06	0.07	0.06	0.05	0.10
87	0.1	1	1.0	3	0.75	400	0.61	0.57	0.58	0.58	0.15	0.06	0.08	0.06	0.05	0.10
95	0.1	1	1.0	3	1.00	400	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.07	0.04	0.09
8	0.1	1	0.4	3	0.50	500	0.61	0.57	0.58	0.58	0.15	0.06	0.08	0.07	0.05	0.10
16	0.1	1	0.4	3	0.75	500	0.61	0.57	0.57	0.57	0.15	0.06	0.08	0.07	0.05	0.10
24	0.1	1	0.4	3	1.00	500	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.07	0.05	0.09
32	0.1	1	0.6	3	0.50	500	0.62	0.58	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.10
40	0.1	1	0.6	3	0.75	500	0.61	0.57	0.58	0.57	0.15	0.06	0.08	0.06	0.05	0.09
48	0.1	1	0.6	3	1.00	500	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.06	0.05	0.09
56	0.1	1	0.8	3	0.50	500	0.61	0.58	0.58	0.58	0.15	0.06	0.07	0.06	0.04	0.09
64	0.1	1	0.8	3	0.75	500	0.61	0.58	0.58	0.58	0.16	0.06	0.07	0.06	0.05	0.09
72	0.1	1	0.8	3	1.00	500	0.62	0.57	0.58	0.58	0.16	0.06	0.07	0.07	0.05	0.09
80	0.1	1	1.0	3	0.50	500	0.61	0.57	0.58	0.58	0.16	0.06	0.07	0.07	0.05	0.10
88	0.1	1	1.0	3	0.75	500	0.61	0.57	0.57	0.57	0.14	0.06	0.08	0.06	0.05	0.10
96	0.1	1	1.0	3	1.00	500	0.62	0.57	0.59	0.58	0.16	0.06	0.07	0.07	0.05	0.09

grafico_confusion(modelo_xgboost4,train_xgboost,test_xgboost)

grafico_roc(modelo_xgboost4,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.669

plot(varImp(modelo_xgboost4))

Ahora sí, conseguimos mejorar levemente el modelo base, con un AUC de test del 65,1%.
Fijamos los mejores valores para colsample_bytree y subsample del modelo anterior y establecemos una rejilla para el parámetro de regularización (gamma):

tune_grid4 <- expand.grid( nrounds = c(30,50,100,150,200,300,400,500),
                          eta = modelo_xgboost2$bestTune$eta,
                          max_depth = modelo_xgboost3$bestTune$max_depth,
                          gamma = c(0, 0.05, 0.1, 0.5, 0.7, 0.9, 1.0),
                          colsample_bytree = modelo_xgboost4$bestTune$colsample_bytree,
                          min_child_weight = modelo_xgboost3$bestTune$min_child_weight,
                          subsample = modelo_xgboost4$bestTune$subsample )

modelo_xgboost5 <- train( x = train_xgboost[-length(train_xgboost)],
                       y = train_xgboost$y,
                       method = "xgbTree",
                      tuneGrid= tune_grid4,
                       trControl = control,
                      preProc=c("center","scale"),
                       verbose = TRUE )

resultados(modelo_xgboost5)

## [1] "Mejores hiperparámetros:"
##   nrounds max_depth eta gamma colsample_bytree min_child_weight subsample
## 2      50         1 0.1     0              0.6                3      0.75

	eta	max_depth	gamma	colsample_bytree	min_child_weight	subsample	nrounds	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.1	1	0.00	0.6	3	0.75	30	0.63	0.59	0.60	0.59	0.19	0.04	0.07	0.07	0.04	0.08
9	0.1	1	0.05	0.6	3	0.75	30	0.63	0.58	0.61	0.60	0.19	0.05	0.06	0.07	0.05	0.10
17	0.1	1	0.10	0.6	3	0.75	30	0.63	0.59	0.60	0.60	0.19	0.04	0.07	0.07	0.04	0.09
25	0.1	1	0.50	0.6	3	0.75	30	0.63	0.59	0.60	0.60	0.20	0.05	0.07	0.06	0.05	0.09
33	0.1	1	0.70	0.6	3	0.75	30	0.63	0.58	0.61	0.59	0.18	0.04	0.07	0.07	0.05	0.09
41	0.1	1	0.90	0.6	3	0.75	30	0.63	0.59	0.60	0.59	0.19	0.04	0.06	0.07	0.04	0.09
49	0.1	1	1.00	0.6	3	0.75	30	0.63	0.59	0.61	0.60	0.19	0.04	0.07	0.06	0.05	0.09
2	0.1	1	0.00	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.20	0.04	0.06	0.07	0.05	0.10
10	0.1	1	0.05	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.20	0.04	0.06	0.08	0.05	0.09
18	0.1	1	0.10	0.6	3	0.75	50	0.64	0.59	0.61	0.60	0.20	0.04	0.06	0.07	0.05	0.09
26	0.1	1	0.50	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.19	0.04	0.06	0.07	0.04	0.09
34	0.1	1	0.70	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.19	0.04	0.06	0.07	0.05	0.09
42	0.1	1	0.90	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.20	0.04	0.06	0.07	0.05	0.09
50	0.1	1	1.00	0.6	3	0.75	50	0.63	0.59	0.61	0.60	0.20	0.04	0.06	0.07	0.05	0.10
3	0.1	1	0.00	0.6	3	0.75	100	0.63	0.59	0.61	0.60	0.20	0.04	0.06	0.07	0.04	0.08
11	0.1	1	0.05	0.6	3	0.75	100	0.63	0.59	0.61	0.60	0.19	0.04	0.06	0.07	0.04	0.08
19	0.1	1	0.10	0.6	3	0.75	100	0.63	0.58	0.61	0.60	0.19	0.04	0.06	0.07	0.05	0.09
27	0.1	1	0.50	0.6	3	0.75	100	0.63	0.59	0.61	0.60	0.19	0.04	0.06	0.07	0.04	0.09
35	0.1	1	0.70	0.6	3	0.75	100	0.63	0.58	0.61	0.60	0.19	0.04	0.06	0.07	0.04	0.08
43	0.1	1	0.90	0.6	3	0.75	100	0.63	0.59	0.61	0.60	0.19	0.04	0.06	0.07	0.04	0.09
51	0.1	1	1.00	0.6	3	0.75	100	0.63	0.59	0.60	0.60	0.20	0.04	0.06	0.06	0.04	0.08
4	0.1	1	0.00	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.19	0.04	0.06	0.07	0.04	0.08
12	0.1	1	0.05	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.05	0.09
20	0.1	1	0.10	0.6	3	0.75	150	0.63	0.58	0.61	0.59	0.18	0.04	0.07	0.06	0.04	0.09
28	0.1	1	0.50	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.18	0.04	0.07	0.07	0.05	0.09
36	0.1	1	0.70	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.19	0.04	0.06	0.06	0.04	0.08
44	0.1	1	0.90	0.6	3	0.75	150	0.63	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.04	0.08
52	0.1	1	1.00	0.6	3	0.75	150	0.63	0.59	0.60	0.59	0.19	0.04	0.06	0.07	0.04	0.08
5	0.1	1	0.00	0.6	3	0.75	200	0.62	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.04	0.09
13	0.1	1	0.05	0.6	3	0.75	200	0.62	0.57	0.60	0.59	0.17	0.04	0.06	0.07	0.05	0.09
21	0.1	1	0.10	0.6	3	0.75	200	0.62	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.05	0.09
29	0.1	1	0.50	0.6	3	0.75	200	0.62	0.58	0.60	0.59	0.17	0.04	0.06	0.07	0.04	0.09
37	0.1	1	0.70	0.6	3	0.75	200	0.63	0.58	0.60	0.59	0.18	0.04	0.07	0.06	0.04	0.08
45	0.1	1	0.90	0.6	3	0.75	200	0.62	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.04	0.09
53	0.1	1	1.00	0.6	3	0.75	200	0.63	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.04	0.09
6	0.1	1	0.00	0.6	3	0.75	300	0.62	0.58	0.60	0.59	0.17	0.04	0.06	0.07	0.05	0.09
14	0.1	1	0.05	0.6	3	0.75	300	0.62	0.57	0.59	0.58	0.16	0.04	0.07	0.07	0.05	0.10
22	0.1	1	0.10	0.6	3	0.75	300	0.62	0.57	0.60	0.59	0.17	0.04	0.06	0.06	0.04	0.09
30	0.1	1	0.50	0.6	3	0.75	300	0.62	0.57	0.59	0.58	0.16	0.05	0.07	0.07	0.04	0.09
38	0.1	1	0.70	0.6	3	0.75	300	0.62	0.57	0.59	0.58	0.17	0.04	0.07	0.07	0.05	0.09
46	0.1	1	0.90	0.6	3	0.75	300	0.62	0.57	0.59	0.58	0.17	0.04	0.06	0.07	0.05	0.09
54	0.1	1	1.00	0.6	3	0.75	300	0.62	0.58	0.59	0.58	0.17	0.04	0.06	0.07	0.04	0.09
7	0.1	1	0.00	0.6	3	0.75	400	0.61	0.58	0.60	0.59	0.18	0.04	0.06	0.07	0.04	0.09
15	0.1	1	0.05	0.6	3	0.75	400	0.61	0.58	0.59	0.58	0.17	0.04	0.06	0.07	0.05	0.09
23	0.1	1	0.10	0.6	3	0.75	400	0.61	0.58	0.59	0.58	0.16	0.04	0.06	0.06	0.04	0.09
31	0.1	1	0.50	0.6	3	0.75	400	0.61	0.57	0.58	0.58	0.15	0.04	0.06	0.07	0.05	0.09
39	0.1	1	0.70	0.6	3	0.75	400	0.62	0.57	0.59	0.58	0.16	0.04	0.06	0.07	0.05	0.09
47	0.1	1	0.90	0.6	3	0.75	400	0.61	0.57	0.59	0.58	0.16	0.04	0.06	0.07	0.04	0.09
55	0.1	1	1.00	0.6	3	0.75	400	0.61	0.57	0.59	0.58	0.16	0.04	0.06	0.07	0.05	0.09
8	0.1	1	0.00	0.6	3	0.75	500	0.61	0.58	0.58	0.58	0.16	0.04	0.06	0.06	0.04	0.08
16	0.1	1	0.05	0.6	3	0.75	500	0.61	0.57	0.58	0.58	0.16	0.04	0.06	0.07	0.04	0.09
24	0.1	1	0.10	0.6	3	0.75	500	0.61	0.57	0.59	0.58	0.16	0.04	0.06	0.07	0.04	0.09
32	0.1	1	0.50	0.6	3	0.75	500	0.61	0.57	0.58	0.58	0.15	0.04	0.06	0.07	0.05	0.09
40	0.1	1	0.70	0.6	3	0.75	500	0.61	0.57	0.58	0.58	0.16	0.05	0.06	0.07	0.05	0.10
48	0.1	1	0.90	0.6	3	0.75	500	0.61	0.57	0.58	0.58	0.15	0.04	0.06	0.07	0.04	0.09
56	0.1	1	1.00	0.6	3	0.75	500	0.61	0.57	0.58	0.57	0.15	0.04	0.07	0.08	0.05	0.10

grafico_confusion(modelo_xgboost5,train_xgboost,test_xgboost)

grafico_roc(modelo_xgboost5,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6766

plot(varImp(modelo_xgboost5))

Se mantiene casi el mismo valor de AUC de test que el modelo anterior, con un valor de 64,9%.
Respecto a la importancia de las variables, al igual que en los modelos bayesianos, destacan la variable ingresos y estar o no suscrito a un periódico. Sin embargo, la variable nivel educativo tiene menos importancia aqui.También destacan en los modelos XGBoost las variables espera y multline.

2.3 Otros modelos

Entrenaremos dos modelos más estudiados en el módulo pasado: Máquina de Soporte de Base Radial y un Random Forest. En cada uno de ellos probaremos diferentes valores de sus hiperparámetros:

# SVM
# ==============================================================================
grid_svm <-  expand.grid(sigma = 1:10/400, C = 1:10/10)
modelo_svm <- train(y~.,data = train_xgboost,
                         method = "svmRadial",
                         preProc=c("center","scale"),
                         metric = metrica,
                         trControl = control,
                          tuneGrid=grid_svm)
# Random Forest
# ==============================================================================
grid_rf <-  expand.grid(mtry = 1:27)
modelo_rf <- train(y~.,data = train_xgboost,
                         method = "rf",
                         preProc=c("center","scale"),
                         metric = metrica,
                         trControl = control,
                          tuneGrid=grid_rf)

resultados(modelo_svm)

## [1] "Mejores hiperparámetros:"
##    sigma   C
## 2 0.0025 0.2

sigma	C	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
0.00	0.1	0.63	0.63	0.55	0.59	0.19	0.05	0.12	0.13	0.05	0.09
0.00	0.2	0.63	0.59	0.61	0.60	0.20	0.05	0.07	0.08	0.05	0.10
0.00	0.3	0.63	0.61	0.59	0.60	0.20	0.05	0.07	0.07	0.05	0.10
0.00	0.4	0.63	0.60	0.59	0.60	0.20	0.05	0.07	0.07	0.05	0.10
0.00	0.5	0.63	0.59	0.60	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.00	0.6	0.63	0.58	0.60	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.00	0.7	0.63	0.58	0.60	0.59	0.19	0.05	0.06	0.07	0.05	0.10
0.00	0.8	0.63	0.58	0.61	0.60	0.19	0.05	0.06	0.07	0.05	0.10
0.00	0.9	0.63	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.10
0.00	1.0	0.63	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.00	0.1	0.63	0.60	0.58	0.59	0.18	0.05	0.09	0.09	0.05	0.09
0.00	0.2	0.62	0.60	0.60	0.60	0.19	0.05	0.07	0.07	0.05	0.10
0.00	0.3	0.62	0.59	0.60	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.00	0.4	0.63	0.58	0.60	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.00	0.5	0.63	0.58	0.61	0.60	0.19	0.05	0.06	0.07	0.05	0.09
0.00	0.6	0.63	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.00	0.7	0.63	0.57	0.61	0.59	0.19	0.05	0.07	0.07	0.05	0.09
0.00	0.8	0.63	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.00	0.9	0.63	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.05	0.09
0.00	1.0	0.63	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.01	0.1	0.63	0.59	0.61	0.60	0.20	0.05	0.07	0.07	0.05	0.10
0.01	0.2	0.62	0.59	0.60	0.60	0.19	0.05	0.06	0.07	0.05	0.10
0.01	0.3	0.63	0.58	0.60	0.59	0.19	0.05	0.06	0.08	0.05	0.10
0.01	0.4	0.62	0.58	0.61	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.01	0.5	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.05	0.09
0.01	0.6	0.62	0.57	0.62	0.59	0.19	0.05	0.06	0.07	0.04	0.08
0.01	0.7	0.63	0.57	0.62	0.59	0.19	0.05	0.06	0.07	0.04	0.09
0.01	0.8	0.63	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.01	0.9	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.01	1.0	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.01	0.1	0.63	0.58	0.61	0.59	0.19	0.05	0.07	0.08	0.05	0.10
0.01	0.2	0.62	0.58	0.60	0.59	0.19	0.05	0.06	0.07	0.05	0.10
0.01	0.3	0.62	0.58	0.60	0.59	0.18	0.05	0.07	0.08	0.05	0.10
0.01	0.4	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.08	0.05	0.10
0.01	0.5	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.08	0.04	0.09
0.01	0.6	0.62	0.58	0.61	0.59	0.19	0.05	0.06	0.08	0.04	0.09
0.01	0.7	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.09
0.01	0.8	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.01	0.9	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	1.0	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	0.1	0.63	0.58	0.61	0.59	0.19	0.05	0.07	0.07	0.05	0.10
0.01	0.2	0.62	0.59	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.10
0.01	0.3	0.62	0.57	0.61	0.59	0.19	0.05	0.07	0.08	0.05	0.10
0.01	0.4	0.62	0.57	0.62	0.59	0.19	0.05	0.07	0.07	0.05	0.09
0.01	0.5	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.09
0.01	0.6	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.08
0.01	0.7	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	0.8	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	0.9	0.62	0.57	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	1.0	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	0.1	0.63	0.58	0.61	0.59	0.19	0.05	0.07	0.08	0.05	0.10
0.01	0.2	0.62	0.58	0.60	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.01	0.3	0.62	0.57	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.10
0.01	0.4	0.62	0.57	0.62	0.60	0.19	0.05	0.06	0.08	0.05	0.09
0.01	0.5	0.62	0.57	0.62	0.59	0.19	0.05	0.06	0.07	0.04	0.09
0.01	0.6	0.62	0.57	0.61	0.59	0.18	0.05	0.05	0.07	0.04	0.08
0.01	0.7	0.62	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.08
0.01	0.8	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.01	0.9	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.06	0.04	0.08
0.01	1.0	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.1	0.62	0.58	0.62	0.60	0.19	0.05	0.07	0.07	0.05	0.09
0.02	0.2	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.09
0.02	0.3	0.62	0.58	0.61	0.59	0.19	0.05	0.07	0.07	0.05	0.09
0.02	0.4	0.62	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.05	0.09
0.02	0.5	0.62	0.57	0.62	0.60	0.19	0.05	0.06	0.07	0.04	0.09
0.02	0.6	0.62	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.08
0.02	0.7	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.8	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.9	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	1.0	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.1	0.62	0.56	0.62	0.59	0.19	0.05	0.07	0.07	0.05	0.09
0.02	0.2	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.08	0.05	0.09
0.02	0.3	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.02	0.4	0.62	0.58	0.62	0.60	0.19	0.05	0.06	0.07	0.04	0.08
0.02	0.5	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.6	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.7	0.62	0.58	0.61	0.59	0.19	0.05	0.06	0.07	0.04	0.08
0.02	0.8	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.9	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	1.0	0.62	0.58	0.60	0.59	0.17	0.05	0.06	0.07	0.04	0.07
0.02	0.1	0.62	0.56	0.63	0.60	0.19	0.05	0.07	0.08	0.05	0.09
0.02	0.2	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.02	0.3	0.62	0.57	0.62	0.60	0.19	0.05	0.06	0.08	0.05	0.09
0.02	0.4	0.62	0.57	0.62	0.60	0.19	0.05	0.06	0.07	0.04	0.08
0.02	0.5	0.62	0.57	0.62	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.02	0.6	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.7	0.62	0.57	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.02	0.8	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.02	0.9	0.62	0.58	0.59	0.59	0.17	0.05	0.06	0.07	0.04	0.08
0.02	1.0	0.61	0.57	0.59	0.58	0.17	0.05	0.06	0.06	0.04	0.08
0.03	0.1	0.62	0.55	0.64	0.60	0.19	0.05	0.08	0.08	0.04	0.09
0.03	0.2	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.05	0.09
0.03	0.3	0.62	0.58	0.61	0.60	0.19	0.05	0.06	0.07	0.04	0.09
0.03	0.4	0.62	0.57	0.62	0.60	0.19	0.05	0.06	0.07	0.04	0.09
0.03	0.5	0.62	0.57	0.62	0.59	0.19	0.05	0.06	0.07	0.04	0.09
0.03	0.6	0.62	0.58	0.61	0.59	0.18	0.05	0.06	0.07	0.04	0.09
0.03	0.7	0.62	0.58	0.60	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.03	0.8	0.62	0.58	0.59	0.59	0.18	0.05	0.06	0.07	0.04	0.08
0.03	0.9	0.61	0.58	0.59	0.58	0.17	0.05	0.06	0.06	0.04	0.08
0.03	1.0	0.61	0.58	0.58	0.58	0.16	0.05	0.06	0.07	0.04	0.07

grafico_confusion(modelo_svm,train_xgboost,test_xgboost)

grafico_roc(modelo_svm,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.6618

plot(varImp(modelo_svm))

resultados(modelo_rf)

## [1] "Mejores hiperparámetros:"
##   mtry
## 1    1

mtry	ROC	Sens	Spec	Accuracy	Kappa	ROCSD	SensSD	SpecSD	AccuracySD	KappaSD
1	0.63	0.63	0.58	0.60	0.21	0.05	0.07	0.07	0.04	0.08
2	0.63	0.61	0.57	0.59	0.18	0.04	0.07	0.08	0.03	0.07
3	0.62	0.61	0.57	0.59	0.18	0.04	0.07	0.07	0.04	0.08
4	0.62	0.60	0.57	0.59	0.17	0.04	0.07	0.07	0.05	0.09
5	0.62	0.60	0.57	0.59	0.18	0.04	0.06	0.06	0.04	0.08
6	0.62	0.60	0.57	0.59	0.17	0.04	0.06	0.07	0.04	0.08
7	0.62	0.60	0.57	0.58	0.17	0.04	0.06	0.07	0.04	0.08
8	0.61	0.60	0.57	0.58	0.17	0.04	0.06	0.07	0.04	0.09
9	0.61	0.60	0.58	0.59	0.17	0.04	0.06	0.07	0.04	0.08
10	0.61	0.59	0.58	0.59	0.17	0.04	0.06	0.06	0.04	0.09
11	0.61	0.59	0.57	0.58	0.16	0.04	0.06	0.07	0.04	0.08
12	0.61	0.59	0.57	0.58	0.16	0.04	0.06	0.06	0.04	0.08
13	0.61	0.58	0.58	0.58	0.16	0.04	0.06	0.07	0.04	0.08
14	0.61	0.58	0.58	0.58	0.16	0.04	0.07	0.07	0.05	0.09
15	0.60	0.59	0.58	0.58	0.16	0.04	0.06	0.07	0.04	0.08
16	0.61	0.59	0.58	0.58	0.16	0.04	0.07	0.06	0.04	0.09
17	0.60	0.58	0.58	0.58	0.16	0.04	0.06	0.07	0.04	0.08
18	0.60	0.58	0.58	0.58	0.16	0.04	0.06	0.06	0.04	0.08
19	0.60	0.58	0.57	0.58	0.15	0.04	0.06	0.06	0.04	0.08
20	0.60	0.57	0.58	0.58	0.15	0.04	0.06	0.07	0.04	0.08
21	0.60	0.58	0.58	0.58	0.15	0.04	0.06	0.07	0.04	0.08
22	0.60	0.58	0.58	0.58	0.16	0.04	0.06	0.06	0.04	0.07
23	0.60	0.58	0.57	0.57	0.15	0.04	0.06	0.07	0.04	0.07
24	0.60	0.57	0.57	0.57	0.15	0.04	0.06	0.06	0.04	0.08
25	0.60	0.57	0.57	0.57	0.15	0.04	0.06	0.06	0.04	0.08
26	0.60	0.57	0.57	0.57	0.15	0.04	0.06	0.07	0.04	0.08
27	0.60	0.57	0.57	0.57	0.14	0.04	0.07	0.06	0.04	0.08

grafico_confusion(modelo_rf,train_xgboost,test_xgboost)

grafico_roc(modelo_rf,train_xgboost,test_xgboost)

## 
## Call:
## roc.default(response = datos_train$y, predictor = pred_prob_train[,     "Sí"])
## 
## Data: pred_prob_train[, "Sí"] in 544 controls (datos_train$y Sí) > 544 cases (datos_train$y No).
## Area under the curve: 0.8049

plot(varImp(modelo_rf))

Respecto al modelo SVM de base radial, obtenemos un AUC de test del 63,1%. Los mejores valores para los hiperparámetros son de 0,0025 para sigma y 0,2 para el parámetro de penalización C. Respecto a la importancia de las variables, las más importantes son los ingresos, la edad y el tiempo que lleva la persona en el domicilio y trabajo actual.
Respecto al modelo Random Forest, obtenemos un AUC de test del 63,8%. El número óptimo de variables seleccionadas en cada árbol (mtry) es 1. Las variables más importantes son las mismas que para el modelo SVM.

3 TAREA3: COMPARACIÓN DE MODELOS

Vamos a comparar los resultados de todos los modelos anteriores. La siguiente tabla muestra los resultados de todos los modelos ordenados de mayor a menor ROC de test:

modelos<-list(fitted.nb2,fitted.tan2,fitted.tanhc2,fitted.aode2,modelo_xgboost,modelo_xgboost2,modelo_xgboost3,modelo_xgboost4,modelo_xgboost5,modelo_svm,modelo_rf)

tabla_comp<-tabla_comparativa(modelos) %>%
  mutate(Modelo=c("NB","TAN","TANHC","AODE","XGB1","XGB2","XGB3","XGB4","XGB5","SVM","RF"),ROC) %>%
  arrange(desc(ROC_Test)) %>%
  mutate(ROC=str_sub(ROC,end=6),Sens=str_sub(Sens,end=6),Spec=str_sub(Spec,end=6),Accuracy=str_sub(Accuracy,end=6),
         Kappa=str_sub(Kappa,end=6),ROC_Test=str_sub(ROC_Test,end=6))
tabla_comp

Modelo	ROC	Sens	Spec	Accuracy	Kappa	ROC_Test
XGB4	0.6316	0.5940	0.6107	0.6024	0.2048	0.6511
XGB5	0.6328	0.5922	0.6080	0.6001	0.2002	0.6493
AODE	0.6339	0.6098	0.5872	0.5984	0.1970	0.6483
XGB1	0.6259	0.5822	0.6110	0.5966	0.1932	0.6408
TANHC	0.6404	0.6330	0.5793	0.6062	0.2123	0.6398
NB	0.6402	0.6375	0.5836	0.6105	0.2211	0.6393
RF	0.6340	0.6278	0.5808	0.6044	0.2087	0.6378
XGB3	0.6317	0.5849	0.6081	0.5965	0.1930	0.6353
TAN	0.6246	0.5849	0.5854	0.5853	0.1704	0.6346
XGB2	0.6274	0.5867	0.6025	0.5946	0.1892	0.6322
SVM	0.6284	0.5921	0.6062	0.5992	0.1984	0.6305

Como se puede observar, los mejores modelos son los dos últimos de XGBoost estimados y, en tercer lugar, el modelo AODE. Si nuestro criterio principal para escoger el modelo fuera la sensibilidad porque nos interesa un mayor porcentaje de acierto en la identificación de aquellas personas que sí responderán, los mejores modelos serían el Naive Bayes y el modelo TAN Hill Climbing, seguidos del Random Forest.

modelos <- list(NB=fitted.nb2,TAN=fitted.tan2,TANHC=fitted.tanhc2,AODE= fitted.aode2,
                XGB1=modelo_xgboost,XGB2=modelo_xgboost2,XGB3=modelo_xgboost3,XGB4=modelo_xgboost4,
                XGB5=modelo_xgboost5,RF = modelo_rf, SVM = modelo_svm)
resultados <- resamples(modelos)
resultados

## 
## Call:
## resamples.default(x = modelos)
## 
## Models: NB, TAN, TANHC, AODE, XGB1, XGB2, XGB3, XGB4, XGB5, RF, SVM 
## Number of resamples: 50 
## Performance metrics: Accuracy, Kappa, ROC, Sens, Spec 
## Time estimates for: everything, final model fit

summary(resultados)[3]

## $statistics
## $statistics$Accuracy
##            Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## NB    0.4954128 0.5842890 0.6164304 0.6105441 0.6374235 0.6880734    0
## TAN   0.4818182 0.5606339 0.5833333 0.5853091 0.6146789 0.6972477    0
## TANHC 0.5000000 0.5821970 0.6018519 0.6062442 0.6422018 0.7222222    0
## AODE  0.5137615 0.5658129 0.5925926 0.5984865 0.6137870 0.6972477    0
## XGB1  0.4678899 0.5773445 0.6036782 0.5966811 0.6203704 0.6727273    0
## XGB2  0.5045872 0.5596330 0.5890325 0.5946106 0.6315888 0.6788991    0
## XGB3  0.4907407 0.5609285 0.6036782 0.5965284 0.6273148 0.6972477    0
## XGB4  0.4220183 0.5688073 0.6055046 0.6024050 0.6382576 0.7000000    0
## XGB5  0.4954128 0.5688073 0.5944614 0.6001359 0.6264178 0.7247706    0
## RF    0.5137615 0.5789408 0.6072977 0.6044888 0.6296296 0.6759259    0
## SVM   0.4537037 0.5648148 0.5898743 0.5992817 0.6466616 0.6944444    0
## 
## $statistics$Kappa
##               Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## NB    -0.009089379 0.1685954 0.2339925 0.2211851 0.2752016 0.3765141    0
## TAN   -0.036363636 0.1207670 0.1666667 0.1704547 0.2290331 0.3947501    0
## TANHC  0.000000000 0.1643939 0.2037037 0.2123963 0.2844037 0.4444444    0
## AODE   0.026949638 0.1317891 0.1851852 0.1970236 0.2277198 0.3939343    0
## XGB1  -0.064309764 0.1545674 0.2067246 0.1932973 0.2407407 0.3454545    0
## XGB2   0.009090909 0.1192656 0.1786549 0.1892907 0.2625747 0.3582843    0
## XGB3  -0.018518519 0.1215788 0.2067246 0.1930532 0.2546296 0.3937300    0
## XGB4  -0.154699849 0.1360870 0.2102779 0.2048024 0.2765152 0.4000000    0
## XGB5  -0.009769244 0.1372515 0.1887529 0.2002874 0.2531675 0.4485666    0
## RF     0.026949638 0.1582543 0.2131625 0.2087899 0.2592593 0.3518519    0
## SVM   -0.092592593 0.1296296 0.1799222 0.1984392 0.2932177 0.3888889    0
## 
## $statistics$ROC
##            Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## NB    0.4902357 0.5986906 0.6500000 0.6402823 0.6772493 0.7407407    0
## TAN   0.5245199 0.5973282 0.6197718 0.6246121 0.6511496 0.7352538    0
## TANHC 0.4883402 0.6009493 0.6413518 0.6404842 0.6913315 0.7705761    0
## AODE  0.5222222 0.6041532 0.6298136 0.6339363 0.6614369 0.7434343    0
## XGB1  0.4543771 0.5967302 0.6276094 0.6259726 0.6618032 0.7365289    0
## XGB2  0.4994949 0.5856318 0.6349124 0.6274702 0.6764169 0.7188552    0
## XGB3  0.5408264 0.5885435 0.6314908 0.6317594 0.6651194 0.7318244    0
## XGB4  0.4124579 0.5988543 0.6373737 0.6316109 0.6751169 0.7199931    0
## XGB5  0.5361953 0.6045603 0.6252525 0.6328559 0.6587749 0.7111111    0
## RF    0.4755892 0.6144781 0.6354545 0.6340085 0.6636606 0.7336700    0
## SVM   0.4787380 0.5880518 0.6335734 0.6284506 0.6611953 0.7319865    0
## 
## $statistics$Sens
##            Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## NB    0.4629630 0.6111111 0.6363636 0.6375758 0.6727273 0.7777778    0
## TAN   0.4074074 0.5370370 0.5925926 0.5849697 0.6296296 0.7222222    0
## TANHC 0.4629630 0.5845118 0.6363636 0.6330168 0.6851852 0.7962963    0
## AODE  0.4629630 0.5740741 0.6111111 0.6098047 0.6481481 0.7454545    0
## XGB1  0.4000000 0.5391414 0.5962963 0.5822424 0.6296296 0.7090909    0
## XGB2  0.4074074 0.5454545 0.5925926 0.5867205 0.6296296 0.7222222    0
## XGB3  0.4545455 0.5555556 0.5818182 0.5849091 0.6296296 0.7090909    0
## XGB4  0.4074074 0.5231481 0.5962963 0.5940943 0.6620370 0.7818182    0
## XGB5  0.4629630 0.5479798 0.6000000 0.5922761 0.6296296 0.7272727    0
## RF    0.5000000 0.5575758 0.6329966 0.6278990 0.6820707 0.8000000    0
## SVM   0.4363636 0.5391414 0.5925926 0.5921953 0.6481481 0.7272727    0
## 
## $statistics$Spec
##            Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## NB    0.4545455 0.5391414 0.5925926 0.5836364 0.6111111 0.7222222    0
## TAN   0.4545455 0.5370370 0.5740741 0.5854680 0.6435185 0.7222222    0
## TANHC 0.3888889 0.5370370 0.5925926 0.5793737 0.6181818 0.7090909    0
## AODE  0.4629630 0.5454545 0.5818182 0.5872391 0.6318182 0.7407407    0
## XGB1  0.4545455 0.5818182 0.6181818 0.6110438 0.6481481 0.7272727    0
## XGB2  0.4814815 0.5662458 0.6055556 0.6025859 0.6481481 0.7272727    0
## XGB3  0.4181818 0.5416667 0.6111111 0.6081616 0.6666667 0.7818182    0
## XGB4  0.3636364 0.5636364 0.6111111 0.6107071 0.6636364 0.7636364    0
## XGB5  0.4814815 0.5636364 0.6111111 0.6080135 0.6545455 0.8181818    0
## RF    0.4074074 0.5370370 0.5872054 0.5808552 0.6267677 0.7592593    0
## SVM   0.3703704 0.5636364 0.6146465 0.6062088 0.6636364 0.7777778    0

dotplot(resultados)

diferencias <- diff(resultados)
summary(diferencias)

## 
## Call:
## summary.diff.resamples(object = diferencias)
## 
## p-value adjustment: bonferroni 
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
## 
## Accuracy 
##       NB     TAN        TANHC      AODE       XGB1       XGB2       XGB3      
## NB            0.0252349  0.0042998  0.0120575  0.0138630  0.0159335  0.0140157
## TAN   0.1539            -0.0209351 -0.0131774 -0.0113719 -0.0093014 -0.0112193
## TANHC 1.0000 0.8494                 0.0077577  0.0095632  0.0116337  0.0097158
## AODE  1.0000 1.0000     1.0000                 0.0018055  0.0038760  0.0019581
## XGB1  1.0000 1.0000     1.0000     1.0000                 0.0020705  0.0001526
## XGB2  1.0000 1.0000     1.0000     1.0000     1.0000                -0.0019179
## XGB3  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000               
## XGB4  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## XGB5  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## RF    1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## SVM   1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
##       XGB4       XGB5       RF         SVM       
## NB     0.0081391  0.0104082  0.0060553  0.0112624
## TAN   -0.0170958 -0.0148267 -0.0191797 -0.0139725
## TANHC  0.0038393  0.0061084  0.0017554  0.0069626
## AODE  -0.0039184 -0.0016493 -0.0060023 -0.0007951
## XGB1  -0.0057239 -0.0034548 -0.0078078 -0.0026006
## XGB2  -0.0077944 -0.0055253 -0.0098783 -0.0046711
## XGB3  -0.0058765 -0.0036074 -0.0079604 -0.0027533
## XGB4              0.0022691 -0.0020839  0.0031233
## XGB5  1.0000                -0.0043530  0.0008542
## RF    1.0000     1.0000                 0.0052071
## SVM   1.0000     1.0000     1.0000               
## 
## Kappa 
##       NB     TAN       TANHC     AODE      XGB1      XGB2      XGB3     
## NB            0.050730  0.008789  0.024162  0.027888  0.031894  0.028132
## TAN   0.1457           -0.041942 -0.026569 -0.022843 -0.018836 -0.022599
## TANHC 1.0000 0.8460               0.015373  0.019099  0.023106  0.019343
## AODE  1.0000 1.0000    1.0000               0.003726  0.007733  0.003970
## XGB1  1.0000 1.0000    1.0000    1.0000               0.004007  0.000244
## XGB2  1.0000 1.0000    1.0000    1.0000    1.0000              -0.003763
## XGB3  1.0000 1.0000    1.0000    1.0000    1.0000    1.0000             
## XGB4  1.0000 1.0000    1.0000    1.0000    1.0000    1.0000    1.0000   
## XGB5  1.0000 1.0000    1.0000    1.0000    1.0000    1.0000    1.0000   
## RF    1.0000 1.0000    1.0000    1.0000    1.0000    1.0000    1.0000   
## SVM   1.0000 1.0000    1.0000    1.0000    1.0000    1.0000    1.0000   
##       XGB4      XGB5      RF        SVM      
## NB     0.016383  0.020898  0.012395  0.022746
## TAN   -0.034348 -0.029833 -0.038335 -0.027984
## TANHC  0.007594  0.012109  0.003606  0.013957
## AODE  -0.007779 -0.003264 -0.011766 -0.001416
## XGB1  -0.011505 -0.006990 -0.015493 -0.005142
## XGB2  -0.015512 -0.010997 -0.019499 -0.009149
## XGB3  -0.011749 -0.007234 -0.015737 -0.005386
## XGB4             0.004515 -0.003988  0.006363
## XGB5  1.0000              -0.008503  0.001848
## RF    1.0000    1.0000               0.010351
## SVM   1.0000    1.0000    1.0000             
## 
## ROC 
##       NB TAN        TANHC      AODE       XGB1       XGB2       XGB3      
## NB        0.0156702 -0.0002020  0.0063459  0.0143097  0.0128120  0.0085229
## TAN   1             -0.0158722 -0.0093243 -0.0013605 -0.0028582 -0.0071473
## TANHC 1  1                      0.0065479  0.0145117  0.0130140  0.0087249
## AODE  1  1          1                      0.0079638  0.0064661  0.0021770
## XGB1  1  1          1          1                     -0.0014977 -0.0057868
## XGB2  1  1          1          1          1                     -0.0042891
## XGB3  1  1          1          1          1          1                    
## XGB4  1  1          1          1          1          1          1         
## XGB5  1  1          1          1          1          1          1         
## RF    1  1          1          1          1          1          1         
## SVM   1  1          1          1          1          1          1         
##       XGB4       XGB5       RF         SVM       
## NB     0.0086714  0.0074264  0.0062737  0.0118317
## TAN   -0.0069988 -0.0082438 -0.0093965 -0.0038385
## TANHC  0.0088734  0.0076284  0.0064757  0.0120336
## AODE   0.0023255  0.0010805 -0.0000722  0.0054858
## XGB1  -0.0056383 -0.0068833 -0.0080360 -0.0024780
## XGB2  -0.0041406 -0.0053856 -0.0065383 -0.0009804
## XGB3   0.0001485 -0.0010965 -0.0022492  0.0033088
## XGB4             -0.0012450 -0.0023977  0.0031603
## XGB5  1                     -0.0011527  0.0044053
## RF    1          1                      0.0055580
## SVM   1          1          1                    
## 
## Sens 
##       NB       TAN        TANHC      AODE       XGB1       XGB2      
## NB              5.261e-02  4.559e-03  2.777e-02  5.533e-02  5.086e-02
## TAN   0.001741            -4.805e-02 -2.484e-02  2.727e-03 -1.751e-03
## TANHC 1.000000 0.052667               2.321e-02  5.077e-02  4.630e-02
## AODE  1.000000 1.000000   1.000000               2.756e-02  2.308e-02
## XGB1  0.005370 1.000000   0.057457   1.000000              -4.478e-03
## XGB2  0.015783 1.000000   0.224316   1.000000   1.000000             
## XGB3  0.004859 1.000000   0.041312   1.000000   1.000000   1.000000  
## XGB4  0.174198 1.000000   0.337673   1.000000   1.000000   1.000000  
## XGB5  0.109888 1.000000   0.054445   1.000000   1.000000   1.000000  
## RF    1.000000 0.287616   1.000000   1.000000   0.136073   0.247898  
## SVM   0.045670 1.000000   0.452425   1.000000   1.000000   1.000000  
##       XGB3       XGB4       XGB5       RF         SVM       
## NB     5.267e-02  4.348e-02  4.530e-02  9.677e-03  4.538e-02
## TAN    6.061e-05 -9.125e-03 -7.306e-03 -4.293e-02 -7.226e-03
## TANHC  4.811e-02  3.892e-02  4.074e-02  5.118e-03  4.082e-02
## AODE   2.490e-02  1.571e-02  1.753e-02 -1.809e-02  1.761e-02
## XGB1  -2.667e-03 -1.185e-02 -1.003e-02 -4.566e-02 -9.953e-03
## XGB2   1.811e-03 -7.374e-03 -5.556e-03 -4.118e-02 -5.475e-03
## XGB3             -9.185e-03 -7.367e-03 -4.299e-02 -7.286e-03
## XGB4  1.000000               1.818e-03 -3.380e-02  1.899e-03
## XGB5  1.000000   1.000000              -3.562e-02  8.081e-05
## RF    0.127686   1.000000   0.956780               3.570e-02
## SVM   1.000000   1.000000   1.000000   0.377465             
## 
## Spec 
##       NB     TAN        TANHC      AODE       XGB1       XGB2       XGB3      
## NB           -0.0018316  0.0042626 -0.0036027 -0.0274074 -0.0189495 -0.0245253
## TAN   1.0000             0.0060943 -0.0017710 -0.0255758 -0.0171178 -0.0226936
## TANHC 1.0000 1.0000                -0.0078653 -0.0316700 -0.0232121 -0.0287879
## AODE  1.0000 1.0000     1.0000                -0.0238047 -0.0153468 -0.0209226
## XGB1  1.0000 1.0000     0.9942     1.0000                 0.0084579  0.0028822
## XGB2  1.0000 1.0000     1.0000     1.0000     1.0000                -0.0055758
## XGB3  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000               
## XGB4  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## XGB5  1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## RF    1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
## SVM   1.0000 1.0000     1.0000     1.0000     1.0000     1.0000     1.0000    
##       XGB4       XGB5       RF         SVM       
## NB    -0.0270707 -0.0243771  0.0027811 -0.0225724
## TAN   -0.0252391 -0.0225455  0.0046128 -0.0207407
## TANHC -0.0313333 -0.0286397 -0.0014815 -0.0268350
## AODE  -0.0234680 -0.0207744  0.0063838 -0.0189697
## XGB1   0.0003367  0.0030303  0.0301886  0.0048350
## XGB2  -0.0081212 -0.0054276  0.0217306 -0.0036229
## XGB3  -0.0025455  0.0001481  0.0273064  0.0019529
## XGB4              0.0026936  0.0298519  0.0044983
## XGB5  1.0000                 0.0271582  0.0018047
## RF    1.0000     1.0000                -0.0253535
## SVM   1.0000     1.0000     1.0000

En función de la curva ROC de test, todos los modelos son estadísticamente iguales, ya que aunque tienen valores de ROC distintos, su variabilidad hace que no sean estadísticamente diferentes.
Si nos fijamos en la sensibilidad sí que existen diferencias estadísticamente significativas entre algunos modelos. En concreto respecto de los modelos que ya hemos comentado que tienen un valor más alto de esta medida(Naive Bayes, TAN Hill Climbing y Random Forest).

4 CONCLUSIONES

En base al trabajo desarrollado podemos concluir lo siguiente:

Si bien es cierto que los mejores modelos según la curva ROC de test son el XGB4, XGB5 y AODE, los test estadísticos nos indican que no son significativamente diferentes del resto. Por otro lado, teniendo en cuenta que el coste de no identificar un cliente que potencialmente contestaría a la oferta es mayor que el coste de enviar una oferta comercial a una persona que realmente no está interesada, parece más oportuno fijarnos en el valor de la sensibilidad. A este respecto el mejor modelo es el Naive Bayes, con una sensibilidad del 63,75%, por lo que este será el modelo escogido.
En vista de la imoprtancia de las variables de los diferentes modelos, se puede decir que la más importante son los ingresos. Otras variables que también son importantes son el nivel educativo, estar o no suscrito a un peródico o la edad.
Respecto al rendimiento de los modelos también podemos decir que todos mejoran el modelo “tonto” que precice todas las observaciones como pertenecientes a una única clase (50% de accuracy). Por tanto, la utilización de uno de estos modelos para el problema planteado sería adecuado.

5 ANEXO: MODELOS Y FUNCIONES EMPLEADAS

5.1 Modelo TAN Hill Climbing

modeloTANHC <- list(label = "Hill Climbing Tree Augmented Naive Bayes Classifier",
                  library = "bnclassify",
                  type = "Classification",
                  parameters = data.frame( parameter = c("smooth"),
                                           class = c("numeric"),
                                           label = c("Smoothing Parameter")),
                  # Funciones
                  grid = function( x, y, len = NULL, search = "grid" ) {
                    if( search == "grid" ) { 
                      out <- expand.grid(smooth = 0:( len - 1 ) )
                    } else {
                      out <- data.frame( smooth= runif( len, min = 0, max = 10 ), 
                                         size = len, 
                                         replace = TRUE )
                    }
                    out
                  },
                  loop = NULL,
                  fit = function( x, y, wts, param, lev, last, classProbs, ... ) {
                    dat <- if( is.data.frame( x ) ) x else as.data.frame( x )
                    bnclassify::bnc( 'tan_hc', 'y', x, 5, smooth = param$smooth )
                  },
                  predict = function( modelFit, newdata, submodels = NULL ) {
                    if( !is.data.frame( newdata ) ) newdata <- as.data.frame( newdata )
                    predict( modelFit, newdata )       
                  },
                  prob = function( modelFit, newdata, submodels = NULL ) {
                    if( !is.data.frame( newdata ) ) newdata <- as.data.frame( newdata )
                    predict( modelFit, newdata, prob = TRUE ) 
                  },
                  levels = function( x ) x$obsLevels,
                  predictors = function( x, s = NULL, ... ) x$xNames,
                  tags = c( "Bayesian Model TAN HC", "Categorical Predictors Only" ),
                  sort = function( x ) x[ order( x[ , 1] ) , ] )

5.2 Modelo AODE

modeloAODE <- list(label = "AODE Naive Bayes Classifier",
                            library = "bnclassify",
                            type = "Classification",
                            parameters = data.frame( parameter = c( "smooth" ),
                                                     class = c( "numeric" ),
                                                     label = c( "Smoothing Parameter" ) ),
                            grid = function( x, y, len = NULL, search = "grid" ) {
                              if( search == "grid" ) { 
                                out <- expand.grid( smooth = 0:( len - 1 ) )
                              } else {
                                out <- data.frame( smooth = runif( len, min = 0, max = 10 ),
                                                   size = len, 
                                                   replace = TRUE )
                              }
                              out
                            },
                            loop = NULL,
                            fit = function( x, y, wts, param, lev, last, classProbs, ... ) {
                              dat <- if( is.data.frame( x ) ) x else as.data.frame( x )
                              bnclassify::bnc( 'aode', 'y', x, smooth = param$smooth )
                            },
                            predict = function( modelFit, newdata, submodels = NULL ) {
                              if(!is.data.frame( newdata ) ) newdata <- as.data.frame( newdata )
                              predict( modelFit, newdata )       
                            },
                            prob = function(modelFit, newdata, submodels = NULL) {
                              if(!is.data.frame(newdata)) newdata <- as.data.frame(newdata)
                              predict( modelFit, newdata, prob = TRUE ) 
                            },
                            levels = function( x ) x$obsLevels,
                            predictors = function( x, s = NULL, ... ) x$xNames,
                            tags = c( "Bayesian Model AODE", "Categorical Predictors Only"),
                            sort = function( x ) x[ order( x[ , 1] ), ] )

5.3 Función conversión: convierte variables categóricas en numéricas

conversion <- function( DF ) {
  
  resultado <- NULL
  matriz <- NULL
  
  for ( j in 1:length( DF ) ) {
    matriz <- disjunctive( DF[ ,c( j ) ] )
    colnames( matriz ) <- paste0( colnames( DF[ j ] ), ".", levels( DF[ , c( j ) ] ) )
    resultado <- cbind( resultado, matriz )
  }
  return( resultado )
}

6 Función resultados: devuelve los resultados de un modelo entrenado

resultados<-function (modelo){
  
  print("Mejores hiperparámetros:")
  print(modelo$bestTune)
  
  tabla<-as.data.frame(modelo$results) %>% mutate_if(is.numeric, ~round(.x,2)) %>% formattable
  
return(tabla)  
}

6.1 Función grafico_confusion: devuelve los gráficos de las matrices de confusión de entrenamiento y test

grafico_confusion<-function(modelo,datos_train,datos_test){

# Matriz de confusión de test
pred_train <- predict(modelo,datos_train )
mat_conf_train<-confusionMatrix( pred_train, datos_train$y )
g1<-autoplot(conf_mat(mat_conf_train$table), type="heatmap") +
  scale_fill_gradient(low = "white", high = "steelblue")+
  labs(title= "Matriz de confusión: entrenamiento")

# Matriz de confusión de test
pred_test <- predict( modelo, datos_test )
mat_conf_test<-confusionMatrix( pred_test, datos_test$y )
g2<-autoplot(conf_mat(mat_conf_test$table), type="heatmap") +
  scale_fill_gradient(low = "white", high = "steelblue")+
  labs(title= "Matriz de confusión: test")

(g1/g2)

}

6.2 Función grafico_roc: crea el gráfico de las curvas ROC de entrenamiento y validación

grafico_roc<-function(modelo,datos_train,datos_test){
  
# ROC de entrenamiento
pred_prob_train <- predict(modelo, datos_train, type="prob")
roc_train <- roc(datos_train$y,pred_prob_train[,"Sí"])

# ROC de test
pred_prob_test <- predict(modelo, datos_test, type="prob")
roc_test <- roc(datos_test$y,pred_prob_test[,"Sí"])  
  
  
  
   p1<-plot(roc_train,
          col = "red",
          print.auc = TRUE,
          print.auc.x = 1,
          print.auc.y = 1, 
          xlim = c(1,0),
          ylim = c(0,1),
          xlab = "Especifidad", 
          ylab ="Sensibilidad", 
          main = "Curva de ROC")
    p2<-plot(roc_test, print.auc = TRUE,
          print.auc.x = 1,
          print.auc.y = 0.9,col="blue", add=TRUE)
     legend("bottomright", legend = c("Entrenamiento", "Validacion"), col = c("red", "blue"), lwd = 2)
  
    polygon(with(p1, cbind(specificities, sensitivities)), 
        col = rgb(.61,0.31,0.25, alpha = 0.4), 
        border = "red",
        lwd = 2)
    polygon(with(p2, cbind(specificities, sensitivities)), 
        col = rgb(.25,0.31,0.61, alpha = 0.4), 
        border = "blue",
        lwd = 2)
  return(p1)

}

6.3 Función grafico_densidad: crea el gráfico de densidad de una variable por cada categoría de la variable objetivo

grafico_densidad<-function(df,x,y,p=1){ # El parámetro p sirve para filtrar los datos eliminando las observaciones
                                        # con un valor de la variable x mayor que dicho percentil. Si no se especifica
  variable<-df[,x]                      # no  se realiza ningún filtrado (p=1). De esta forma, eliminamos outliers.
   cuantil<-quantile(variable,p)         

  x<-as.symbol(x)
  y<-as.symbol(y)
 
  dfnew <- df %>%
    filter(!!x <= cuantil)
 
  gr <- ggplot( dfnew) +
    geom_density(aes(x = !!x,fill=!!y),alpha = 0.6) +
    labs(title = paste("Variable ",x))+
    theme_bw()
 
  return(gr)
 
}

6.4 Función grafico_dispersion: crea un gráfico de dispersión entre dos variables numéricas

grafico_dispersion<-function(df,x,y,p=1){
  variable1<-df[,x]
  variable2<-df[,y]
  cuantil1<-quantile(variable1,p)
  cuantil2<-quantile(variable2,p)
  
  x<-as.symbol(x)
  y<-as.symbol(y)
 
  dfnew <- df %>%
    filter(!!x <= cuantil1 & !!y <= cuantil2)
 
  gr <- ggplot( dfnew ,aes(!!x,!!y) ) +
    geom_point(alpha = 0.25) +
    geom_smooth(method = "loess") +
    labs(title = paste("Variables ",x,"y ",y))+
    theme_bw()
 
  return(gr)
}

6.5 Función tabla_comparativa: crea una tabla comparativa con diferentes métricas de los modelos entrenados

tabla_comparativa <- function ( modelos ){
  n_modelos = length(modelos)
  comparativa <- matrix(0, n_modelos, 7)
  pred <- NULL

  for (i in 1:n_modelos){
    
      comparativa[i,1] = modelos[[i]]$method
      comparativa[i,2] = modelos[[i]]$results[rownames(modelos[[i]]$bestTune), c("ROC")] %>% as.numeric()
      comparativa[i,3] = modelos[[i]]$results[rownames(modelos[[i]]$bestTune), c("Sens")] %>% as.numeric()
      comparativa[i,4] = modelos[[i]]$results[rownames(modelos[[i]]$bestTune), c("Spec")] %>% as.numeric()
      comparativa[i,5] = modelos[[i]]$results[rownames(modelos[[i]]$bestTune), c("Accuracy")] %>% as.numeric()
      comparativa[i,6] = modelos[[i]]$results[rownames(modelos[[i]]$bestTune), c("Kappa")] %>% as.numeric()
      
    if(modelos[[i]]$method %in% c("xgbTree","rf","svmRadial")){
      pred[[i]] <- predict(modelos[i], test_xgboost, type="prob")
      comparativa[i,7] = auc(roc(test_xgboost$y,pred[[i]][[1]][,"Sí"]))  }
    else {
      pred[[i]] <- predict(modelos[i], test_bayes, type="prob")
      comparativa[i,7] = auc(roc(test_xgboost$y,pred[[i]][[1]][,"Sí"]))  }
  }
  
  colnames(comparativa) <- c("Modelo", "ROC", "Sens", "Spec", "Accuracy", "Kappa", "ROC_Test")
  comparativa<-as.data.frame(comparativa) %>% formattable()
  
  return(comparativa)
}

Resolución ejercicio1 Minería II

Borja Macías

12/9/2021