Trabajo Final

Lectura de datos

#install.packages("readxl")
library(readxl)

data <- read_excel("../data/Base Corp Bancaria.XLS")
data

## # A tibble: 150 × 13
##       Id Sector   VENTAS  CREVEN     REOP   RENNET ROTCAT ROTINV CAJAPRO  CAPTRA
##    <dbl> <chr>     <dbl>   <dbl>    <dbl>    <dbl>  <dbl>  <dbl>   <dbl>   <dbl>
##  1     1 Ind      2.01e5  0.0129  0.0408  -1.04e-2  39.4  8.50e1 -1.27e5  1.46e4
##  2     2 Servicio 1.31e6  0.101  -0.255   -2.13e-1  23.1  1.60e1 -1.38e6 -2.00e5
##  3     3 Servicio 4.05e2  0.605   0.309    2.92e-2 209.   0       2.61e2 -1.98e2
##  4     4 Agro     3.05e3 -0.0966 -0.00540  9.55e-4   1.81 4.22e0 -2.58e3 -3.17e1
##  5     5 Servicio 4.57e3 -0.174   0.249    1.41e-1  41.5  0      -6.88e2  5.36e2
##  6     6 Agro     5.13e2  1.70   -0.516   -7.51e-1 187.   9.51e1 -4.10e2 -2.84e2
##  7     7 Servicio 1.90e3  0.227   0.0133   1.24e-2  44.7  3.14e1 -1.58e3  3.76e2
##  8     8 Servicio 1.64e4 -0.225  -0.195    1.04e-2 389.   1.10e3 -9.62e3 -1.35e4
##  9     9 Ind      7.3 e1 -0.109   0.35     3.5 e-1  58.8  0       2.63e1  4.26e1
## 10    10 Ind      2.20e3  0.131   0.285    1.18e-1  96.4  3.40e1 -7.03e2  9.00e2
## # ℹ 140 more rows
## # ℹ 3 more variables: RAZCO <dbl>, AUDEU <dbl>, TipoCliente <chr>

Exploracion de los datos

str(data)

## tibble [150 × 13] (S3: tbl_df/tbl/data.frame)
##  $ Id         : num [1:150] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Sector     : chr [1:150] "Ind" "Servicio" "Servicio" "Agro" ...
##  $ VENTAS     : num [1:150] 200782 1307317 405 3046 4575 ...
##  $ CREVEN     : num [1:150] 0.0129 0.1006 0.6052 -0.0966 -0.1739 ...
##  $ REOP       : num [1:150] 0.0408 -0.2548 0.3095 -0.0054 0.2493 ...
##  $ RENNET     : num [1:150] -0.010388 -0.213042 0.029151 0.000955 0.140959 ...
##  $ ROTCAT     : num [1:150] 39.35 23.08 209.37 1.81 41.55 ...
##  $ ROTINV     : num [1:150] 84.95 16 0 4.22 0 ...
##  $ CAJAPRO    : num [1:150] -127443 -1384286 261 -2585 -688 ...
##  $ CAPTRA     : num [1:150] 14615.1 -199651.9 -198.4 -31.7 535.8 ...
##  $ RAZCO      : num [1:150] 1.25 0.544 0.567 0.711 1.609 ...
##  $ AUDEU      : num [1:150] -0.1571 -0.288 0.0245 -0.1797 -0.0744 ...
##  $ TipoCliente: chr [1:150] "A" "B" "A" "A" ...

Sector es la unica variable categorica, las demas son numericas. La variable a a clasificar es TipoCliente. Hay que eliminar la variable Id.

unique(data$TipoCliente)

## [1] "A" "B" "D" "C"

Hay que clasificar en 4 categorias, A, B, C y D.

sum(is.na(data))

## [1] 0

No hay valores nulos (GOD)

summary(data)

##        Id            Sector              VENTAS              CREVEN        
##  Min.   :  1.00   Length:150         Min.   :     15.7   Min.   :-0.66609  
##  1st Qu.: 38.25   Class :character   1st Qu.:    868.1   1st Qu.:-0.01191  
##  Median : 75.50   Mode  :character   Median :   3059.0   Median : 0.14427  
##  Mean   : 75.50                      Mean   :  25572.7   Mean   : 0.55087  
##  3rd Qu.:112.75                      3rd Qu.:  11665.5   3rd Qu.: 0.38826  
##  Max.   :150.00                      Max.   :1307316.8   Max.   :31.06180  
##       REOP              RENNET              ROTCAT            ROTINV       
##  Min.   :-3.30079   Min.   :-0.751462   Min.   :-349.51   Min.   :   0.00  
##  1st Qu.: 0.02194   1st Qu.: 0.001020   1st Qu.:  24.65   1st Qu.:   0.00  
##  Median : 0.05771   Median : 0.019720   Median :  59.24   Median :  16.59  
##  Mean   : 0.05482   Mean   : 0.007681   Mean   :  72.06   Mean   :  59.17  
##  3rd Qu.: 0.11509   3rd Qu.: 0.043939   3rd Qu.:  86.81   3rd Qu.:  70.24  
##  Max.   : 0.75003   Max.   : 0.418695   Max.   : 640.70   Max.   :1097.86  
##     CAJAPRO               CAPTRA              RAZCO              AUDEU         
##  Min.   :-1384286.3   Min.   :-199651.9   Min.   : 0.09751   Min.   :-0.74305  
##  1st Qu.:   -7274.8   1st Qu.:    -32.6   1st Qu.: 0.94965   1st Qu.:-0.09087  
##  Median :   -1599.1   Median :    103.5   Median : 1.29449   Median : 0.01200  
##  Mean   :  -21025.8   Mean   :   -434.3   Mean   : 1.80923   Mean   : 0.15159  
##  3rd Qu.:    -359.1   3rd Qu.:    835.3   3rd Qu.: 1.85248   3rd Qu.: 0.10196  
##  Max.   :   12063.5   Max.   :  28027.0   Max.   :15.48785   Max.   :10.38674  
##  TipoCliente       
##  Length:150        
##  Class :character  
##  Mode  :character  
##                    
##                    
## 

Vamos a separar los datos entre la variable a clasificar y los datos.

# Separar la variable a clasificar

y <- data$TipoCliente

X <- data[, -which(names(data) %in% c("TipoCliente", "Id"))]

Cuantas observaciones hay por cada categoria?

table(y)

## y
##   A   B   C   D 
## 120  17   8   5

No vamos a obtener resultados muy buenos, hay muy pocas observaciones de C y D.

Vamos a separar la variable a clasificar de las demas, estandarizar con Z-score los datos numericos (eso lo hace automaticamente la regresion logistica, no es necesario hacerlo antes) y a aplicar one hot encoding a las variables categoricas.

Ademas, hay que dividir las variables en train y test.

#install.packages("readxl")
library(readxl)

data <- read_excel("../data/Base Corp Bancaria.XLS")

# Cargar librerías necesarias
library(dplyr)

## 
## Adjuntando el paquete: 'dplyr'

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

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

library(caret)

## Cargando paquete requerido: ggplot2

## Cargando paquete requerido: lattice

library(fastDummies)

# Supongamos que 'data' es el dataframe original
data <- subset(data, select = -Id)  # Eliminar la columna Id

# Definir la variable objetivo (y) antes de transformaciones
y <- data$TipoCliente
X <- subset(data, select = -TipoCliente)  # Variables predictoras

# Separar variables numéricas y categóricas (excluyendo 'TipoCliente')
num_vars <- select_if(X, is.numeric)
cat_vars <- select_if(X, is.character)

# Normalizar las variables numéricas
num_vars <- as.data.frame(scale(num_vars))

# Aplicar One-Hot Encoding a las categóricas
cat_vars <- fastDummies::dummy_cols(cat_vars, remove_first_dummy = TRUE, remove_selected_columns = TRUE)

# Combinar nuevamente las variables transformadas
X <- cbind(num_vars, cat_vars)  # Este será el conjunto de variables predictoras

# Dividir en train y test (85% train, 15% test)
set.seed(123)  # Para reproducibilidad
train_index <- createDataPartition(y, p = 0.85, list = FALSE)
X_train <- X[train_index, ]
X_test <- X[-train_index, ]
y_train <- y[train_index]
y_test <- y[-train_index]

# Mostrar dimensiones finales de los conjuntos
cat("Dimensiones de X_train:", dim(X_train), "\n")

## Dimensiones de X_train: 129 12

cat("Dimensiones de X_test:", dim(X_test), "\n")

## Dimensiones de X_test: 21 12

cat("Dimensiones de y_train:", length(y_train), "\n")

## Dimensiones de y_train: 129

cat("Dimensiones de y_test:", length(y_test), "\n")

## Dimensiones de y_test: 21

X_test

##          VENTAS      CREVEN        REOP      RENNET      ROTCAT      ROTINV
## 1    1.52118475 -0.20178808 -0.04495681 -0.13518510 -0.35155107  0.21670455
## 3   -0.21850399  0.02036500  0.81743552  0.16061815  1.47570343 -0.49724999
## 13  -0.22100053 -0.04233520  0.02626236  0.11889235 -0.03990836  1.18024031
## 22   2.43692028 -0.15578631 -0.11248756  0.11401412 -0.77448593 -0.49724999
## 26  -0.21782792 -0.07924558  0.12067748 -0.36873098 -0.32822279 -0.36293577
## 31   0.10464961 -0.15008378  0.46512416  0.19389123 -0.52460221 -0.42824536
## 37  -0.05298852 -0.20180326  0.10685465  0.21957943 -0.12397072  0.39399198
## 43  -0.16821691 -0.19673486 -0.10027025  0.02003162 -0.61236300 -0.09028207
## 47  -0.21563283 -0.01825601  0.40288525  0.21539207 -0.36901494 -0.49724999
## 69  -0.19165586 -0.17598293  0.95762889  1.75560653 -0.77448593 -0.49724999
## 80  -0.11076972 -0.09069839 -0.12443934 -0.05615936 -0.51029268 -0.49628250
## 84  -0.18293861 -0.11934078  0.37695733  0.44480073  0.75417376  0.73895214
## 85  -0.21666990 -0.08798756  0.15863687  0.26933196 -0.07391952  0.05848637
## 92   0.65515546 -0.14009920  0.08857715 -0.02187741  0.12563567  0.50330267
## 96  -0.21302317 -0.17894206  0.12354204  0.32642722 -0.26877658 -0.49724999
## 109 -0.16416021 -0.14642273  0.06404791  0.38245808 -0.43326987 -0.46341785
## 117 -0.18019333 -0.21154649 -0.03879082  0.13414305 -0.04880179 -0.49724999
## 123 -0.20232944 -0.45645045 -0.08003355 -1.08633603  0.18356567 -0.49724999
## 127 -0.22188836 -0.22199617  0.04730686  0.13827900 -0.77201683 -0.49724999
## 147 -0.21925300 -0.05707611 -0.17828324 -0.03332703 -0.08396380 -0.32449078
## 150  0.02343346 -0.23225551 -0.43390191  0.37499620  2.97576311 -0.43909112
##         CAJAPRO      CAPTRA       RAZCO       AUDEU Sector_Ind Sector_Servicio
## 1   -0.90475292  0.86443924 -0.28031122 -0.32615013          1               0
## 3    0.18097650  0.01355078 -0.62270874 -0.13430638          0               1
## 13   0.17800592  0.02665343 -0.06530083  0.03608758          0               1
## 22  -1.82355056  0.56323615 -0.26157385 -0.37079154          0               1
## 26   0.17623828  0.02707906 -0.06982486 -0.15772498          1               0
## 31   0.01600305 -0.08620079 -0.51456587 -0.16635147          0               1
## 37   0.06484336  0.12920176 -0.27151127 -0.25714361          1               0
## 43   0.13011018  0.07130619  0.31103687  0.38203910          1               0
## 47   0.17502820  0.02891140 -0.22953626 -0.01272092          1               0
## 69   0.17871022  0.05655673 -0.13232651 -0.33380810          0               1
## 80   0.07755478  0.03836374 -0.32429768 -0.16378917          0               1
## 84   0.16469954  0.12284487  0.55004576 -0.36017228          1               0
## 85   0.17712623  0.01736652 -0.62479500 -0.14934250          1               0
## 92  -0.47942128  0.52438599 -0.31259827 -0.09169528          1               0
## 96   0.17417214  0.02435296 -0.42810355 -0.33678666          0               1
## 109  0.13450066  0.01819538 -0.46806310 -0.22298953          0               0
## 117  0.14889725  0.05424305 -0.17069176 -0.25019099          0               1
## 123  0.16132674  0.01882837 -0.46104205  0.03567836          0               1
## 127  0.17876021  0.02512495 -0.02939729  1.74586018          0               1
## 147  0.17772663  0.02975232  0.87713810 -0.35875502          0               1
## 150  0.28132349 -1.74375518 -0.65824577  0.05151516          1               0

MODELO LOGISTICO

#install.packages("caret")
#install.packages("glmnet")
#install.packages("MLmetrics")

library(MLmetrics)

## 
## Adjuntando el paquete: 'MLmetrics'

## The following objects are masked from 'package:caret':
## 
##     MAE, RMSE

## The following object is masked from 'package:base':
## 
##     Recall

library(caret)
library(glmnet)

## Cargando paquete requerido: Matrix

## Loaded glmnet 4.1-8

# Configurar la validación cruzada (K-Fold Cross Validation)
set.seed(123)  # Para reproducibilidad
cv_control <- trainControl(
  method = "cv",  # Validación cruzada
  number = 10,
  classProbs = TRUE,
  summaryFunction = multiClassSummary
)

# Definir la búsqueda de hiperparámetros
grid <- expand.grid(
  alpha = seq(0, 1, by = 0.05),  # Elastic Net: 0 = Ridge, 1 = Lasso, 0.5 = combinación
  lambda = 10^seq(-2, 1, length.out = 100)  # Regularización lambda
)

# Ajustar el modelo con Grid Search
modelo_logistico <- suppressWarnings(train(
  x = X_train,
  y = as.factor(y_train),  
  method = "glmnet",
  trControl = cv_control,
  tuneGrid = grid,
  metric = "Accuracy",
  family = "multinomial",
  preProcess = c("center", "scale")
))

best_lambda <- modelo_logistico$bestTune$lambda
best_alpha <- modelo_logistico$bestTune$alpha

print(paste("Mejor lambda:", best_lambda))

## [1] "Mejor lambda: 0.533669923120631"

print(paste("Mejor alpha:", best_alpha))

## [1] "Mejor alpha: 0"

regresion_logistica <- suppressWarnings(glmnet(
  x = as.matrix(X_train),  
  y = as.factor(y_train),        
  alpha = best_alpha,      
  lambda = best_lambda,    
  family = "multinomial",
  preProcess = c("center", "scale")
))

Obtenemos alpha = 0 y lambda = 0.533669923120631, es una regresion ridge.

Estos son los coeficientes de la matriz Beta:

library(Matrix)

coefs_A <- as.matrix(coef(regresion_logistica)$A)
coefs_B <- as.matrix(coef(regresion_logistica)$B)
coefs_C <- as.matrix(coef(regresion_logistica)$C)
coefs_D <- as.matrix(coef(regresion_logistica)$D)

coef_df <- data.frame(Variable = rownames(coefs_A),
                      Clase_A = coefs_A[,1],
                      Clase_B = coefs_B[,1],
                      Clase_C = coefs_C[,1],
                      Clase_D = coefs_D[,1])

print(coef_df)

##                        Variable      Clase_A      Clase_B      Clase_C
##                                  1.930342684 -0.053235642 -0.755408515
## VENTAS                   VENTAS -0.067984816  0.082587671 -0.006487609
## CREVEN                   CREVEN  0.034879635 -0.023612008 -0.008853504
## REOP                       REOP -0.004219053  0.010455323  0.009809657
## RENNET                   RENNET  0.016676330  0.026110562  0.004747563
## ROTCAT                   ROTCAT -0.071836171  0.007768072  0.065276055
## ROTINV                   ROTINV  0.013625060  0.022543397 -0.014475057
## CAJAPRO                 CAJAPRO  0.056509258 -0.070429016  0.005629910
## CAPTRA                   CAPTRA  0.028458801 -0.034964379  0.003725232
## RAZCO                     RAZCO -0.034314475 -0.011877867  0.079294755
## AUDEU                     AUDEU -0.084873995  0.084772679 -0.005339554
## Sector_Ind           Sector_Ind -0.133443917  0.128947736 -0.051842184
## Sector_Servicio Sector_Servicio  0.102227214 -0.129936783  0.018643451
##                      Clase_D
##                 -1.121698527
## VENTAS          -0.008115246
## CREVEN          -0.002414123
## REOP            -0.016045927
## RENNET          -0.047534454
## ROTCAT          -0.001207956
## ROTINV          -0.021693399
## CAJAPRO          0.008289848
## CAPTRA           0.002780345
## RAZCO           -0.033102414
## AUDEU            0.005440870
## Sector_Ind       0.056338365
## Sector_Servicio  0.009066118

Este es el accuracy y la matriz de confusion:

regresion_logistica <- suppressWarnings(glmnet(
  x = as.matrix(X_train),  
  y = as.factor(y_train),        
  alpha = best_alpha,      
  lambda = best_lambda,    
  family = "multinomial",
  preProcess = c("center", "scale")   
))

# Predecir con el modelo
X_test_matrix <- as.matrix(X_test)  # Convertir a matriz
predicciones <- predict(regresion_logistica, newx = X_test_matrix, type = "response")

# Seleccionar la clase con mayor probabilidad para cada observación
predicciones_clases <- colnames(predicciones)[apply(predicciones, 1, which.max)]

# Convertir predicciones a factor con los niveles de y_test
predicciones_clases <- factor(predicciones_clases, levels = levels(y_test))

# Convertir y_test a factor
y_test <- factor(y_test)

# Convertir predicciones_clases a factor con los mismos niveles de y_test
predicciones_clases <- factor(predicciones_clases, levels = levels(y_test))

# Calcular la matriz de confusión
library(caret)
matriz_confusion <- confusionMatrix(predicciones_clases, y_test)

# Mostrar la matriz de confusión
print(matriz_confusion)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction A B C
##          A 0 0 0
##          B 0 0 0
##          C 0 0 0
## 
## Overall Statistics
##                                   
##                Accuracy : NaN     
##                  95% CI : (NA, NA)
##     No Information Rate : NA      
##     P-Value [Acc > NIR] : NA      
##                                   
##                   Kappa : NaN     
##                                   
##  Mcnemar's Test P-Value : NA      
## 
## Statistics by Class:
## 
##                      Class: A Class: B Class: C
## Sensitivity                NA       NA       NA
## Specificity                NA       NA       NA
## Pos Pred Value             NA       NA       NA
## Neg Pred Value             NA       NA       NA
## Prevalence                NaN      NaN      NaN
## Detection Rate            NaN      NaN      NaN
## Detection Prevalence      NaN      NaN      NaN
## Balanced Accuracy          NA       NA       NA

Como se dijo al inicio, no se obtienen buenos resultados porque hay muy pocas observaciones de C y de D. El modelo tiene un accuracy de 0.85 en test. Casualmente, en la separacion de Train y Test, todas las D’s se fueron a Train.

MODELO DE Analisis de Discriminante:

# Cargar librerías necesarias
library(MASS)

## 
## Adjuntando el paquete: 'MASS'

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

library(caret)

# Asegurar que y es un factor
y <- as.factor(y)

# Configurar la validación cruzada (10-fold CV)
control_cv <- trainControl(method = "cv", number = 10)

# Entrenar el modelo LDA con Cross Validation
modelo_lda_cv <- train(x = X_train, y = y_train, 
                       method = "lda", 
                       trControl = control_cv,
                       preProcess = c("center", "scale"))

# Predecir con el modelo validado
predicciones <- predict(modelo_lda_cv, newdata = X_test)

# Crear la matriz de confusión
matriz_confusion <- table(Predicho = predicciones, Real = y_test)

# Calcular el accuracy final
accuracy <- sum(diag(matriz_confusion)) / sum(matriz_confusion)

# Mostrar resultados finales
cat("\nAccuracy después de Cross Validation:", accuracy, "\n")

## 
## Accuracy después de Cross Validation: 0.7619048

print(matriz_confusion)

##         Real
## Predicho  A  B  C
##        A 16  2  0
##        B  2  0  1
##        C  0  0  0
##        D  0  0  0

Este modelo mas sensillo con peor accuracy en test

MODELO DE ARBOL DE DECISION

para este modelo no hay que estandarizar

# Instalar y cargar paquetes necesarios
if (!requireNamespace("readxl", quietly = TRUE)) install.packages("readxl")
if (!requireNamespace("dplyr", quietly = TRUE)) install.packages("dplyr")
if (!requireNamespace("caret", quietly = TRUE)) install.packages("caret")
if (!requireNamespace("fastDummies", quietly = TRUE)) install.packages("fastDummies")

library(readxl)
library(dplyr)
library(caret)
library(fastDummies)

# Cargar datos
data <- read_excel("../data/Base Corp Bancaria.XLS")

# Eliminar columna 'id' si existe
data <- subset(data, select = -Id)

# Definir la variable objetivo
y <- data$TipoCliente
X <- subset(data, select = -TipoCliente)

# Separar variables numéricas y categóricas
num_vars <- select_if(X, is.numeric)
cat_vars <- select_if(X, is.character)

# Aplicar One-Hot Encoding a las categóricas
cat_vars <- fastDummies::dummy_cols(cat_vars, remove_first_dummy = TRUE, remove_selected_columns = TRUE)

# Combinar nuevamente las variables transformadas
X <- cbind(num_vars, cat_vars)

# Dividir en train y test (85% train, 15% test)
set.seed(123)  # Para reproducibilidad
train_index <- createDataPartition(y, p = 0.85, list = FALSE)

X_train <- X[train_index, , drop = FALSE]
X_test <- X[-train_index, , drop = FALSE]
y_train <- y[train_index]
y_test <- y[-train_index]

# Cargar librerías
library(caret)
library(rpart)
library(rpart.plot)

# Convertimos y_train en factor para clasificación
df <- data.frame(X_train, y = as.factor(y_train))

# Definir control del árbol con minsplit y maxdepth
control_rpart <- rpart.control(minsplit = 1,  # Mínimo de observaciones para dividir un nodo
                               maxdepth = 10, # Profundidad máxima del árbol
                               minbucket = 1) # Mínimo de observaciones en un nodo terminal

# Definir la búsqueda en malla (grid search) para ajustar el hiperparámetro cp
grid <- expand.grid(cp = seq(0.001, 10, by = 0.005))  # Complexity Parameter

# Configurar la validación cruzada (cross-validation)
control_caret <- trainControl(method = "cv", number = 10)  # 10-fold cross-validation

# Entrenar el modelo con búsqueda de hiperparámetros
modelo <- train(y ~ ., data = df, method = "rpart", 
                trControl = control_caret, tuneGrid = grid,
                control = control_rpart)  # Aquí pasamos los otros hiperparámetros

# Realizar predicciones en los datos de prueba
predicciones <- predict(modelo, newdata = X_test, type = "raw")

# Convertir y_test en factor con los mismos niveles que df$y
y_test <- factor(y_test, levels = levels(df$y))
predicciones <- factor(predicciones, levels = levels(df$y))

# Eliminar niveles vacíos
y_test <- droplevels(y_test)
predicciones <- droplevels(predicciones)

# Calcular la matriz de confusión
conf_matrix <- confusionMatrix(predicciones, y_test)

## Warning in levels(reference) != levels(data): longitud de objeto mayor no es
## múltiplo de la longitud de uno menor

## Warning in confusionMatrix.default(predicciones, y_test): Levels are not in the
## same order for reference and data. Refactoring data to match.

# Mostrar la matriz de confusión y el accuracy
print(conf_matrix$table)

##           Reference
## Prediction  A  B  C
##          A 16  2  1
##          B  2  0  0
##          C  0  0  0

accuracy <- conf_matrix$overall["Accuracy"]
cat("Accuracy del modelo:", accuracy, "\n")

## Accuracy del modelo: 0.7619048

# Visualizar el árbol
rpart.plot(modelo$finalModel, type = 4, extra = 101, under = TRUE, 
           box.palette = "RdYlGn", # Rojo → Amarillo → Verde
           main = "Árbol de Decisión Optimizado")

Todo lo manda a A xD

---

PCA

Como siempre, lo primero es aplicar one hot encoding a las categoricas y luego normalizar todo el dataframe, pero eso lo hace automaticamente R al pedirle el PCA.

library(dplyr)
library(fastDummies)
library(caret)
library(readxl)

# Leer los datos
data_antes_de_PCA <- read_excel("../data/Base Corp Bancaria.XLS")

# Eliminar la columna Id
data_antes_de_PCA <- data_antes_de_PCA[, -which(names(data_antes_de_PCA) %in% c("Id"))]

# Identificar variables categóricas
categorical_vars <- sapply(data_antes_de_PCA, is.factor) | sapply(data_antes_de_PCA, is.character)

# Aplicar One-Hot Encoding a todas las variables categóricas
data_encoded <- dummy_cols(data_antes_de_PCA, select_columns = names(data_antes_de_PCA)[categorical_vars], 
                           remove_first_dummy = TRUE, remove_selected_columns = TRUE)

data_encoded

## # A tibble: 150 × 15
##     VENTAS  CREVEN     REOP   RENNET ROTCAT ROTINV CAJAPRO  CAPTRA RAZCO   AUDEU
##      <dbl>   <dbl>    <dbl>    <dbl>  <dbl>  <dbl>   <dbl>   <dbl> <dbl>   <dbl>
##  1  2.01e5  0.0129  0.0408  -1.04e-2  39.4  8.50e1 -1.27e5  1.46e4 1.25  -0.157 
##  2  1.31e6  0.101  -0.255   -2.13e-1  23.1  1.60e1 -1.38e6 -2.00e5 0.544 -0.288 
##  3  4.05e2  0.605   0.309    2.92e-2 209.   0       2.61e2 -1.98e2 0.567  0.0245
##  4  3.05e3 -0.0966 -0.00540  9.55e-4   1.81 4.22e0 -2.58e3 -3.17e1 0.711 -0.180 
##  5  4.57e3 -0.174   0.249    1.41e-1  41.5  0      -6.88e2  5.36e2 1.61  -0.0744
##  6  5.13e2  1.70   -0.516   -7.51e-1 187.   9.51e1 -4.10e2 -2.84e2 0.617  1.57  
##  7  1.90e3  0.227   0.0133   1.24e-2  44.7  3.14e1 -1.58e3  3.76e2 9.80  -0.341 
##  8  1.64e4 -0.225  -0.195    1.04e-2 389.   1.10e3 -9.62e3 -1.35e4 0.669  0.0583
##  9  7.3 e1 -0.109   0.35     3.5 e-1  58.8  0       2.63e1  4.26e1 2.50  10.4   
## 10  2.20e3  0.131   0.285    1.18e-1  96.4  3.40e1 -7.03e2  9.00e2 1.72   0.0169
## # ℹ 140 more rows
## # ℹ 5 more variables: Sector_Ind <int>, Sector_Servicio <int>,
## #   TipoCliente_B <int>, TipoCliente_C <int>, TipoCliente_D <int>

El tipo de cliente A es cuando B, C y D son 0. Igual que Sector Agro es cuando Industria y Servicio son 0

# Aplicar PCA correctamente
pca_result <- prcomp(data_encoded, center = TRUE, scale. = TRUE)
data_pca <- as.data.frame(pca_result$x)

# Mostrar resumen de la varianza explicada
summary(pca_result)

## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     1.7352 1.4066 1.2761 1.15598 1.08695 1.04026 0.99191
## Proportion of Variance 0.2007 0.1319 0.1086 0.08909 0.07876 0.07214 0.06559
## Cumulative Proportion  0.2007 0.3326 0.4412 0.53028 0.60904 0.68118 0.74678
##                            PC8     PC9    PC10   PC11    PC12    PC13    PC14
## Standard deviation     0.96505 0.85432 0.82061 0.7520 0.65794 0.54850 0.40202
## Proportion of Variance 0.06209 0.04866 0.04489 0.0377 0.02886 0.02006 0.01077
## Cumulative Proportion  0.80886 0.85752 0.90241 0.9401 0.96897 0.98903 0.99980
##                          PC15
## Standard deviation     0.0546
## Proportion of Variance 0.0002
## Cumulative Proportion  1.0000

Vamos a trabajar con al menos el 80% de la variabilidad de nuestros datos

# Calcular la proporción acumulada de varianza explicada
var_acumulada <- cumsum((pca_result$sdev^2) / sum(pca_result$sdev^2))

# Encontrar el número mínimo de componentes que explican al menos el 90% de la varianza
num_componentes <- min(which(var_acumulada >= 0.80))

# Seleccionar solo las columnas necesarias en los datos transformados
data_pca <- data_pca[, 1:num_componentes]

# Mostrar cuántos componentes se seleccionaron
cat("Número de componentes seleccionados:", num_componentes, "\n")

## Número de componentes seleccionados: 8

Seleccionamos los 8 primeros componentes principales

Ahora vamos a realizar clustering con k-means para data_encoded y data_pca para ver que resultados obtenemos.

k-means para data_encoded

library(cluster)  # Para el coeficiente de silueta
#install.packages("factoextra")
#install.packages("ggplot2")
library(factoextra)  # Para visualización de clustering

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(ggplot2)

# Definir el rango de clusters a probar
k_values <- 2:10
silhouette_scores <- numeric(length(k_values))  # Vector para almacenar coeficiente de sombra

# Aplicar K-Means para cada valor de k y calcular la silueta
for (i in seq_along(k_values)) {
  k <- k_values[i]
  
  # Aplicar K-Means con k clusters
  set.seed(123)  # Para reproducibilidad
  kmeans_result <- kmeans(data_encoded, centers = k, nstart = 25)
  
  # Calcular coeficiente de silueta
  sil <- silhouette(kmeans_result$cluster, dist(data_encoded))
  silhouette_scores[i] <- mean(sil[, 3])  # Tercer columna contiene el coeficiente de silueta promedio
}

# Crear un dataframe con los resultados
df_silhouette <- data.frame(K = k_values, Silhouette = silhouette_scores)

# Graficar el coeficiente de silueta en función del número de clusters
ggplot(df_silhouette, aes(x = K, y = Silhouette)) +
  geom_line(color = "blue") +
  geom_point(size = 3) +
  labs(title = "Coeficiente de Silueta para Diferentes Valores de K",
       x = "Número de Clusters (K)",
       y = "Coeficiente de Silueta") +
  theme_minimal()

El criterio del codo nos diria en este caso que el numero apropiado de clusters esta entre 5 y 7. Escojamos 6.

k-means para data_pca

library(cluster)
library(factoextra)
library(ggplot2)

# Definir el rango de clusters a probar
k_values <- 2:10
silhouette_scores <- numeric(length(k_values))  # Vector para almacenar coeficiente de sombra

# Aplicar K-Means para cada valor de k y calcular la silueta
for (i in seq_along(k_values)) {
  k <- k_values[i]
  
  # Aplicar K-Means con k clusters
  set.seed(123)  # Para reproducibilidad
  kmeans_result <- kmeans(data_pca, centers = k, nstart = 25)
  
  # Calcular coeficiente de silueta
  sil <- silhouette(kmeans_result$cluster, dist(data_pca))
  silhouette_scores[i] <- mean(sil[, 3])  # Tercer columna contiene el coeficiente de silueta promedio
}

# Crear un dataframe con los resultados
df_silhouette <- data.frame(K = k_values, Silhouette = silhouette_scores)

# Graficar el coeficiente de silueta en función del número de clusters
ggplot(df_silhouette, aes(x = K, y = Silhouette)) +
  geom_line(color = "blue") +
  geom_point(size = 3) +
  labs(title = "Coeficiente de Silueta para Diferentes Valores de K en PCA",
       x = "Número de Clusters (K)",
       y = "Coeficiente de Silueta") +
  theme_minimal()

El criterio del codo en este caso nos indica que a lo mas hay 3 clusters.

APLICANDO K-MEANS CON LA CANTIDAD DE CLUSTERS ENCONTRADA

library(dplyr)
# Aplicar K-Means con 6 clusters a data_encoded
set.seed(123)
kmeans_result <- kmeans(data_encoded, centers = 6, nstart = 25)
kmeans_pca_result <- kmeans(data_pca, centers = 3, nstart = 25)

# Crear la nueva columna de clusters
data$Cluster_sin_PCA <- kmeans_result$cluster  # Pegarlo directamente a data_antes_de_PCA
data$Cluster_con_PCA <- kmeans_pca_result$cluster  # Pegarlo directamente a data_antes_de_PCA
data_pca$Cluster <- kmeans_pca_result$cluster  # Pegarlo a data_pca

data

## # A tibble: 150 × 14
##    Sector   VENTAS  CREVEN     REOP   RENNET ROTCAT ROTINV CAJAPRO  CAPTRA RAZCO
##    <chr>     <dbl>   <dbl>    <dbl>    <dbl>  <dbl>  <dbl>   <dbl>   <dbl> <dbl>
##  1 Ind      2.01e5  0.0129  0.0408  -1.04e-2  39.4  8.50e1 -1.27e5  1.46e4 1.25 
##  2 Servicio 1.31e6  0.101  -0.255   -2.13e-1  23.1  1.60e1 -1.38e6 -2.00e5 0.544
##  3 Servicio 4.05e2  0.605   0.309    2.92e-2 209.   0       2.61e2 -1.98e2 0.567
##  4 Agro     3.05e3 -0.0966 -0.00540  9.55e-4   1.81 4.22e0 -2.58e3 -3.17e1 0.711
##  5 Servicio 4.57e3 -0.174   0.249    1.41e-1  41.5  0      -6.88e2  5.36e2 1.61 
##  6 Agro     5.13e2  1.70   -0.516   -7.51e-1 187.   9.51e1 -4.10e2 -2.84e2 0.617
##  7 Servicio 1.90e3  0.227   0.0133   1.24e-2  44.7  3.14e1 -1.58e3  3.76e2 9.80 
##  8 Servicio 1.64e4 -0.225  -0.195    1.04e-2 389.   1.10e3 -9.62e3 -1.35e4 0.669
##  9 Ind      7.3 e1 -0.109   0.35     3.5 e-1  58.8  0       2.63e1  4.26e1 2.50 
## 10 Ind      2.20e3  0.131   0.285    1.18e-1  96.4  3.40e1 -7.03e2  9.00e2 1.72 
## # ℹ 140 more rows
## # ℹ 4 more variables: AUDEU <dbl>, TipoCliente <chr>, Cluster_sin_PCA <int>,
## #   Cluster_con_PCA <int>

# Instalar paquetes si no están instalados
if (!requireNamespace("scatterplot3d", quietly = TRUE)) install.packages("scatterplot3d")
if (!requireNamespace("plotly", quietly = TRUE)) install.packages("plotly")
if (!requireNamespace("ggplot2", quietly = TRUE)) install.packages("ggplot2")

# Cargar librerías
library(scatterplot3d)
library(plotly)

## 
## Adjuntando el paquete: 'plotly'

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

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(ggplot2)
library(dplyr)
library(tidyr)

## 
## Adjuntando el paquete: 'tidyr'

## The following objects are masked from 'package:Matrix':
## 
##     expand, pack, unpack

# Generar todas las combinaciones posibles de tres componentes principales
componentes <- colnames(data_pca)[1:8]  # Tomar solo PC1 a PC8
combinaciones <- combn(componentes, 3, simplify = FALSE)

# Crear gráficos 3D interactivos para cada combinación
graficos <- lapply(combinaciones, function(combo) {
  plot_ly(
    data = data_pca, 
    x = ~get(combo[1]), 
    y = ~get(combo[2]), 
    z = ~get(combo[3]), 
    color = ~as.factor(Cluster),
    colors = "Dark2",
    type = "scatter3d",
    mode = "markers"
  ) %>%
    layout(
      title = paste("3D PCA: ", combo[1], "-", combo[2], "-", combo[3]),
      scene = list(
        xaxis = list(title = combo[1]),
        yaxis = list(title = combo[2]),
        zaxis = list(title = combo[3])
      )
    )
})

graficos[[55]]

En los dos clusters donde se concentra la mayor variabilidad encontramos que el algoritmo basicamente aparto un dato que es extrano de todos los demas.

# Instalar y cargar librerías necesarias
#install.packages("plotly")  # Si no está instalado
library(plotly)
library(dplyr)
library(tidyr)

# Variables a considerar (excluyendo Sector, TipoCliente y Cluster_con_PCA)
numeric_vars <- c("VENTAS", "CREVEN", "REOP", "RENNET", "ROTCAT", "ROTINV", 
                  "CAJAPRO", "CAPTRA", "RAZCO", "AUDEU")

# Generar todas las combinaciones posibles de 3 variables
combinations <- combn(numeric_vars, 3, simplify = FALSE)

# Lista para almacenar los gráficos
plots <- list()

# Crear gráficos 3D para cada combinación
for (i in seq_along(combinations)) {
  vars <- combinations[[i]]
  
  # Crear gráfico interactivo con plotly
  p <- plot_ly(
    data = data, 
    x = as.formula(paste0("~", vars[1])), 
    y = as.formula(paste0("~", vars[2])), 
    z = as.formula(paste0("~", vars[3])), 
    color = ~as.factor(Cluster_sin_PCA),  # Cluster como factor para colores
    colors = c("red", "blue", "green", "purple", "orange"),  # Ajusta según número de clusters
    type = "scatter3d", 
    mode = "markers",
    marker = list(size = 5, opacity = 0.8)
  ) %>%
    layout(
      title = paste(vars[1], vars[2], vars[3], sep = " - "),
      scene = list(
        xaxis = list(title = vars[1]),
        yaxis = list(title = vars[2]),
        zaxis = list(title = vars[3])
      )
    )
  
  # Guardar en la lista de gráficos
  plots[[paste(vars, collapse = "_")]] <- p
}

#Probar todas las combinaciones, cambiar el numero
plots[[120]]