Proyecto: Análisis de Comportamiento en Datos de Crédito
Priscilla Seas
2025-12-11
Proyecto Final
Análisis de Comportamiento en Datos de Crédito
Se elige y fija el directorio a utilizar en el proyecto, junto con las librerías pertinentes para realizar el análisis. También se cargan los datos, y se realiza una revision inicial de los mismos.
###Directorio de Trabajo
setwd("~/Data Analysys/CETAV/II Q/intro a programacion/Proyecto")
###Librerias
library(dplyr)
library(tidyr)
library(ggplot2)
library(corrplot)
### Revision del conjunto de datos
BankChurners <- read.csv("~/Data Analysys/CETAV/II Q/intro a programacion/Proyecto/BankChurners.csv")
head(BankChurners)## CLIENTNUM Attrition_Flag Customer_Age Gender Dependent_count
## 1 768805383 Existing Customer 45 M 3
## 2 818770008 Existing Customer 49 F 5
## 3 713982108 Existing Customer 51 M 3
## 4 769911858 Existing Customer 40 F 4
## 5 709106358 Existing Customer 40 M 3
## 6 713061558 Existing Customer 44 M 2
## Education_Level Marital_Status Income_Category Card_Category Months_on_book
## 1 High School Married $60K - $80K Blue 39
## 2 Graduate Single Less than $40K Blue 44
## 3 Graduate Married $80K - $120K Blue 36
## 4 High School Unknown Less than $40K Blue 34
## 5 Uneducated Married $60K - $80K Blue 21
## 6 Graduate Married $40K - $60K Blue 36
## Total_Relationship_Count Months_Inactive_12_mon Contacts_Count_12_mon
## 1 5 1 3
## 2 6 1 2
## 3 4 1 0
## 4 3 4 1
## 5 5 1 0
## 6 3 1 2
## Credit_Limit Total_Revolving_Bal Avg_Open_To_Buy Total_Amt_Chng_Q4_Q1
## 1 12691 777 11914 1.335
## 2 8256 864 7392 1.541
## 3 3418 0 3418 2.594
## 4 3313 2517 796 1.405
## 5 4716 0 4716 2.175
## 6 4010 1247 2763 1.376
## Total_Trans_Amt Total_Trans_Ct Total_Ct_Chng_Q4_Q1 Avg_Utilization_Ratio
## 1 1144 42 1.625 0.061
## 2 1291 33 3.714 0.105
## 3 1887 20 2.333 0.000
## 4 1171 20 2.333 0.760
## 5 816 28 2.500 0.000
## 6 1088 24 0.846 0.311
## Naive_Bayes_Classifier_Attrition_Flag_Card_Category_Contacts_Count_12_mon_Dependent_count_Education_Level_Months_Inactive_12_mon_1
## 1 9.3448e-05
## 2 5.6861e-05
## 3 2.1081e-05
## 4 1.3366e-04
## 5 2.1676e-05
## 6 5.5077e-05
## Naive_Bayes_Classifier_Attrition_Flag_Card_Category_Contacts_Count_12_mon_Dependent_count_Education_Level_Months_Inactive_12_mon_2
## 1 0.99991
## 2 0.99994
## 3 0.99998
## 4 0.99987
## 5 0.99998
## 6 0.99994summary(BankChurners)## CLIENTNUM Attrition_Flag Customer_Age Gender
## Min. :708082083 Length:10127 Min. :26.00 Length:10127
## 1st Qu.:713036770 Class :character 1st Qu.:41.00 Class :character
## Median :717926358 Mode :character Median :46.00 Mode :character
## Mean :739177606 Mean :46.33
## 3rd Qu.:773143533 3rd Qu.:52.00
## Max. :828343083 Max. :73.00
## Dependent_count Education_Level Marital_Status Income_Category
## Min. :0.000 Length:10127 Length:10127 Length:10127
## 1st Qu.:1.000 Class :character Class :character Class :character
## Median :2.000 Mode :character Mode :character Mode :character
## Mean :2.346
## 3rd Qu.:3.000
## Max. :5.000
## Card_Category Months_on_book Total_Relationship_Count
## Length:10127 Min. :13.00 Min. :1.000
## Class :character 1st Qu.:31.00 1st Qu.:3.000
## Mode :character Median :36.00 Median :4.000
## Mean :35.93 Mean :3.813
## 3rd Qu.:40.00 3rd Qu.:5.000
## Max. :56.00 Max. :6.000
## Months_Inactive_12_mon Contacts_Count_12_mon Credit_Limit
## Min. :0.000 Min. :0.000 Min. : 1438
## 1st Qu.:2.000 1st Qu.:2.000 1st Qu.: 2555
## Median :2.000 Median :2.000 Median : 4549
## Mean :2.341 Mean :2.455 Mean : 8632
## 3rd Qu.:3.000 3rd Qu.:3.000 3rd Qu.:11068
## Max. :6.000 Max. :6.000 Max. :34516
## Total_Revolving_Bal Avg_Open_To_Buy Total_Amt_Chng_Q4_Q1 Total_Trans_Amt
## Min. : 0 Min. : 3 Min. :0.0000 Min. : 510
## 1st Qu.: 359 1st Qu.: 1324 1st Qu.:0.6310 1st Qu.: 2156
## Median :1276 Median : 3474 Median :0.7360 Median : 3899
## Mean :1163 Mean : 7469 Mean :0.7599 Mean : 4404
## 3rd Qu.:1784 3rd Qu.: 9859 3rd Qu.:0.8590 3rd Qu.: 4741
## Max. :2517 Max. :34516 Max. :3.3970 Max. :18484
## Total_Trans_Ct Total_Ct_Chng_Q4_Q1 Avg_Utilization_Ratio
## Min. : 10.00 Min. :0.0000 Min. :0.0000
## 1st Qu.: 45.00 1st Qu.:0.5820 1st Qu.:0.0230
## Median : 67.00 Median :0.7020 Median :0.1760
## Mean : 64.86 Mean :0.7122 Mean :0.2749
## 3rd Qu.: 81.00 3rd Qu.:0.8180 3rd Qu.:0.5030
## Max. :139.00 Max. :3.7140 Max. :0.9990
## Naive_Bayes_Classifier_Attrition_Flag_Card_Category_Contacts_Count_12_mon_Dependent_count_Education_Level_Months_Inactive_12_mon_1
## Min. :7.660e-06
## 1st Qu.:9.898e-05
## Median :1.815e-04
## Mean :1.600e-01
## 3rd Qu.:3.373e-04
## Max. :9.996e-01
## Naive_Bayes_Classifier_Attrition_Flag_Card_Category_Contacts_Count_12_mon_Dependent_count_Education_Level_Months_Inactive_12_mon_2
## Min. :0.00042
## 1st Qu.:0.99966
## Median :0.99982
## Mean :0.84000
## 3rd Qu.:0.99990
## Max. :0.99999View(BankChurners)
knitr::opts_chunk$set(echo = TRUE)A continuación se hace una limpieza de los datos, las columnas de “Naive_Bayes”, “Clientum”, y “Attrition Flag” se dejan por fuera ya que no se considera que estas aporten datos pertinentes para el analisis a realizar.
Credit_Data<-BankChurners%>%
select(Customer_Age:Avg_Utilization_Ratio)%>%
mutate(Income_Rating_By_Stars = case_when(
Income_Category == "Less than $40K" ~ 5,
Income_Category == "$40K - $60K" ~ 4,
Income_Category == "$60K - $80K" ~ 3,
Income_Category == "$80K - $120K" ~ 2,
Income_Category == "$120K +" ~ 1,
))%>%
mutate(Dependants=case_when(
Dependent_count <2 ~ "0-1",
Dependent_count < 4~"2-3",
Dependent_count >= 4~"4+"
))%>%
mutate(Dependants=case_when(
Dependent_count <2 ~ "0-1",
Dependent_count < 4~"2-3",
Dependent_count >= 4~"4+"
))%>%
mutate(Credit_Level=case_when(
Credit_Limit < 4549 ~ "Low",
Credit_Limit > 4549 & Credit_Limit < 34516 ~ "Mid",
Credit_Limit >= 34516 ~ "High"
))%>%
mutate(
Credit_Age_Ratio = Credit_Limit / Customer_Age
)%>%
filter(
Income_Rating_By_Stars != "Unknown",
Education_Level != "Unknown",
Marital_Status !="Unknown"
)%>%
drop_na()Se realiza una exploracion estadistica de los datos con la asistencia de corrplot. Se verifica la correlacion entre el sexo (o genero) del cliente contra el limite de credito que tiene disponible desvelando una correlacion negativa de -47 siendo las mujeres las que tienen un limite de credito muchisimo más bajo que los hombres desvelando una gran disparidad entre ambas poblaciones.
##
## Welch Two Sample t-test
##
## data: Credit_Limit by Gender
## t = -47.428, df = 4406.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -9070.118 -8350.035
## sample estimates:
## mean in group F mean in group M
## 3936.361 12646.437Tambien se calcula la correlacion entre las edades de los clientes, sin embargo no se encuentra gran diferencia entre las edades de los clientes. Esta informacion sumada a lo encontrado anteriomento nos lleva a la hipotesis que sin importar la edad, las mujeres se encuentran en una situacion de desventaja en cuanto ingresos y acceso a lineas de credito.
medidas_CDAges<-Credit_Data%>%
summarise(
promedio =mean(Customer_Age),
mediana=mean(Customer_Age),
desviacion_estandar=sd(Customer_Age),
varianza=var(Customer_Age),
minimo=min(Customer_Age),
maximo=max(Customer_Age));
t.test(Customer_Age~ Gender, data = Credit_Data)##
## Welch Two Sample t-test
##
## data: Customer_Age by Gender
## t = 0.88303, df = 7038.9, p-value = 0.3772
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -0.2059328 0.5435370
## sample estimates:
## mean in group F mean in group M
## 46.44013 46.27133Luego de una exploración más profunda se crean tablas de resumen de datos para poder análizar los datos de una forma más concisa y ordenada. Se crea una tabla de resumen con los datos de credito agrupados por genero, una tabla con la informacion de credito agrupada por genero y estado civil, y una ultima tabla que agrupa el promedio de ingresos por genero y estado civil; finalmente, se promedia el creito disponible por genero.
Summary_Table <- Credit_Data %>%
group_by(Gender) %>%
summarise(
Count = n(),
Avg_Credit = mean(Credit_Limit, na.rm = TRUE),
SD_Credit = sd(Credit_Limit, na.rm = TRUE)
)
Credit_Summary <- Credit_Data %>%
group_by(Gender, Marital_Status) %>%
summarise(
n = n(),
Avg_Credit = mean(Credit_Limit, na.rm = TRUE),
SD_Credit = sd(Credit_Limit, na.rm = TRUE))
Income_Avg <- Credit_Data %>%
group_by(Gender, Marital_Status) %>%
summarise(
Avg_Income = mean(Income_Rating_By_Stars, na.rm = TRUE)
)
AvgCreditGender <- Credit_Data %>%
group_by(Gender) %>%
summarise(Avg_Credit = mean(Credit_Limit))Visualización de los Datos
Se crea un gráfico de columnas para visualizar el comportamiento del límite de crédito en relacion al genero del cliente. Se arginan colores de alto contraste a cada poblacion para poder distinguirles claramente.
ggplot(AvgCreditGender,
aes(x = Gender, y = Avg_Credit, fill = Gender)) +
geom_col(alpha = 0.8) +
scale_fill_manual(values = c("darkred", "steelblue")) +
labs(
title = "Límite Promedio de Crédito por Género",
x = "Género",
y = "Promedio del Límite de Crédito"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5)
)
A continuacion se visualiza en un gráfico de disperción un resumen del promedio y la variación en el crédito disponible según el género.
ggplot(Credit_Summary,
aes(x = Avg_Credit,
y = SD_Credit,
color = Gender)) +
geom_point(size = 3) +
labs(
title = "Resumen de Promedio y Variación del Crédito por Género",
x = "Promedio de Crédito",
y = "Desviación Estándar del Crédito",
color = "Género"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5)
)
El tercer gráfico de barras inclinadas se crea para comparar la distribución de dependientes de acuerdo al genero del cliente. Con este gráfico se puede ver claramente que tanto hombres como mujeres tienden a tener una cantidad similar de dependeintes, excepto en la categoría de 2 a 3 dependientes donde hay una mayor cantidad de hombres responsables de multiples dependientes.
ggplot(Credit_Data,
aes(x = Dependants,
fill = Gender)) +
geom_bar(position = "dodge") +
coord_flip() +
labs(
title = "Distribución de Dependientes por Género",
x = "Cantidad de Dependientes",
y = "Cantidad de clientes",
fill = "Género"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5)
)
Matríz de Correlación
Finalmente, se crea una matriz de correlación con todos los datos numericos y ver claramente los índices de relacion entre los datos.En este punto se puede ver claramente que hay una relación positiva perfecta entre la edad del cliente y el uso que le se le da a la tarjeta de credito, indicando que a mayor edad hay más posibilidad de usar la tarjeta.La mayor correlacion negativa que se encuentra es entre mayor es la disposición a comprar menor es el promedio de uso de la tarjeta de crédito.
Datos_Num <- Credit_Data %>%
select_if(is.numeric) %>%
select(-Credit_Age_Ratio, -Income_Rating_By_Stars)
corrplot(cor(Datos_Num, use = "complete.obs"),
method = "circle",
type = "upper")
Funcion Automatizada para analizar datos numericos
Se crea una funcion automatizada para analizar el promedio, mediana, variacion estandar, minimo, maximo, y cantidad de datos nulos en las variables numericas. Esta misma se prueba con el dato de “Months_On_Book” que indica cuantos meses tiene el cliente en el sistema.
resumen_variable <- function(x) {
if (!is.numeric(x)) {
stop("La variable debe ser numérica")
}
x_limpio <- x[!is.na(x)]
result <- list(
mean = mean(x_limpio),
median = median(x_limpio),
sd = sd(x_limpio),
variance = var(x_limpio),
min = min(x_limpio),
max = max(x_limpio),
n_missing = sum(is.na(x))
)
return(result)
}
resumen_variable(Credit_Data$Months_on_book)## $mean
## [1] 35.98276
##
## $median
## [1] 36
##
## $sd
## [1] 8.003849
##
## $variance
## [1] 64.06159
##
## $min
## [1] 13
##
## $max
## [1] 56
##
## $n_missing
## [1] 0Conclusiones
Si bien los clientes tienen una edad promedio y una cantidad de dependientes similares, si hay una gran brecha entre los ingresos y el acceso que tienen a lineas de credito cuando estos se agrupan por genero, siendo las mujeres las que tienen una menor disponibilidad de ingresos y credito. Esta gran brecha denota una gran inequidad a nivel socioeconomico entre hombres y mujeres.