Evidencia2_Técnicas predictivas basadas en aprendizaje autónomo_A00833113

Evidencia 2: Técnicas predictivas basadas en aprendizaje autónomo

Introducción

Una empresa busca mejorar su tasa de conversión y optimizar la experiencia del usuario, por medio del análisis de distintos modelos predictivos. El idccionario de variables para este caso es: - Administrative (Administrativas): Número de páginas administrativas visitadas. En el e-commerce, esto podría incluir gestión de cuentas o consultas de ayuda. Un número elevado podría indicar un usuario activamente involucrado o con problemas que requieren asistencia.

• Administrative_Duration (Duración Administrativa): Tiempo total invertido en páginas administrativas. El tiempo prolongado puede sugerir un mayor compromiso o dificultades en la navegación o gestión del sitio.

• Informational (Informativas): Número de páginas informativas visitadas. Esto incluye FAQs, blogs o artículos. Una cantidad alta podría indicar usuarios buscando información antes de una posible compra.

• Informational_Duration (Duración Informativa): Tiempo total en páginas informativas. Un tiempo mayor puede reflejar un alto interés en el contenido proporcionado por el sitio.

• ProductRelated (Relacionadas con Productos): Número de páginas de productos visitadas. Esencial en e-commerce, ya que una mayor cantidad de visitas a estas páginas suele estar relacionada con un interés en los productos.

• ProductRelated_Duration (Duración Relacionada con Productos): Tiempo total en páginas de productos. Un indicador clave de interés y compromiso del usuario con los productos ofrecidos.

• BounceRates (Tasa de Rebote): Porcentaje de visitantes que abandonan el sitio después de ver solo una página. Una tasa alta puede indicar un contenido no relevante o problemas de usabilidad.

• ExitRates (Tasa de Salida): Tasa de abandonos en todas las páginas. A diferencia de la tasa de rebote, mide la salida desde cualquier página, siendo un indicador de la eficacia general del sitio para retener visitantes.

• PageValues (Valor de Página): Valor promedio de las páginas visitadas, reflejado en términos de conversión a ventas. Un valor alto indica páginas que contribuyen significativamente a las ventas.

• SpecialDay (Día Especial): Cercanía de la visita a un día especial (como Navidad o San Valentín), en una escala de 0 a 1. Importante para evaluar campañas y estrategias específicas para días festivos.

• Month (Mes): Mes de la visita. Permite analizar tendencias estacionales y planificar estrategias de marketing y stock.

• OperatingSystems (Sistema Operativo), Browser (Navegador), Region (Región), TrafficType (Tipo de Tráfico): Estas variables proporcionan información sobre el perfil técnico y geográfico del usuario, útil para optimizar el diseño y la accesibilidad del sitio.

• VisitorType (Tipo de Visitante): Categoría del visitante (nuevo, recurrente, etc.). Un factor clave para entender la lealtad y el comportamiento de los clientes.

• Weekend (Fin de Semana): Si la visita ocurrió en fin de semana. Ayuda a comprender los patrones de compra en diferentes días.

• Revenue (Ingresos): Si la visita resultó en una compra. La variable objetivo esencial para entender qué conduce a las conversiones.

Limpieza de base de datos

Importación de librerías

library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

library(ggplot2)
library(lattice)
library(rpart)
library(rpart.plot)
library(party)

## Loading required package: grid

## Loading required package: mvtnorm

## Loading required package: modeltools

## Loading required package: stats4

## Loading required package: strucchange

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## Loading required package: sandwich

library(gmodels)
library(grid)
library(mvtnorm)
library(modeltools)
library(stats4)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:party':
## 
##     where

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(strucchange)
library(zoo)
library(readr)
library(ggplot2)
library(e1071)
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(bootstrap)

Se carga base de datos y se realiza transformación de tipos de datos

bd <- read.csv("DataEcommerce.csv")
head(bd)

##   Administrative Administrative_Duration Informational Informational_Duration
## 1              0                     0.0             0                      0
## 2              3                    41.2             0                      0
## 3              0                     0.0             0                      0
## 4              2                   196.6             0                      0
## 5              6                    53.0             0                      0
## 6              1                     4.0             0                      0
##   ProductRelated ProductRelated_Duration BounceRates   ExitRates PageValues
## 1             20                419.6000  0.03809524 0.068253968   0.000000
## 2              7                942.8000  0.00000000 0.030000000   0.000000
## 3             34               1228.5000  0.03970588 0.059313725   0.000000
## 4             31               1514.3000  0.03636364 0.066666667   0.000000
## 5             40                778.8333  0.00000000 0.009469697   8.480846
## 6              8                227.1000  0.02222222 0.066666667   0.000000
##   SpecialDay Month OperatingSystems Browser Region TrafficType
## 1          0   Aug                3       2      3           3
## 2          0   Aug                1       1      4           5
## 3          0   Aug                3       2      1           4
## 4          0   Aug                1       8      7           1
## 5          0   Aug                1       1      1           4
## 6          0   Aug                2       2      3          13
##         VisitorType Weekend Revenue
## 1 Returning_Visitor    TRUE   FALSE
## 2       New_Visitor   FALSE   FALSE
## 3 Returning_Visitor   FALSE   FALSE
## 4 Returning_Visitor    TRUE   FALSE
## 5       New_Visitor    TRUE   FALSE
## 6 Returning_Visitor   FALSE   FALSE

Se eliminan duplicados

bd <- unique(bd)
dim(bd) #251 registros duplicados

## [1] 12205    18

Se eliminan nulos

bd$VisitorType <- as.factor(bd$VisitorType)
bd$Month <- as.factor(bd$Month)

bd <- na.exclude(bd)
summary(bd)

##  Administrative   Administrative_Duration Informational    
##  Min.   : 0.000   Min.   :   0.00         Min.   : 0.0000  
##  1st Qu.: 0.000   1st Qu.:   0.00         1st Qu.: 0.0000  
##  Median : 1.000   Median :   9.00         Median : 0.0000  
##  Mean   : 2.339   Mean   :  81.65         Mean   : 0.5087  
##  3rd Qu.: 4.000   3rd Qu.:  94.70         3rd Qu.: 0.0000  
##  Max.   :27.000   Max.   :3398.75         Max.   :24.0000  
##                                                            
##  Informational_Duration ProductRelated   ProductRelated_Duration
##  Min.   :   0.00        Min.   :  0.00   Min.   :    0.0        
##  1st Qu.:   0.00        1st Qu.:  8.00   1st Qu.:  193.0        
##  Median :   0.00        Median : 18.00   Median :  608.9        
##  Mean   :  34.83        Mean   : 32.05   Mean   : 1207.0        
##  3rd Qu.:   0.00        3rd Qu.: 38.00   3rd Qu.: 1477.2        
##  Max.   :2549.38        Max.   :705.00   Max.   :63973.5        
##                                                                 
##   BounceRates         ExitRates         PageValues       SpecialDay     
##  Min.   :0.000000   Min.   :0.00000   Min.   :  0.00   Min.   :0.00000  
##  1st Qu.:0.000000   1st Qu.:0.01423   1st Qu.:  0.00   1st Qu.:0.00000  
##  Median :0.002899   Median :0.02500   Median :  0.00   Median :0.00000  
##  Mean   :0.020370   Mean   :0.04147   Mean   :  5.95   Mean   :0.06194  
##  3rd Qu.:0.016667   3rd Qu.:0.04853   3rd Qu.:  0.00   3rd Qu.:0.00000  
##  Max.   :0.200000   Max.   :0.20000   Max.   :361.76   Max.   :1.00000  
##                                                                         
##      Month      OperatingSystems    Browser           Region     
##  May    :3329   Min.   :1.000    Min.   : 1.000   Min.   :1.000  
##  Nov    :2982   1st Qu.:2.000    1st Qu.: 2.000   1st Qu.:1.000  
##  Mar    :1860   Median :2.000    Median : 2.000   Median :3.000  
##  Dec    :1706   Mean   :2.124    Mean   : 2.358   Mean   :3.153  
##  Oct    : 549   3rd Qu.:3.000    3rd Qu.: 2.000   3rd Qu.:4.000  
##  Sep    : 448   Max.   :8.000    Max.   :13.000   Max.   :9.000  
##  (Other):1331                                                    
##   TrafficType                VisitorType     Weekend         Revenue       
##  Min.   : 1.000   New_Visitor      : 1693   Mode :logical   Mode :logical  
##  1st Qu.: 2.000   Other            :   81   FALSE:9346      FALSE:10297    
##  Median : 2.000   Returning_Visitor:10431   TRUE :2859      TRUE :1908     
##  Mean   : 4.074                                                            
##  3rd Qu.: 4.000                                                            
##  Max.   :20.000                                                            
## 

Se visualiza distribución de datos de cada columna

boxplot(bd[, !colnames(bd) %in% c("Month", "Revenue", "Weekend", "VisitorType")], col = "lightblue", main = "Boxplot de Varias Columnas")

Acorde a boxplot, se elimina outliers por medio del rango intercuartil de la variable ProductRelatedDuration

conteorango <- sum(bd$ProductRelated_Duration >= 0 & bd$ProductRelated_Duration < 100, na.rm = TRUE)
conteorango

## [1] 1997

bd$ProductRelated_Duration <- replace(bd$ProductRelated_Duration, bd$ProductRelated_Duration >= 0 & bd$ProductRelated_Duration < 100, NA)

bd$ProductRelated_Duration[is.na(bd$ProductRelated_Duration)] <- median(bd$ProductRelated_Duration, na.rm = TRUE)

#Eliminar valores extremos adicionales usando el rango intercuartil
q1 <- quantile(bd$ProductRelated_Duration, 0.25, na.rm=TRUE)
q3 <- quantile(bd$ProductRelated_Duration, 0.75, na.rm=TRUE)
rangointq <- q3 - q1

limite_inferior <- q1 - 3 * rangointq
limite_superior <- q3 + 3 * rangointq

bd <- subset(bd, ProductRelated_Duration >= limite_inferior & ProductRelated_Duration <= limite_superior)

summary(bd$ProductRelated_Duration)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   100.0   418.3   815.4  1041.2  1306.3  4590.4

DESBALANCEO DE CLASES

library(ggplot2)

ggplot(bd, aes(x = Revenue)) +
  geom_bar() +
  labs(title = "Distribución de Clases", x = "Clase", y = "Frecuencia")

SETS de ENTRENAMIENTO, VALIDACIÓN Y PRUEBA

# Establecer la semilla para reproducibilidad
set.seed(123)

bd$Revenue <- as.factor(bd$Revenue)
bd$Month <- as.factor(bd$Month)

# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndex1 <- createDataPartition(bd$Revenue, p = 0.5, list = FALSE, times = 1)
train <- bd[trainIndex1, ]
temp <- bd[-trainIndex1, ]

# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndex2 <- createDataPartition(temp$Revenue, p = 0.5, list = FALSE, times = 1)
validation <- temp[trainIndex2, ]
test <- temp[-trainIndex2, ]

Metolodogia CART

# Construir el árbol de decisión
tree <- rpart(Revenue ~ ., data = train, method = "class", control = rpart.control(cp = 0.0))
rpart.plot(tree)

## Warning: labs do not fit even at cex 0.15, there may be some overplotting

rpart.plot(tree,digits = 4, fallen.leaves = TRUE,type = 3,extra = 101)

## Warning: labs do not fit even at cex 0.15, there may be some overplotting

# Visualizar la curva de complejidad de costo
plotcp(tree)

# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree <- prune(tree, cp = 0.005)

# Visualizar el árbol podado
rpart.plot(pruned_tree)

rpart.plot(pruned_tree,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)

Matriz de confusion CART

# Realizar predicciones en el conjunto de prueba
predictions <- predict(tree, newdata = test, type = "class")

# Convertir las predicciones a un factor si aún no lo son
predictions <- as.factor(predictions)

# Calcular la matriz de confusión
test$Revenue <- as.factor(test$Revenue)
conf_matrix <- confusionMatrix(predictions, test$Revenue,positive = "TRUE")

# Imprimir la matriz de confusión
print(conf_matrix)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction FALSE TRUE
##      FALSE  2379  209
##      TRUE    106  221
##                                          
##                Accuracy : 0.8919         
##                  95% CI : (0.8801, 0.903)
##     No Information Rate : 0.8525         
##     P-Value [Acc > NIR] : 2.421e-10      
##                                          
##                   Kappa : 0.5231         
##                                          
##  Mcnemar's Test P-Value : 9.081e-09      
##                                          
##             Sensitivity : 0.51395        
##             Specificity : 0.95734        
##          Pos Pred Value : 0.67584        
##          Neg Pred Value : 0.91924        
##              Prevalence : 0.14751        
##          Detection Rate : 0.07581        
##    Detection Prevalence : 0.11218        
##       Balanced Accuracy : 0.73565        
##                                          
##        'Positive' Class : TRUE           
## 

# Obtener las puntuaciones de probabilidad
prediccion_prob <- predict(tree, test, type = "prob")

# Si el resultado es una matriz, selecciona la columna que corresponde a la clase 'Yes' o '1'
prediccion_prob_yes <- prediccion_prob[, "TRUE"]

Curva ROC y AUC CART

# Generar la curva ROC
library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following object is masked from 'package:gmodels':
## 
##     ci

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

roc_obj <- roc(test$Revenue, prediccion_prob_yes)

## Setting levels: control = FALSE, case = TRUE

## Setting direction: controls < cases

# Dibujar la curva ROC
plot.roc(roc_obj, main="Curva ROC", col="blue")

# Calcular el AUC
auc(roc_obj)

## Area under the curve: 0.8952

Clasificacion Naive Bayes

modelo_nb <- naiveBayes(Revenue ~ ., data = train)

# Hacer predicciones
predicciones_nb <- predict(modelo_nb, test)

# tablas de probabilidad condicional:
modelo_nb$tables

## $Administrative
##        Administrative
## Y           [,1]     [,2]
##   FALSE 1.991952 3.030989
##   TRUE  2.961628 3.362765
## 
## $Administrative_Duration
##        Administrative_Duration
## Y            [,1]     [,2]
##   FALSE  69.02917 158.0947
##   TRUE  106.36340 184.8837
## 
## $Informational
##        Informational
## Y            [,1]     [,2]
##   FALSE 0.4110664 1.115686
##   TRUE  0.6406977 1.411732
## 
## $Informational_Duration
##        Informational_Duration
## Y           [,1]     [,2]
##   FALSE 25.30875 116.4663
##   TRUE  40.27120 130.4112
## 
## $ProductRelated
##        ProductRelated
## Y           [,1]     [,2]
##   FALSE 24.59235 26.93976
##   TRUE  33.70116 29.55286
## 
## $ProductRelated_Duration
##        ProductRelated_Duration
## Y           [,1]      [,2]
##   FALSE 1011.481  874.9744
##   TRUE  1309.536 1016.7936
## 
## $BounceRates
##        BounceRates
## Y              [,1]        [,2]
##   FALSE 0.023331332 0.048757581
##   TRUE  0.004675728 0.009664846
## 
## $ExitRates
##        ExitRates
## Y             [,1]       [,2]
##   FALSE 0.04625761 0.04914529
##   TRUE  0.01928178 0.01494247
## 
## $PageValues
##        PageValues
## Y           [,1]      [,2]
##   FALSE  1.95244  8.465397
##   TRUE  29.48115 36.662071
## 
## $SpecialDay
##        SpecialDay
## Y             [,1]      [,2]
##   FALSE 0.07038229 0.2121962
##   TRUE  0.02209302 0.1225469
## 
## $Month
##        Month
## Y               Aug         Dec         Feb         Jul        June         Mar
##   FALSE 0.033199195 0.149496982 0.018511066 0.037022133 0.023742455 0.164788732
##   TRUE  0.034883721 0.120930233 0.002325581 0.036046512 0.013953488 0.113953488
##        Month
## Y               May         Nov         Oct         Sep
##   FALSE 0.285110664 0.212273642 0.041046278 0.034808853
##   TRUE  0.210465116 0.343023256 0.063953488 0.060465116
## 
## $OperatingSystems
##        OperatingSystems
## Y           [,1]      [,2]
##   FALSE 2.130584 0.9167667
##   TRUE  2.122093 0.9960225
## 
## $Browser
##        Browser
## Y           [,1]     [,2]
##   FALSE 2.354527 1.725317
##   TRUE  2.508140 2.029739
## 
## $Region
##        Region
## Y           [,1]     [,2]
##   FALSE 3.184507 2.413311
##   TRUE  3.141860 2.409888
## 
## $TrafficType
##        TrafficType
## Y           [,1]     [,2]
##   FALSE 4.065996 3.998550
##   TRUE  4.301163 4.257022
## 
## $VisitorType
##        VisitorType
## Y       New_Visitor       Other Returning_Visitor
##   FALSE 0.121529175 0.006237425       0.872233400
##   TRUE  0.258139535 0.010465116       0.731395349
## 
## $Weekend
##        Weekend
## Y           FALSE      TRUE
##   FALSE 0.7647887 0.2352113
##   TRUE  0.7418605 0.2581395

Bootstrap en BAYES

#Bootstrap
# Definir la estadística a calcular
# Por ejemplo, si deseas calcular la precisión del modelo, podrías hacer una función así:
bootstrap_statistic <- function(data, indices) {
  # Seleccionar una muestra de bootstrap
  sample <- data[indices, ]
  
  # Ajustar el modelo a la muestra de bootstrap
  fit <- naiveBayes(Revenue ~ ., data = sample)
  
  # Evaluar la precisión del modelo en todo el conjunto de datos
  predictions <- predict(fit, newdata = data, type = "class")
  accuracy <- mean(predictions == data$Revenue)
  
  return(accuracy)
}

# Aplicar la función de bootstrap
library(boot)

## 
## Attaching package: 'boot'

## The following object is masked from 'package:lattice':
## 
##     melanoma

results <- boot(data = validation, statistic = bootstrap_statistic, R = 50)

# Ver los resultados
results

## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = validation, statistic = bootstrap_statistic, R = 50)
## 
## 
## Bootstrap Statistics :
##      original       bias    std. error
## t1* 0.8054889 -0.007773585  0.02475574

Interpretabilidad

str(modelo_nb)

## List of 5
##  $ apriori  : 'table' int [1:2(1d)] 4970 860
##   ..- attr(*, "dimnames")=List of 1
##   .. ..$ Y: chr [1:2] "FALSE" "TRUE"
##  $ tables   :List of 17
##   ..$ Administrative         : num [1:2, 1:2] 1.99 2.96 3.03 3.36
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y             : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Administrative: NULL
##   ..$ Administrative_Duration: num [1:2, 1:2] 69 106 158 185
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y                      : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Administrative_Duration: NULL
##   ..$ Informational          : num [1:2, 1:2] 0.411 0.641 1.116 1.412
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y            : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Informational: NULL
##   ..$ Informational_Duration : num [1:2, 1:2] 25.3 40.3 116.5 130.4
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y                     : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Informational_Duration: NULL
##   ..$ ProductRelated         : num [1:2, 1:2] 24.6 33.7 26.9 29.6
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y             : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ ProductRelated: NULL
##   ..$ ProductRelated_Duration: num [1:2, 1:2] 1011 1310 875 1017
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y                      : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ ProductRelated_Duration: NULL
##   ..$ BounceRates            : num [1:2, 1:2] 0.02333 0.00468 0.04876 0.00966
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y          : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ BounceRates: NULL
##   ..$ ExitRates              : num [1:2, 1:2] 0.0463 0.0193 0.0491 0.0149
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y        : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ ExitRates: NULL
##   ..$ PageValues             : num [1:2, 1:2] 1.95 29.48 8.47 36.66
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y         : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ PageValues: NULL
##   ..$ SpecialDay             : num [1:2, 1:2] 0.0704 0.0221 0.2122 0.1225
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y         : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ SpecialDay: NULL
##   ..$ Month                  : 'table' num [1:2, 1:10] 0.0332 0.0349 0.1495 0.1209 0.0185 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y    : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Month: chr [1:10] "Aug" "Dec" "Feb" "Jul" ...
##   ..$ OperatingSystems       : num [1:2, 1:2] 2.131 2.122 0.917 0.996
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y               : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ OperatingSystems: NULL
##   ..$ Browser                : num [1:2, 1:2] 2.35 2.51 1.73 2.03
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y      : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Browser: NULL
##   ..$ Region                 : num [1:2, 1:2] 3.18 3.14 2.41 2.41
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y     : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Region: NULL
##   ..$ TrafficType            : num [1:2, 1:2] 4.07 4.3 4 4.26
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y          : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ TrafficType: NULL
##   ..$ VisitorType            : 'table' num [1:2, 1:3] 0.12153 0.25814 0.00624 0.01047 0.87223 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y          : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ VisitorType: chr [1:3] "New_Visitor" "Other" "Returning_Visitor"
##   ..$ Weekend                : 'table' num [1:2, 1:2] 0.765 0.742 0.235 0.258
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y      : chr [1:2] "FALSE" "TRUE"
##   .. .. ..$ Weekend: chr [1:2] "FALSE" "TRUE"
##  $ levels   : chr [1:2] "FALSE" "TRUE"
##  $ isnumeric: Named logi [1:17] TRUE TRUE TRUE TRUE TRUE TRUE ...
##   ..- attr(*, "names")= chr [1:17] "Administrative" "Administrative_Duration" "Informational" "Informational_Duration" ...
##  $ call     : language naiveBayes.default(x = X, y = Y, laplace = laplace)
##  - attr(*, "class")= chr "naiveBayes"

Graficos de Probabilidades Condicionales

barplot(modelo_nb$tables$VisitorType)
# Agregar una leyenda
legend("topright", inset = .05, title = "Revenue", 
       c("TRUE", "FALSE"), fill = c("black", "lightgray"))

barplot(modelo_nb$tables$Weekend)

barplot(modelo_nb$tables$VisitorType)

barplot(modelo_nb$tables$PageValues)

Curva ROC y AUC Bayes

# Obtener las puntuaciones de probabilidad
prediccion_prob_nb <- predict(modelo_nb, test, type = "raw")

# Si el resultado es una matriz, selecciona la columna que corresponde a la clase 'Compra' o 'No compra'
prediccion_prob_yes_nb <- prediccion_prob_nb[, "TRUE"]

# Generar la curva ROC
roc_obj_nb <- roc(test$Revenue, prediccion_prob_yes_nb)

## Setting levels: control = FALSE, case = TRUE

## Setting direction: controls < cases

# Dibujar la curva ROC
plot.roc(roc_obj_nb, main="Curva ROC", col="blue")

# Calcular el AUC
auc(roc_obj_nb)

## Area under the curve: 0.8283

Matriz de Confusion Bayes

# Calcular la matriz de confusión
conf_matrix1 <- confusionMatrix(predicciones_nb, test$Revenue,positive = "TRUE")

# Imprimir la matriz de confusión
print(conf_matrix1)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction FALSE TRUE
##      FALSE  2034  130
##      TRUE    451  300
##                                           
##                Accuracy : 0.8007          
##                  95% CI : (0.7857, 0.8151)
##     No Information Rate : 0.8525          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.3944          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.6977          
##             Specificity : 0.8185          
##          Pos Pred Value : 0.3995          
##          Neg Pred Value : 0.9399          
##              Prevalence : 0.1475          
##          Detection Rate : 0.1029          
##    Detection Prevalence : 0.2576          
##       Balanced Accuracy : 0.7581          
##                                           
##        'Positive' Class : TRUE            
## 

Regresion Logistica

modelo_logistico <- glm(Revenue ~ ., data = train, family = binomial, weights = ifelse(train$Revenue == TRUE, 5, 1))

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

# Resumen del modelo
summary(modelo_logistico)

## 
## Call:
## glm(formula = Revenue ~ ., family = binomial, data = train, weights = ifelse(train$Revenue == 
##     TRUE, 5, 1))
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -4.075e-01  1.857e-01  -2.194  0.02820 *  
## Administrative                1.824e-02  1.126e-02   1.620  0.10515    
## Administrative_Duration       1.883e-05  1.967e-04   0.096  0.92371    
## Informational                 4.902e-02  2.668e-02   1.838  0.06613 .  
## Informational_Duration       -2.637e-04  2.516e-04  -1.048  0.29460    
## ProductRelated               -2.506e-03  1.594e-03  -1.573  0.11582    
## ProductRelated_Duration       2.966e-04  4.432e-05   6.692 2.19e-11 ***
## BounceRates                  -7.921e+00  2.756e+00  -2.873  0.00406 ** 
## ExitRates                    -1.222e+01  2.013e+00  -6.073 1.26e-09 ***
## PageValues                    1.272e-01  3.584e-03  35.482  < 2e-16 ***
## SpecialDay                   -2.149e-01  2.066e-01  -1.040  0.29822    
## MonthDec                     -8.568e-01  1.637e-01  -5.234 1.66e-07 ***
## MonthFeb                     -1.703e+00  4.281e-01  -3.978 6.96e-05 ***
## MonthJul                     -1.574e-01  1.986e-01  -0.792  0.42810    
## MonthJune                    -8.848e-01  2.736e-01  -3.234  0.00122 ** 
## MonthMar                     -8.547e-01  1.623e-01  -5.268 1.38e-07 ***
## MonthMay                     -9.763e-01  1.586e-01  -6.156 7.45e-10 ***
## MonthNov                      3.095e-01  1.495e-01   2.071  0.03840 *  
## MonthOct                     -1.165e-01  1.851e-01  -0.629  0.52930    
## MonthSep                      3.113e-01  1.847e-01   1.686  0.09187 .  
## OperatingSystems             -4.403e-02  3.413e-02  -1.290  0.19700    
## Browser                       2.143e-02  1.725e-02   1.243  0.21401    
## Region                       -1.180e-02  1.213e-02  -0.973  0.33068    
## TrafficType                   1.774e-02  7.471e-03   2.374  0.01759 *  
## VisitorTypeOther             -8.914e-01  5.527e-01  -1.613  0.10678    
## VisitorTypeReturning_Visitor -3.979e-01  8.147e-02  -4.883 1.04e-06 ***
## WeekendTRUE                   8.066e-02  6.576e-02   1.227  0.21999    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 12802.5  on 5829  degrees of freedom
## Residual deviance:  7516.8  on 5803  degrees of freedom
## AIC: 7570.8
## 
## Number of Fisher Scoring iterations: 7

Curva ROC y AUC Modelo Logistico

prediccionesml <- predict(modelo_logistico, type = "response")

# Crear un objeto 'roc' para calcular AUC
roc_objeto_ml <- roc(modelo_logistico$y, prediccionesml)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

# Dibujar la curva ROC
plot.roc(roc_objeto_ml, main="Curva ROC", col="blue")

# Calcular el AUC
auc(roc_objeto_ml)

## Area under the curve: 0.9148

Matriz de Confusion Modelo Logistico

min_length <- min(length(as.factor(ifelse(prediccionesml > 0.5, "TRUE", "FALSE"))), length(test$Revenue))
predicciones_ajustadas <- as.factor(ifelse(prediccionesml > 0.5, "TRUE", "FALSE"))[1:min_length]
test_ajustado <- test$Revenue[1:min_length]

# Calcular la matriz de confusión
confusion_glm <- confusionMatrix(predicciones_ajustadas, as.factor(test_ajustado), positive = "TRUE")
print(confusion_glm)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction FALSE TRUE
##      FALSE  2166  370
##      TRUE    319   60
##                                          
##                Accuracy : 0.7636         
##                  95% CI : (0.7478, 0.779)
##     No Information Rate : 0.8525         
##     P-Value [Acc > NIR] : 1.0000         
##                                          
##                   Kappa : 0.0117         
##                                          
##  Mcnemar's Test P-Value : 0.0568         
##                                          
##             Sensitivity : 0.13953        
##             Specificity : 0.87163        
##          Pos Pred Value : 0.15831        
##          Neg Pred Value : 0.85410        
##              Prevalence : 0.14751        
##          Detection Rate : 0.02058        
##    Detection Prevalence : 0.13002        
##       Balanced Accuracy : 0.50558        
##                                          
##        'Positive' Class : TRUE           
## 

LDA

library(MASS)

## 
## Attaching package: 'MASS'

## The following object is masked from 'package:dplyr':
## 
##     select

set.seed (123)

modelolda <- lda(Revenue ~ ., data = train)
prediccioneslda <- predict(modelolda, newdata = test)$class

par(mar=c(2,2,2,2))
plot(modelolda)

summary(modelolda)

##         Length Class  Mode     
## prior    2     -none- numeric  
## counts   2     -none- numeric  
## means   52     -none- numeric  
## scaling 26     -none- numeric  
## lev      2     -none- character
## svd      1     -none- numeric  
## N        1     -none- numeric  
## call     3     -none- call     
## terms    3     terms  call     
## xlevels  2     -none- list

Matriz de confusion LDA

confusion_lda <- confusionMatrix(prediccioneslda, as.factor(test$Revenue), positive = "TRUE")
print(confusion_lda)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction FALSE TRUE
##      FALSE  2444  279
##      TRUE     41  151
##                                           
##                Accuracy : 0.8902          
##                  95% CI : (0.8783, 0.9013)
##     No Information Rate : 0.8525          
##     P-Value [Acc > NIR] : 1.423e-09       
##                                           
##                   Kappa : 0.434           
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.35116         
##             Specificity : 0.98350         
##          Pos Pred Value : 0.78646         
##          Neg Pred Value : 0.89754         
##              Prevalence : 0.14751         
##          Detection Rate : 0.05180         
##    Detection Prevalence : 0.06587         
##       Balanced Accuracy : 0.66733         
##                                           
##        'Positive' Class : TRUE            
## 

Curva ROC y AUC LDA

prediccion_prob_nb <- predict(modelolda, test, type = "response")$posterior[, "TRUE"]

# Crear el objeto 'roc'
roc_objeto_lda <- roc(response = test$Revenue, predictor = prediccion_prob_nb)

## Setting levels: control = FALSE, case = TRUE

## Setting direction: controls < cases

plot.roc(roc_objeto_lda, main="Curva ROC", col="blue")

# Imprimir el área bajo la curva (AUC)
auc_lda <- auc(roc_objeto_lda)

print(auc_lda)

## Area under the curve: 0.8943

Conclusion

Con base en el desbalanceo y las métricas de cada modelo, se determina que CART es el más conveniente a utilizar, ya que el árbol de decisión es capaz de clasificar correctamente las clases minoritarias, incluso en conjuntos de datos desequilibrados. Esto se debe a que el CART utiliza un algoritmo de aprendizaje basado en reglas que le permite identificar las características que son más discriminantes para cada clase. Además, presenta el AUC más alto con 0.895; y una diferencia de 0.4 entre la especifidad de 0.96 y la sensibilidad de 0.51