Churn
Patricio Araneda
2021-06-11
R Markdown
Limpieza de datos
bank <- bank %>%
dplyr::select(-RowNumber, -CustomerId, -Surname) %>% #remove unwanted column
mutate(Geography = as.factor(Geography),
Gender = as.factor(Gender),
HasCrCard = as.factor(HasCrCard),
IsActiveMember = as.factor(IsActiveMember),
Exited = as.factor(Exited),
Tenure = as.factor(Tenure),
NumOfProducts = as.factor(NumOfProducts))# detectar datos NA
sapply(bank, function(x) sum(is.na(x)))## CreditScore Geography Gender Age Tenure
## 0 0 0 0 0
## Balance NumOfProducts HasCrCard IsActiveMember EstimatedSalary
## 0 0 0 0 0
## Exited
## 0# no hay datos perdidosAnálisis exploratorio
summary(bank)## CreditScore Geography Gender Age Tenure
## Min. :350.0 France :5014 Female:4543 Min. :18.00 2 :1048
## 1st Qu.:584.0 Germany:2509 Male :5457 1st Qu.:32.00 1 :1035
## Median :652.0 Spain :2477 Median :37.00 7 :1028
## Mean :650.5 Mean :38.92 8 :1025
## 3rd Qu.:718.0 3rd Qu.:44.00 5 :1012
## Max. :850.0 Max. :92.00 3 :1009
## (Other):3843
## Balance NumOfProducts HasCrCard IsActiveMember EstimatedSalary
## Min. : 0 1:5084 0:2945 0:4849 Min. : 11.58
## 1st Qu.: 0 2:4590 1:7055 1:5151 1st Qu.: 51002.11
## Median : 97199 3: 266 Median :100193.91
## Mean : 76486 4: 60 Mean :100090.24
## 3rd Qu.:127644 3rd Qu.:149388.25
## Max. :250898 Max. :199992.48
##
## Exited
## 0:7963
## 1:2037
##
##
##
##
## # caracteristicas relevantes
# Age: entre 198 y 92 años
# Tenure. años de permanencia en el banco
# Balance: monto de dinero disponible para retiro
# NumOfProducts: cantidad de productos que el cliente tiene con el banco
# IsActiveMember: 1 activo
# EstimatedSalary: salario estimado
# Exited: 1 si el cliente se ha retirado del banco (cerrado cuenta)variable
Exited: 0, cliente no ha abandonado Exited: 1, cliente ha abandonado
ggplot(bank, aes(Exited, fill = Exited)) +
geom_bar() +
theme(legend.position = 'none')
table(bank$Exited)##
## 0 1
## 7963 2037# proporción de abandono de clientes
round(prop.table(table(bank$Exited)),3)##
## 0 1
## 0.796 0.204EStimación de la distribución
bank %>%
keep(is.numeric) %>%
gather() %>%
ggplot() +
geom_histogram(mapping = aes(x=value,fill=key), color="black") +
facet_wrap(~ key, scales = "free") +
theme_minimal() +
theme(legend.position = 'none')
matriz de correlación
numericVarName <- names(which(sapply(bank, is.numeric)))
corr <- cor(bank[,numericVarName], use = 'pairwise.complete.obs')
ggcorrplot(corr, lab = TRUE)
variables categorica
bank %>%
dplyr::select(-Exited) %>%
keep(is.factor) %>%
gather() %>%
group_by(key, value) %>%
summarize(n = n()) %>%
ggplot() +
geom_bar(mapping=aes(x = value, y = n, fill=key), color="black", stat='identity') +
coord_flip() +
facet_wrap(~ key, scales = "free") +
theme_minimal() +
theme(legend.position = 'none')
Tenemos más clientes masculinos que femeninos.
Los clientes proceden de Francia (la mayorÃa), Alemania y Francia.
La mayorÃa de los clientes tienen la tarjeta de crédito del banco
Tenemos un número casi igual de socios activos y no activos, lo que no es muy buena señal
La mayorÃa de los clientes utilizan uno o dos tipos de productos, y muy pocos utilizan tres o cuatro productos
Hay casi el mismo número de clientes en los distintos grupos de tenencia, excepto 0 y 10.
variables continuas
age_hist <- ggplot(bank, aes(x = Age, fill = Exited)) +
geom_histogram(binwidth = 5) +
theme_minimal() +
scale_x_continuous(breaks = seq(0,100,by=10), labels = comma)
age_boxplot <- ggplot(bank, aes(x = Exited, y = Age, fill = Exited)) +
geom_boxplot() +
theme_minimal() +
theme(legend.position = 'none')
graficofinal2 <- grid.arrange(age_hist, age_boxplot,
ncol = 2, nrow = 1
)
Los clientes que no han cambiado de opinión tienen una distribución sesgada a la derecha (tienden a ser jóvenes). Los valores atÃpicos de más de 60 años pueden ser nuestros clientes estables.
Los clientes que cambian de banco tienen entre 40 y 50 años. Es posible que necesiten cambiar de servicio bancario por motivos de jubilación o por cuestiones familiares.
Podemos ver una clara diferencia entre estos dos grupos.
Balance
balance_hist <- ggplot(bank, aes(x = Balance, fill = Exited)) +
geom_histogram() +
theme_minimal() +
scale_x_continuous(breaks = seq(0,255000,by=30000), labels = comma) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
balance_box <- ggplot(bank, aes(x = Exited, y = Balance, fill = Exited)) +
geom_boxplot() +
theme_minimal() +
theme(legend.position = 'none')
balancegraf <- grid.arrange(balance_hist, balance_box,
ncol = 2, nrow = 1
)
We can see the distribution of these two groups are quite similar.
Surprisingly some non-churned customers have lower balance than churned customers.
Puntaje de crédito
credit_hist <- ggplot(bank, aes(x = CreditScore, fill = Exited)) +
geom_histogram() +
theme_minimal() +
#scale_x_continuous(breaks = seq(0,255000,by=30000), labels = comma) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
credit_box <- ggplot(bank, aes(x = Exited, y = CreditScore, fill = Exited)) +
geom_boxplot() +
theme_minimal() +
theme(legend.position = 'none')
credito_graf <- grid.arrange(credit_hist, credit_box,
ncol = 2, nrow = 1
)
En general, la distribución es similar. Algunos clientes con una puntuación de crédito extremadamente baja (en la cola de la izquierda), asà como con una puntuación de crédito alta, también cambian de opinión, lo que indica que los clientes de calidad realmente baja y alta cambian de opinión con más facilidad que los clientes de calidad media.
Estimated Salary
estimated_hist <- ggplot(bank, aes(x = EstimatedSalary, fill = Exited)) +
geom_histogram() +
theme_minimal() +
#scale_x_continuous(breaks = seq(0,255000,by=30000), labels = comma) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
estimated_box <- ggplot(bank, aes(x = Exited, y = EstimatedSalary, fill = Exited)) +
geom_boxplot() +
theme_minimal() +
theme(legend.position = 'none')
salary_graf <- grid.arrange(estimated_hist, estimated_box,
ncol = 2, nrow = 1
)