ACT_2_A01275655

library(dplyr)
library(ggplot2)
library(corrplot)
library(car)
library(lmtest)
library(lattice)
library(xgboost)
library(rpart)
library(randomForest)
library(neuralnet)
library(psych)
library(corrplot)
library(pROC)
library(rpart)
library(rpart.plot)
library(e1071)
library(purrr)
library(factoextra)
library(class)
library(vcd)

1. Preguntas

a) ¿Qué es Supervised Machine Learning y cuáles son algunas de sus aplicaciones en análisis de clasificación?

El SML es una rama de Machine Learning que funciona con datos etiquetados, es decir que nosotros ya conocemos la variable dependiente y se la hacemos saber al modelo que vamos a entrenar
Algunas de sus aplicaciones REALES dentro de la clasificación son:
* Análisis de sentimientos con el fin de analizar la experiencia de los usuarios o clientes.
* Detección de fraudes común en industrias como la bancaria pues busca identificar actividades irregulares que pudieran ser fraudulentas
* Segmentación de clientes con el fin de segmentar de manera homogenea a un grupo de clientes dependiendo de sus características en común y así poder dirigir campañas de marketing u otras estratégias de venta personalizadas.

b) Respecto a la selección de los resultados de los modelos de clasificación ¿Qué es la matriz de confusión? ¿Qué es el estadístico Kappa? ¿Cuál es la relación entre AUC y ROC Curve?

• Matriz de confusión: es una tabla que usamos en clasificación para medir el desempeño en general de un modelo pues en escencia se dedica a comparar los datos reales contra los predichos en el modelo y de ella podemos obtener métricas como el accuracy o Specificity con las cuales podemos evaluar que tan bueno es el modelo.
  
• Kappa: es un estadístico que nos ayuda a entender la concordancia de las predicciones (recordemos que la concordancia es simplemente saber en cuánto coinciden las predicciones de un modelo con la realidad en un rango de -1 a 1) y es muy útil ya que un valor cercano a 1 nos indica una alta efectividad en las predicciones.
  
• Relación entre ROC y AUC: la curva ROC muestra la relación entre la sensibilidad y especificidad del modelo, es decir su capacidad de distinguir los verdaderos positivos y los falsos positivos, mientras más cercana se encuentre a la esquina izquierda superior entonces el AUC será mayor la cual es como su nombre lo dice, el área de bajo de la curva y entre más cercano sea su valor a 1 entonces sabremos que el modelo tiene un mejor rendimiento

2. Análisis Exploratorio de los Datos (EDA)

Importación base de datos

df<- read.csv("C:\\Users\\LuisD\\Documents\\Concentración\\MODULO 3\\bank_marketing_strategy.csv")
#file.choose()
df_numeric<- df

df_numeric$job <- as.numeric(factor(df_numeric$job, levels = c("admin.","unknown","unemployed","management","housemaid","entrepreneur","student", "blue-collar","self-employed","retired","technician","services"), labels = c(1,2,3,4,5,6,7,8,9,10,11,12)))
df_numeric$marital <- as.numeric(factor(df_numeric$marital, levels=c("married","divorced","single"), labels=c(1,2,3)))
df_numeric$education <- as.numeric(factor(df_numeric$education, levels=c("unknown","secondary","primary","tertiary"), labels=c(1,2,3,4)))
df_numeric$default <- as.numeric(factor(df_numeric$default, levels=c("yes","no"), labels=c(1,2)))
df_numeric$housing <- as.numeric(factor(df_numeric$housing, levels=c("yes","no"), labels=c(1,2)))
df_numeric$loan <- as.numeric(factor(df_numeric$loan, levels=c("yes","no"), labels=c(1,2)))
df_numeric$contact <- as.numeric(factor(df_numeric$contact, levels=c("unknown","telephone","cellular"), labels=c(1,2,3)))
df_numeric$month <- as.numeric(factor(df_numeric$month, levels=c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"), labels=c(1,2,3,4,5,6,7,8,9,10,11,12)))
df_numeric$poutcome <- as.numeric(factor(df_numeric$poutcome, levels=c("unknown","other","failure","success"), labels=c(1,2,3,4)))
str(df_numeric)

## 'data.frame':    45211 obs. of  17 variables:
##  $ age      : int  58 44 33 47 33 35 28 42 58 43 ...
##  $ job      : num  4 11 6 8 2 4 4 6 10 11 ...
##  $ marital  : num  1 3 1 1 3 1 3 2 1 3 ...
##  $ education: num  4 2 2 1 1 4 4 4 3 2 ...
##  $ default  : num  2 2 2 2 2 2 2 1 2 2 ...
##  $ balance  : int  2143 29 2 1506 1 231 447 2 121 593 ...
##  $ housing  : num  1 1 1 1 2 1 1 1 1 1 ...
##  $ loan     : num  2 2 1 2 2 2 1 2 2 2 ...
##  $ contact  : num  1 1 1 1 1 1 1 1 1 1 ...
##  $ day      : int  5 5 5 5 5 5 5 5 5 5 ...
##  $ month    : num  5 5 5 5 5 5 5 5 5 5 ...
##  $ duration : int  261 151 76 92 198 139 217 380 50 55 ...
##  $ campaign : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ pdays    : int  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ previous : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ poutcome : num  1 1 1 1 1 1 1 1 1 1 ...
##  $ outcome  : int  1 1 1 1 1 1 1 1 1 1 ...

Primer acercamiento

#Tenemos que cambiar algunas de las variables categóricas a factor:
df$job <- factor(df$job)
df$marital <- factor(df$marital)
df$education <- factor(df$education)
df$default <- ifelse(df$default == "yes", 2, 1)
df$default <- factor(df$default)
df$housing <- ifelse(df$housing == "yes", 2, 1)
df$housing <- factor(df$housing)
df$loan <- ifelse(df$loan == "yes", 2, 1)
df$loan <- factor(df$loan)
df$contact <- factor(df$contact)
df$month <- factor(df$month)
df$poutcome <- factor(df$poutcome)
df$outcome <- ifelse(df$outcome == "2", 2, 1)
df$outcome <- factor(df$outcome)

#Observamos un pequeño resumen del df
summary(df)

##       age                 job           marital          education    
##  Min.   :18.00   blue-collar:9732   divorced: 5207   primary  : 6851  
##  1st Qu.:33.00   management :9458   married :27214   secondary:23202  
##  Median :39.00   technician :7597   single  :12790   tertiary :13301  
##  Mean   :40.94   admin.     :5171                    unknown  : 1857  
##  3rd Qu.:48.00   services   :4154                                     
##  Max.   :95.00   retired    :2264                                     
##                  (Other)    :6835                                     
##  default      balance       housing   loan           contact     
##  1:44396   Min.   : -8019   1:20081   1:37967   cellular :29285  
##  2:  815   1st Qu.:    72   2:25130   2: 7244   telephone: 2906  
##            Median :   448                       unknown  :13020  
##            Mean   :  1362                                        
##            3rd Qu.:  1428                                        
##            Max.   :102127                                        
##                                                                  
##       day            month          duration         campaign     
##  Min.   : 1.00   may    :13766   Min.   :   0.0   Min.   : 1.000  
##  1st Qu.: 8.00   jul    : 6895   1st Qu.: 103.0   1st Qu.: 1.000  
##  Median :16.00   aug    : 6247   Median : 180.0   Median : 2.000  
##  Mean   :15.81   jun    : 5341   Mean   : 258.2   Mean   : 2.764  
##  3rd Qu.:21.00   nov    : 3970   3rd Qu.: 319.0   3rd Qu.: 3.000  
##  Max.   :31.00   apr    : 2932   Max.   :4918.0   Max.   :63.000  
##                  (Other): 6060                                    
##      pdays          previous           poutcome     outcome  
##  Min.   : -1.0   Min.   :  0.0000   failure: 4901   1:39922  
##  1st Qu.: -1.0   1st Qu.:  0.0000   other  : 1840   2: 5289  
##  Median : -1.0   Median :  0.0000   success: 1511            
##  Mean   : 40.2   Mean   :  0.5803   unknown:36959            
##  3rd Qu.: -1.0   3rd Qu.:  0.0000                            
##  Max.   :871.0   Max.   :275.0000                            
## 

str(df)

## 'data.frame':    45211 obs. of  17 variables:
##  $ age      : int  58 44 33 47 33 35 28 42 58 43 ...
##  $ job      : Factor w/ 12 levels "admin.","blue-collar",..: 5 10 3 2 12 5 5 3 6 10 ...
##  $ marital  : Factor w/ 3 levels "divorced","married",..: 2 3 2 2 3 2 3 1 2 3 ...
##  $ education: Factor w/ 4 levels "primary","secondary",..: 3 2 2 4 4 3 3 3 1 2 ...
##  $ default  : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 2 1 1 ...
##  $ balance  : int  2143 29 2 1506 1 231 447 2 121 593 ...
##  $ housing  : Factor w/ 2 levels "1","2": 2 2 2 2 1 2 2 2 2 2 ...
##  $ loan     : Factor w/ 2 levels "1","2": 1 1 2 1 1 1 2 1 1 1 ...
##  $ contact  : Factor w/ 3 levels "cellular","telephone",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ day      : int  5 5 5 5 5 5 5 5 5 5 ...
##  $ month    : Factor w/ 12 levels "apr","aug","dec",..: 9 9 9 9 9 9 9 9 9 9 ...
##  $ duration : int  261 151 76 92 198 139 217 380 50 55 ...
##  $ campaign : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ pdays    : int  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ previous : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ poutcome : Factor w/ 4 levels "failure","other",..: 4 4 4 4 4 4 4 4 4 4 ...
##  $ outcome  : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...

Podemos oservar que logramos obtener una base de datos manejable, fue necesario renombrar algunas celdas y cambiar variables a factor para poder desarollar los modelos de clasificación más adelante

a-b) NA’s (Identificación y reemplazo)

#Comprobamos que no tengamos NA's en nuestro df
na_count <- colSums(is.na(df))
na_count

##       age       job   marital education   default   balance   housing      loan 
##         0         0         0         0         0         0         0         0 
##   contact       day     month  duration  campaign     pdays  previous  poutcome 
##         0         0         0         0         0         0         0         0 
##   outcome 
##         0

No contamos con valores nulos por lo que no es necesario llevar a cabo alguna función mutate.

c) Medidas descriptivas

columnas_numericas <- sapply(df, is.numeric)
media <- colMeans(df[, columnas_numericas], na.rm = TRUE)
cat("Media:", media, "\n")

## Media: 40.93621 1362.272 15.80642 258.1631 2.763841 40.19783 0.5803234

mediana <- sapply(df[, columnas_numericas], median, na.rm = TRUE) 
cat("Mediana:", mediana, "\n")

## Mediana: 39 448 16 180 2 -1 0

moda <- apply(df, 2, function(x) {
  unique_x <- unique(x[!is.na(x)])
  unique_x[which.max(tabulate(match(x, unique_x)))]})  
cat("Moda:", media, "\n")

## Moda: 40.93621 1362.272 15.80642 258.1631 2.763841 40.19783 0.5803234

columnas_numericas

##       age       job   marital education   default   balance   housing      loan 
##      TRUE     FALSE     FALSE     FALSE     FALSE      TRUE     FALSE     FALSE 
##   contact       day     month  duration  campaign     pdays  previous  poutcome 
##     FALSE      TRUE     FALSE      TRUE      TRUE      TRUE      TRUE     FALSE 
##   outcome 
##     FALSE

d) Medidas de dispersión

describe(df)

##            vars     n    mean      sd median trimmed    mad   min    max  range
## age           1 45211   40.94   10.62     39   40.25  10.38    18     95     77
## job*          2 45211    5.34    3.27      5    5.25   4.45     1     12     11
## marital*      3 45211    2.17    0.61      2    2.21   0.00     1      3      2
## education*    4 45211    2.22    0.75      2    2.23   0.00     1      4      3
## default*      5 45211    1.02    0.13      1    1.00   0.00     1      2      1
## balance       6 45211 1362.27 3044.77    448  767.21 664.20 -8019 102127 110146
## housing*      7 45211    1.56    0.50      2    1.57   0.00     1      2      1
## loan*         8 45211    1.16    0.37      1    1.08   0.00     1      2      1
## contact*      9 45211    1.64    0.90      1    1.55   0.00     1      3      2
## day          10 45211   15.81    8.32     16   15.69  10.38     1     31     30
## month*       11 45211    6.52    3.01      7    6.68   2.97     1     12     11
## duration     12 45211  258.16  257.53    180  210.87 137.88     0   4918   4918
## campaign     13 45211    2.76    3.10      2    2.12   1.48     1     63     62
## pdays        14 45211   40.20  100.13     -1   11.92   0.00    -1    871    872
## previous     15 45211    0.58    2.30      0    0.13   0.00     0    275    275
## poutcome*    16 45211    3.56    0.99      4    3.82   0.00     1      4      3
## outcome*     17 45211    1.12    0.32      1    1.02   0.00     1      2      1
##             skew kurtosis    se
## age         0.68     0.32  0.05
## job*        0.26    -1.27  0.02
## marital*   -0.10    -0.44  0.00
## education*  0.20    -0.26  0.00
## default*    7.24    50.49  0.00
## balance     8.36   140.73 14.32
## housing*   -0.22    -1.95  0.00
## loan*       1.85     1.43  0.00
## contact*    0.77    -1.32  0.00
## day         0.09    -1.06  0.04
## month*     -0.48    -1.00  0.01
## duration    3.14    18.15  1.21
## campaign    4.90    39.24  0.01
## pdays       2.62     6.93  0.47
## previous   41.84  4506.16  0.01
## poutcome*  -1.97     2.15  0.00
## outcome*    2.38     3.68  0.00

En el chunk anterior se nos presentas las siguientes medidas de dispersión:

• mean: La media de los datos, es decir, la suma de todos los valores dividida por el número de observaciones.
• sd: La desviación estándar de los datos, que indica cuánto varían los datos con respecto a la media.
• median: La mediana de los datos, que es el valor que separa el conjunto de datos en dos mitades iguales cuando los datos están ordenados.
• min: El valor mínimo en el conjunto de datos.
• max: El valor máximo en el conjunto de datos.
• range: El rango de los datos, que es la diferencia entre el valor máximo y el valor mínimo.

e) Gráficos para identificar patrones

# Matriz de correlación
# Tenemos que cambiar temporalmente la variable "outcome" a numeric para poderla incluir en nuestra matríz de confusión:
df$outcome <- as.numeric(df$outcome)
corr_matrix <- cor(df_numeric[, c("age", "balance","day", "duration", "campaign", "pdays", "previous","outcome")])
corrplot(corr_matrix, method = "color")

# Devolvemos la variable "outcome" as a factor para poder usarla como variable dependiente en los futuros modelos y gráficos
df$outcome <- factor(df$outcome)


# Gráficos de barras (variables categóricas)
barplot(table(df$outcome), main = "Distribución de Outcome", xlab = "Outcome", ylab = "Frecuencia", ylim = c(0, 40000))

barplot(table(df$job), main = "Distribución de Trabajo", xlab = "Tipo de Trabajo", ylab = "Frecuencia", ylim = c(0, 10000))

barplot(table(df$education), main = "Distribución de Educación", xlab = "Educación", ylab = "Frecuencia", ylim = c(0, 25000))

# Histogramas (variables numéricas)

options(scipen = 999)
hist(df$age, main = "Histograma de Edad", xlab= "Edad", ylab="Frecuencia")

hist(df$balance, main = "Histograma de Balance", xlab= "Balance", ylab="Frecuencia")

hist(df$duration, main = "Histograma de Duración", xlab= "Duración", ylab="Frecuencia")

f) Transformación de variables (log)

# No consideré necesario realizar ninguna transformación de variables puesto que a pesar que en algunas de las variables poodemos observar colas a la derecha en sus histogramas, dichos outliers pueden ser cruciales para identificar patrones de valor y no fueron muchos registros los que presentaron este comportamiento

3. Interpretación del EDA

Durante el inicio de este Análisis Exploratorio de los Datos decidí cambiar la variable dependiente “outcome” a numeric para poder incluirla dentro de una matriz de correlación en la que buscamos identificar la relación o asociación entre pares de variables en nuestro conjunto de datos y lo que obtuvimos fueron los primer hallazgos de posibles relaciones directas con nuestra variable dependiente como lo podemos ver con “duration”, también buscamos identificar alguna correlación entre las variables independientes que pudieses sesgar nuestros resultados. Después de haber realizado la matriz de correlaciones, procedí a realizar algunos gráficos de barras en los que buscaba comparar la distribución de las principales variables categóricas, en estos casos siendo “outcome” pues es nuestra variable de interés, “job” para saber los principales tipos de trabajos y “education” para saber si encontrábamos la presencia de mayor cantidad de registros para un nivel de escolaridad específico Finalmente realicé histogramas para ver el comportamiento de la distribución de frecuencias, así como la forma de dichas distribuciones y podemos observar que contamos con colas derechas tanto en el ingreso como con la duración, pero no decidí realizar alguna transformación logarítmica debido a que dichas variables fueron importantes en la R.L.M.

4. Estimación de los métodos de clasificación SML

set.seed(123)
sample <- sample(c(TRUE, FALSE), nrow(df), replace = T, prob = c(0.6,0.4))
train  <- df[sample, ]
test   <- df[!sample, ]

sample_numeric <- sample(c(TRUE, FALSE), nrow(df_numeric), replace = T, prob = c(0.6,0.4))
train_numeric  <- df_numeric[sample, ]
test_numeric   <- df_numeric[!sample, ]

str(train)

## 'data.frame':    27336 obs. of  17 variables:
##  $ age      : int  58 33 35 28 58 43 29 58 57 45 ...
##  $ job      : Factor w/ 12 levels "admin.","blue-collar",..: 5 3 5 5 6 10 1 10 8 1 ...
##  $ marital  : Factor w/ 3 levels "divorced","married",..: 2 2 2 3 2 3 3 2 2 3 ...
##  $ education: Factor w/ 4 levels "primary","secondary",..: 3 2 3 3 1 2 2 4 2 4 ...
##  $ default  : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
##  $ balance  : int  2143 2 231 447 121 593 390 71 162 13 ...
##  $ housing  : Factor w/ 2 levels "1","2": 2 2 2 2 2 2 2 2 2 2 ...
##  $ loan     : Factor w/ 2 levels "1","2": 1 2 1 2 1 1 1 1 1 1 ...
##  $ contact  : Factor w/ 3 levels "cellular","telephone",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ day      : int  5 5 5 5 5 5 5 5 5 5 ...
##  $ month    : Factor w/ 12 levels "apr","aug","dec",..: 9 9 9 9 9 9 9 9 9 9 ...
##  $ duration : int  261 76 139 217 50 55 137 71 174 98 ...
##  $ campaign : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ pdays    : int  -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ previous : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ poutcome : Factor w/ 4 levels "failure","other",..: 4 4 4 4 4 4 4 4 4 4 ...
##  $ outcome  : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...

a) Logistic Regression

# Generar el modelo
library(caret)
logistic_model <- glm(outcome ~ ., family = binomial, data = train)

# Generar predicciones
logistic_predictions <- predict(logistic_model, newdata = test, type = "response")
logistic_predictions_fact <- factor(ifelse(logistic_predictions > 0.009, "1", "2"), levels = levels(test$outcome))

#Matriz de confusion
conf_lr <- confusionMatrix(logistic_predictions_fact, test$outcome)
conf_lr

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 13782  2086
##          2  1999     8
##                                           
##                Accuracy : 0.7715          
##                  95% CI : (0.7652, 0.7776)
##     No Information Rate : 0.8829          
##     P-Value [Acc > NIR] : 1.0000          
##                                           
##                   Kappa : -0.1251         
##                                           
##  Mcnemar's Test P-Value : 0.1784          
##                                           
##             Sensitivity : 0.873329        
##             Specificity : 0.003820        
##          Pos Pred Value : 0.868540        
##          Neg Pred Value : 0.003986        
##              Prevalence : 0.882853        
##          Detection Rate : 0.771021        
##    Detection Prevalence : 0.887720        
##       Balanced Accuracy : 0.438575        
##                                           
##        'Positive' Class : 1               
## 

# Calculo de curva ROC y su AUC

roc_curve_log <- roc(test$outcome, logistic_predictions)
plot(roc_curve_log, main = "Curva ROC R.L.", col = "red", lwd = 2)

auc_value_log <- auc(roc_curve_log)
auc_value_log

## Area under the curve: 0.9023

b) Decision Trees

# Crear el modelo
dt_model <- rpart(outcome ~ .,data = train_numeric, method = "class", control = rpart.control(cp=0.002))
rpart.plot(dt_model)

# Generar predicciones
dt_predictions <- predict(dt_model, newdata = test_numeric, type = "class")

#Matriz de confusion
conf_dt <- confusionMatrix(dt_predictions, test$outcome)
conf_dt

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 15395  1393
##          2   386   701
##                                                
##                Accuracy : 0.9005               
##                  95% CI : (0.896, 0.9048)      
##     No Information Rate : 0.8829               
##     P-Value [Acc > NIR] : 0.00000000000003669  
##                                                
##                   Kappa : 0.3921               
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.9755               
##             Specificity : 0.3348               
##          Pos Pred Value : 0.9170               
##          Neg Pred Value : 0.6449               
##              Prevalence : 0.8829               
##          Detection Rate : 0.8613               
##    Detection Prevalence : 0.9392               
##       Balanced Accuracy : 0.6552               
##                                                
##        'Positive' Class : 1                    
## 

c) Support Vector Machine (SVM)

# Creación del modelo
svm_model <- svm(outcome ~ . , data = train, kernel = "radial")

# Predicciones
svm_predictions <- predict(svm_model, newdata = test)

#Matriz de confusion
conf_svm <- confusionMatrix(svm_predictions, test$outcome)
conf_svm

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 15451  1505
##          2   330   589
##                                                
##                Accuracy : 0.8973               
##                  95% CI : (0.8928, 0.9018)     
##     No Information Rate : 0.8829               
##     P-Value [Acc > NIR] : 0.0000000004603      
##                                                
##                   Kappa : 0.3441               
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.9791               
##             Specificity : 0.2813               
##          Pos Pred Value : 0.9112               
##          Neg Pred Value : 0.6409               
##              Prevalence : 0.8829               
##          Detection Rate : 0.8644               
##    Detection Prevalence : 0.9486               
##       Balanced Accuracy : 0.6302               
##                                                
##        'Positive' Class : 1                    
## 

d) K-means Clustering

# Creación del modelo
kmeans_model <- kmeans(train_numeric, centers = 3, nstart = 20)

fviz_cluster(kmeans_model, data = train_numeric)

e) KNN

#CREACION DE LAS PARTICIONES NECESARIAS PARA LE MODELO
set.seed(123)
trainIndex <- createDataPartition(df_numeric$outcome, p=.6, list = FALSE, times = 1)
train_knn <- df_numeric[trainIndex,]  
test_knn <- df_numeric[-trainIndex,]

# Dividir nuevamente los datos en predictores y variable objetivo
train_knn_predictors <- train_knn[, 1:16] 
train_knn_target <- train_knn[, 17]      

test_knn_predictors <- test_knn[, 1:16] 
test_knn_target <- test_knn[, 17]       

#Creación del modelo
knn_model <- knn (train=train_knn_predictors, test=test_knn_predictors, cl=train_knn_target, k=3, prob=TRUE)
knn_predictions <- knn_model

conf_knn <- table(knn_predictions, test_knn_target)
conf_knn

##                test_knn_target
## knn_predictions     1     2
##               1 15227  1484
##               2   764   609

# Medidas de desempeño
accuracy_knn <- sum(diag(conf_knn)) / sum(conf_knn)
accuracy_knn

## [1] 0.8756912

kappa_knn <- kappa(conf_knn)
kappa_knn

##       Estimate Std.Err   2.5%  97.5%
## kappa   0.2859 0.01098 0.2644 0.3075
##                                                                                                                                                          P-value
## kappa 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001775

f) Naïve Bayes

#Particion de datos para el modelo
set.seed(123)
nb_partition <- createDataPartition(y = df$outcome, p = 0.65, list = FALSE)
nb_train <- df[nb_partition,]
nb_test  <- df[-nb_partition,]

#Creación del modelo
modelo_nb <- naiveBayes(outcome ~ ., data = nb_train)

#Creación de predicciones
nb_prediction<-predict(modelo_nb, as.data.frame(nb_test))

#Matriz de confusion
conf_nb <- confusionMatrix(nb_test$outcome, nb_prediction)
conf_nb

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 12945  1027
##          2   860   991
##                                           
##                Accuracy : 0.8807          
##                  95% CI : (0.8756, 0.8858)
##     No Information Rate : 0.8725          
##     P-Value [Acc > NIR] : 0.0008547       
##                                           
##                   Kappa : 0.4445          
##                                           
##  Mcnemar's Test P-Value : 0.0001327       
##                                           
##             Sensitivity : 0.9377          
##             Specificity : 0.4911          
##          Pos Pred Value : 0.9265          
##          Neg Pred Value : 0.5354          
##              Prevalence : 0.8725          
##          Detection Rate : 0.8181          
##    Detection Prevalence : 0.8830          
##       Balanced Accuracy : 0.7144          
##                                           
##        'Positive' Class : 1               
## 

6. Evaluación y Selección de Modelo de Clasificación

a) Matriz de Confusión

A continuación se muestran las matrices de confusión de cada uno de los modelos:

# LOGISTIC REGRESION
conf_lr$table

##           Reference
## Prediction     1     2
##          1 13782  2086
##          2  1999     8

# DECISION TREE
conf_dt$table

##           Reference
## Prediction     1     2
##          1 15395  1393
##          2   386   701

# SUPPORTED VECTOR MACHINE (SVM)
conf_svm$table

##           Reference
## Prediction     1     2
##          1 15451  1505
##          2   330   589

# KNN
conf_knn

##                test_knn_target
## knn_predictions     1     2
##               1 15227  1484
##               2   764   609

# NAIVE BAYES
conf_nb$table

##           Reference
## Prediction     1     2
##          1 12945  1027
##          2   860   991

b) Estadístico Kappa

A continuación se muestran los estadísticos de kappa de cada uno de los modelos:

kappa_lr<- conf_lr$overall["Kappa"]
kappa_dt<- conf_dt$overall["Kappa"]
kappa_svm<- conf_svm$overall["Kappa"]
kappa_knn<- 0.2859
kappa_nb<- conf_nb$overall["Kappa"]

kappas_values<- c(kappa_lr,kappa_dt,kappa_svm, kappa_knn,kappa_nb)
kappas_names<- c("Logistic Regression", "Decision Tree", "SVM", "KNN", "Naive Bayes")
kappas_compare <- data.frame(Modelo = kappas_names, Kappa = kappas_values)
kappas_compare

##                Modelo      Kappa
## 1 Logistic Regression -0.1251049
## 2       Decision Tree  0.3920698
## 3                 SVM  0.3441004
## 4                 KNN  0.2859000
## 5         Naive Bayes  0.4444873

c) Accuracy

A continuación se muestra el accuracy de cada uno de los modelos:

acc_lr<- conf_lr$overall["Accuracy"]
acc_dt<- conf_dt$overall["Accuracy"]
acc_svm<- conf_svm$overall["Accuracy"]
acc_knn<- accuracy_knn
acc_nb<- conf_nb$overall["Accuracy"]

acc_values<- c(acc_lr,acc_dt,acc_svm, acc_knn,acc_nb)
acc_names<- c("Logistic Regression", "Decision Tree", "SVM", "KNN", "Naive Bayes")
acc_compare <- data.frame(Modelo = acc_names, Accuracy = acc_values)
acc_compare

##                Modelo  Accuracy
## 1 Logistic Regression 0.7714685
## 2       Decision Tree 0.9004755
## 3                 SVM 0.8973427
## 4                 KNN 0.8756912
## 5         Naive Bayes 0.8807432

Finalmente, tomando en cuenta las métricas de comparación para los distintos modelos como el accuracy, sus matrices de confusión y el estadístico Kappa podemos realizar un top de los modelos a la hora de clasificar:

• Decision Trees debido a su alto accuracy y a mostrar el segundo más alto nivel en Kappa
  
• Naive Bayes debido a que mostró el nivel en Kappa más alto y mostrando un accuracy de más del 85%
  
• SVM demostró tener un buen rendimiento a pesar de haber quedado 0.05 puntos más bajo que D.T. en estadístico de Kappa
  
• KNN No mostró una baja precision, sin embargo los niveles de concordancia comenzaron a ser más leves
  
• Logistic Regresion Al principio demostró tener un buen ROC Y AUC, sin embargo tomando en cuenta los resultados de su accuracy y Kappa demostró ser más deficiente que los demás modelos (esto puede deberse a un problema de optimización a la hora de transformar las predicciones a factores o provocado por la falta de alguna normalización o transformación de variables) por lo que no es para nada un mal modelo, pero son necesarios cambios para poder aprovecharlo al máximo.