Customer Churn em Operadoras de Telecom
Giuliana Farabolini
4/11/2021
1.Objetivo
O projeto possui o foco de criar um modelo de aprendizado de máquina para prever se um cliente pode ou não cancelar seu plano e a probabilidade disso ocorrer. Para desenvolver o estudo utilizaremos a linguagem R.
2. Introdução
2.1 O que é Customer Churn?
Churn é uma métrica que indica o número de clientes que reincidem seus contratos em determinado período. Para calcular o churn, o que você precisa fazer é somar o número de clientes que cancelou seu produto/serviço no período analisado.
Para que uma empresa consiga fazer a expansão da sua base de clientes, é preciso que o número de novos clientes exceda o seu churn rate – a taxa de clientes cancelados.
- Churn = total de clientes cancelados
Fonte: (https://resultadosdigitais.com.br/blog/o-que-e-churn/); acessado em 11 de abril de 2021.
2.2 O que é análise preditiva?
Análise preditiva é uma técnica analítica avançada que usa dados, algoritmos e machine learning para antecipar tendências e fazer projeções nos negócios. Graças ao avanço computacional, já é possível analisar grandes volumes de dados (Big Data) para encontrar padrões e avaliar as futuras possibilidades a partir do histórico da empresa.
Autor: Patel, Neil; (https://neilpatel.com/br/blog/analise-preditiva/); acessado em 11 de abril de 2021.
2.3 Por que usar análise preditiva para diminuir churn rate?
- Gerenciar riscos;
- Suportar a tomada de decisão;
- Diminuir custos;
- Aumentar o alcance dos negócios;
- Identificar produtos mais desejados;
- Prever Churn;
- Detectar fraudes.
Autor: Alcantara, Joyce; (https://e-millennium.com.br/o-que-e-analise-preditiva-e-como-ela-agrega-valor-para-os-negocios/); acessado em 11 de abril de 2021.
3. Dataset
3.1 Obtenção e importação dos dados
O banco de dados foi extraído do site Kaggle e vamos importá-lo para software.
churn <- read.csv('/Users/giulianafarabolini/Downloads/WA_Fn-UseC_-Telco-Customer-Churn.csv')3.2 Dicionário:
customerID: 7043 ID’s únicos, cada um representando um cliente;
gender: gênero do cliente;
SeniorCitizen: se o cliente é idoso ou não;
Partner: se cliente tem um cônjuge ou não;
Dependents: se o cliente possui dependentes ou não;
tenure: número de meses que o cliente está/ficou na companhia;
PhoneService: se o cliente possui serviço de telefone ou não;
MultipleLines: se o cliente possui múltiplas linhas de telefone;
InternetService: tipo de serviço de internet;
OnlineSecurity: se o cliente possui algum tipo de proteção online;
OnlineBackup: se o cliente tem backup online;
DeviceProtection: se o cliente possui algum tipo de proteção para celular;
TechSupport: se o cliente tem suporte técnico;
StreamingTV: se o cliente tem serviço de streaming de TV (TV por assinatura);
StreamingMovies: se o cliente tem algum tipo de serviço de streaming para filmes (Netflix, Telecine, Amazon Prime, etc…);
Contract: duração do contrato;
PaperlessBilling: se o cliente recebe a fatura virtualmente (sem a impressão de papel);
PaymentMethod: método de pagamento utilizado;
MonthlyCharges: valor da fatura mensal do cliente;
TotalCharges: valor total já pago pelo cliente;
Churn: variável indicando se o cliente rescindiu ou não seu contrato com a companhia no último mês.
Vamos analisar o banco de dados e suas características:
str(churn)## 'data.frame': 7043 obs. of 21 variables:
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ gender : chr "Female" "Male" "Male" "Male" ...
## $ SeniorCitizen : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Partner : chr "Yes" "No" "No" "No" ...
## $ Dependents : chr "No" "No" "No" "No" ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ PhoneService : chr "No" "Yes" "Yes" "No" ...
## $ MultipleLines : chr "No phone service" "No" "No" "No phone service" ...
## $ InternetService : chr "DSL" "DSL" "DSL" "DSL" ...
## $ OnlineSecurity : chr "No" "Yes" "Yes" "Yes" ...
## $ OnlineBackup : chr "Yes" "No" "Yes" "No" ...
## $ DeviceProtection: chr "No" "Yes" "No" "Yes" ...
## $ TechSupport : chr "No" "No" "No" "Yes" ...
## $ StreamingTV : chr "No" "No" "No" "No" ...
## $ StreamingMovies : chr "No" "No" "No" "No" ...
## $ Contract : chr "Month-to-month" "One year" "Month-to-month" "One year" ...
## $ PaperlessBilling: chr "Yes" "No" "Yes" "No" ...
## $ PaymentMethod : chr "Electronic check" "Mailed check" "Mailed check" "Bank transfer (automatic)" ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ TotalCharges : num 29.9 1889.5 108.2 1840.8 151.7 ...
## $ Churn : chr "No" "No" "Yes" "No" ...A tabela é composta por 7.043 observações(linhas) e 21 variáveis (colunas).
3.3 Limpeza e preparação dos dados
A maioria das variáveis entrou como classificação caracter, porém a maior parte da base é factor, por isso vamos alterar suas classes:
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionchurn <- churn %>%
mutate_at(vars(2:5,7:18,21), as.factor)As colunas 10 a 15 tem observações que são diferentes, mas possuem o mesmo significado. Para facilitar a análise iremos substitui-las e unificar as observações.
churn[churn == 'No internet service'] <- 'No'O mesmo acontece com a coluna MultipleLines, vamos repetir a ação anterior, porém com a observação “No phone service”.
levels(churn$MultipleLines)## [1] "No" "No phone service" "Yes"levels(churn$MultipleLines) <- c('No', 'No', 'Yes')Já a coluna SeniorCitizen traz a informação ‘1’ para quem é idoso e ‘0’ para o contrário, como feito anteriormente vamos substituir esses valores para ‘Yes’ e ‘No’, respectivamente para uniformizar nossa base.
levels(churn$SeniorCitizen)## [1] "0" "1"levels(churn$SeniorCitizen) <- c('No', 'Yes')Verificando se a base possui valores nulos
sum(is.na(churn))## [1] 11Temos valores nulos, agora vamos identificar em qual coluna estão:
sapply(churn, function(x) sum(is.na(x)))## customerID gender SeniorCitizen Partner
## 0 0 0 0
## Dependents tenure PhoneService MultipleLines
## 0 0 0 0
## InternetService OnlineSecurity OnlineBackup DeviceProtection
## 0 0 0 0
## TechSupport StreamingTV StreamingMovies Contract
## 0 0 0 0
## PaperlessBilling PaymentMethod MonthlyCharges TotalCharges
## 0 0 0 11
## Churn
## 0Observamos que todos os valores nulos estão na coluna TotalCharges, mas como o dataset nos traz os valores pagos no mês e tempo do contrato, podemos criar os valores nulos se houver necessidade.
churn[is.na(churn$TotalCharges),1:6]## customerID gender SeniorCitizen Partner Dependents tenure
## 489 4472-LVYGI Female No Yes Yes 0
## 754 3115-CZMZD Male No No Yes 0
## 937 5709-LVOEQ Female No Yes Yes 0
## 1083 4367-NUYAO Male No Yes Yes 0
## 1341 1371-DWPAZ Female No Yes Yes 0
## 3332 7644-OMVMY Male No Yes Yes 0
## 3827 3213-VVOLG Male No Yes Yes 0
## 4381 2520-SGTTA Female No Yes Yes 0
## 5219 2923-ARZLG Male No Yes Yes 0
## 6671 4075-WKNIU Female No Yes Yes 0
## 6755 2775-SEFEE Male No No Yes 0Vemos que os clientes que estão com valores nulos é porque possuem o tempo de contrato zero, ou seja, não realizaram o primeiro pagamento. Será que temos outros clientes com o tempo de contrato zerado?
library(dplyr)
churn %>%
filter(tenure == 0) %>%
summarize("Zero Tenure" = n())## Zero Tenure
## 1 11Esses são os únicos clientes, então vamos removê-los do dataset, já que não possuem um tempo considerável de contrato para influenciar as nossas análises, além do que essas observações representam apenas 0,15% do banco de dados total.
nondchurn <- churn[complete.cases(churn), ]
dim(nondchurn)## [1] 7032 21Não precisaremos da variável customerID para gráficos ou modelagem, portanto, ela pode ser removida.
nvdatasetchurn <- nondchurn %>%
select(-customerID)4. Análise Exploratória
4.1 Taxa Churn
O conjunto de dados nos traz que 26,58% dos clientes reincidiram os contratos.
library(ggplot2)
nvdatasetchurn %>%
group_by(Churn) %>%
summarise(Number = n()) %>%
mutate(Percentual = prop.table(Number)*100) %>%
ggplot(aes(Churn, Percentual)) +
geom_col(aes(fill = Churn)) +
labs(title = "Taxa Churn") +
theme(plot.title = element_text(hjust = 0.5)) +
geom_text(aes(label = sprintf("%.2f%%", Percentual)), hjust = 0.5,vjust =1, size = 4) +
theme_minimal()## `summarise()` ungrouping output (override with `.groups` argument)
4.2 Perfil do cliente churn
Antes de começarmos a fazer nossa modelagem, vamos analisar os perfis dos clientes.
library(cowplot)##
## ********************************************************## Note: As of version 1.0.0, cowplot does not change the## default ggplot2 theme anymore. To recover the previous## behavior, execute:
## theme_set(theme_cowplot())## ********************************************************library(stringr)
plot_grid(ggplot(nvdatasetchurn, aes(x = gender, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = SeniorCitizen, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = Partner, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = Dependents, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()))+
labs(title = "Perfil do Cliente") +
theme(plot.title = element_text(hjust = 0.5))
A partir dos gráficos podemos ver que a mostra é dívida uniformemente por gênero e status de parceiro. Uma minoria da amostra é idosa e a grande maioria não possui dependentes. Conseguimos perceber que o perfil dos clientes não churn e dos clientes churn diferem apenas na variável partner, onde os clientes que reincidiram o contrato a maioria não possui companheiro e já os clientes não churn a maioria possui companheiros.
ggplot(nvdatasetchurn, aes(x = tenure, fill = Churn)) +
geom_bar() +
labs(x = "Tenure") +
theme_minimal()
A maioria dos clientes churn, cancelam seus contratos antes de completar 2 meses, como podemos observar no gráfico acima.
plot_grid(ggplot(nvdatasetchurn, aes(x = Contract, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = PaymentMethod, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = InternetService, fill = Churn)) +
geom_bar() +
geom_text(aes(y = ..count.. -200,
label = paste0(round(prop.table(..count..),4) * 100, '%')),
stat = 'count', position = position_dodge(.1), size = 3)+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()))
A maior parte dos clientes churn preferem o meio de pagamento Eletronic Check e possuem contratos mensais. Também preferem pelo serviço de internet Fiber optic.
Vamos dar uma olhada nas demais variáveis:
plot_grid(ggplot(nvdatasetchurn, aes(x = PhoneService, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = MultipleLines, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = OnlineBackup, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = DeviceProtection, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = TechSupport, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = StreamingTV, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = StreamingTV, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()),
ggplot(nvdatasetchurn, aes(x = StreamingMovies, fill = Churn)) +
geom_bar()+
theme_minimal()+
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()))+
labs(title = "Demais Serviços") +
theme(plot.title = element_text(hjust = 0.5))
5. Modelo
Neste projeto, usarei 3 modelos de aprendizado de máquina (Naive Bayes, Decision Tree e Random Forest). Para começar a realizar os modelos, vamos primeiramente dividir a base de dados em dois. O subconjunto de treinamento será aproximadamente 70% da amostra original, com o restante sendo o subconjunto de teste.
library(caret)## Loading required package: latticeset.seed(56)
split_train_test <- createDataPartition(nvdatasetchurn$Churn,p=0.7,list=FALSE)
dtrain<- nvdatasetchurn[split_train_test,]
dtest<- nvdatasetchurn[-split_train_test,]5.1 Decision Tree
A análise da árvore de decisão é um método de classificação que usa modelos de decisões em forma de árvore e seus possíveis resultados. Este método exploratório identificará as variáveis mais importantes relacionadas ao churn em um formato hierárquico.
library(rpart)
library(rpart.plot)
tr_fit <- rpart(Churn ~., data = dtrain, method="class")
rpart.plot(tr_fit)
A variável mais importante é Contract. Com o modelo podemos ver que os clientes mais engajados preferem contratos anuais, serviço de internet DSL e permanecem na empresa mais de 15 meses.
Para avaliar a precisão da nossa árvore de decisão vamos utilizar a matriz de confusão:
tr_prob1 <- predict(tr_fit, dtest)
tr_pred1 <- ifelse(tr_prob1[,2] > 0.5,"Yes","No")
table(Predicted = tr_pred1, Actual = dtest$Churn)## Actual
## Predicted No Yes
## No 1406 284
## Yes 142 276A partir dessa matriz de confusão, podemos ver que o modelo tem um bom desempenho na previsão de clientes não rotativos, mas não tem um desempenho tão bom na previsão de clientes rotativos.
E quanto a acuracidade do modelo?
tr_prob2 <- predict(tr_fit, dtrain)
tr_pred2 <- ifelse(tr_prob2[,2] > 0.5,"Yes","No")
tr_tab1 <- table(Predicted = tr_pred2, Actual = dtrain$Churn)
tr_tab2 <- table(Predicted = tr_pred1, Actual = dtest$Churn)
# Treinamento
library(caret)
confusionMatrix(
as.factor(tr_pred2),
as.factor(dtrain$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3272 674
## Yes 343 635
##
## Accuracy : 0.7935
## 95% CI : (0.7819, 0.8047)
## No Information Rate : 0.7342
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4245
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.4851
## Specificity : 0.9051
## Pos Pred Value : 0.6493
## Neg Pred Value : 0.8292
## Prevalence : 0.2658
## Detection Rate : 0.1290
## Detection Prevalence : 0.1986
## Balanced Accuracy : 0.6951
##
## 'Positive' Class : Yes
## # Teste
confusionMatrix(
as.factor(tr_pred1),
as.factor(dtest$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1406 284
## Yes 142 276
##
## Accuracy : 0.7979
## 95% CI : (0.7801, 0.8149)
## No Information Rate : 0.7343
## P-Value [Acc > NIR] : 6.398e-12
##
## Kappa : 0.4364
##
## Mcnemar's Test P-Value : 8.405e-12
##
## Sensitivity : 0.4929
## Specificity : 0.9083
## Pos Pred Value : 0.6603
## Neg Pred Value : 0.8320
## Prevalence : 0.2657
## Detection Rate : 0.1309
## Detection Prevalence : 0.1983
## Balanced Accuracy : 0.7006
##
## 'Positive' Class : Yes
## tr_acc <- sum(diag(tr_tab2))/sum(tr_tab2)
tr_acc## [1] 0.7979127O modelo de árvore de decisão é bastante preciso, prevendo corretamente o status de rotatividade de clientes no subconjunto de teste 79% do tempo.
5.2 Random forest
A análise floresta aleatória é outro método de classificação de aprendizado de máquina freqüentemente usado na análise de rotatividade de clientes. O método opera construindo múltiplas árvores de decisão e construindo modelos com base em estatísticas resumidas dessas árvores de decisão.
Começaremos identificando o número de variáveis amostradas aleatoriamente. No pacote randomForest, isso é referido como o parâmetro ou argumento ‘mtry’.
#Definir parâmetros de controle para seleção aleatória de modelo de floresta
ctrl <- trainControl(method = "cv", number=5,
classProbs = TRUE, summaryFunction = twoClassSummary)
#Seleção exploratória de modelo de floresta aleatória
rf_fit1 <- train(Churn ~., data = dtrain,
method = "rf",
ntree = 75,
tuneLength = 5,
metric = "ROC",
trControl = ctrl)
rf_fit1## Random Forest
##
## 4924 samples
## 19 predictor
## 2 classes: 'No', 'Yes'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 3940, 3939, 3939, 3939, 3939
## Resampling results across tuning parameters:
##
## mtry ROC Sens Spec
## 2 0.8332208 0.9629322 0.3009798
## 8 0.8239186 0.8993084 0.4858764
## 15 0.8165053 0.8901798 0.4881665
## 22 0.8165443 0.8912863 0.4881665
## 29 0.8101833 0.8835408 0.4904478
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.saveRDS(rf_fit1, "Churn.RDS")
rf_fit1 <- readRDS("Churn.RDS")O modelo descobriu que o valor ideal para mtry é 2. A partir deste modelo, podemos investigar a importância relativa das variáveis preditoras de rotatividade.
library(randomForest)## randomForest 4.6-14## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## margin## The following object is masked from 'package:dplyr':
##
## combinerf_fit2 <- randomForest(Churn ~., data = dtrain,
ntree = 75, mtry = 2,
importance = TRUE, proximity = TRUE)
# Mostra a importância da variável da árvore aleatória
varImpPlot(rf_fit2, sort=T, n.var = 10,
main = 'Top 10 variáveis importantes')
Semelhante à árvore de decisão, este modelo de floresta aleatório identificou tenure e Contract como preditores importantes para a rotatividade. Em contrapartida Internet Service não está entre os top 3 e é substituída por TotalCharges.
Vamos examinar o desempenho deste modelo de floresta aleatório. Começaremos com a matriz de confusão.
rf_pred1 <- predict(rf_fit2, dtest)
table(Predicted = rf_pred1, Actual = dtest$Churn)## Actual
## Predicted No Yes
## No 1433 289
## Yes 115 271plot(rf_fit2)
O desempenho é um tanto semelhante ao modelo de árvore de decisão. A taxa de falsos negativos é baixa, mas a taxa de falsos positivos é bastante alta. E quanto à precisão geral?
rf_pred2 <- predict(rf_fit2, dtrain)
rf_tab1 <- table(Predicted = rf_pred2, Actual = dtrain$Churn)
rf_tab2 <- table(Predicted = rf_pred1, Actual = dtest$Churn)
# Treinamento
confusionMatrix(
as.factor(rf_pred2),
as.factor(dtrain$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3466 445
## Yes 149 864
##
## Accuracy : 0.8794
## 95% CI : (0.8699, 0.8883)
## No Information Rate : 0.7342
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6669
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.6600
## Specificity : 0.9588
## Pos Pred Value : 0.8529
## Neg Pred Value : 0.8862
## Prevalence : 0.2658
## Detection Rate : 0.1755
## Detection Prevalence : 0.2057
## Balanced Accuracy : 0.8094
##
## 'Positive' Class : Yes
## # Teste
confusionMatrix(
as.factor(rf_pred1),
as.factor(dtest$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1433 289
## Yes 115 271
##
## Accuracy : 0.8083
## 95% CI : (0.7909, 0.825)
## No Information Rate : 0.7343
## P-Value [Acc > NIR] : 1.088e-15
##
## Kappa : 0.4547
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.4839
## Specificity : 0.9257
## Pos Pred Value : 0.7021
## Neg Pred Value : 0.8322
## Prevalence : 0.2657
## Detection Rate : 0.1286
## Detection Prevalence : 0.1831
## Balanced Accuracy : 0.7048
##
## 'Positive' Class : Yes
## rf_acc <- sum(diag(rf_tab2))/sum(rf_tab2)
rf_acc## [1] 0.8083491O modelo de floresta aleatória é um pouco mais preciso do que o modelo de árvore de decisão, sendo capaz de prever corretamente o status de rotatividade de um cliente no subconjunto de teste com 80% de precisão.
5.3 Logistic regression analysis
A regressão logística envolve a regressão de variáveis preditoras em um resultado binário usando uma função de ligação binomial. Vamos ajustar o modelo usando a função de modelagem linear geral básica em R, ‘glm’.
lr_fit <- glm(Churn ~., data = dtrain,
family=binomial(link='logit'))
summary(lr_fit)##
## Call:
## glm(formula = Churn ~ ., family = binomial(link = "logit"), data = dtrain)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8966 -0.6818 -0.2767 0.7457 3.2597
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.232e+00 9.637e-01 1.278 0.201258
## genderMale -1.242e-02 7.748e-02 -0.160 0.872611
## SeniorCitizenYes 2.358e-01 1.001e-01 2.355 0.018532 *
## PartnerYes -7.698e-02 9.255e-02 -0.832 0.405513
## DependentsYes -1.896e-01 1.071e-01 -1.770 0.076691 .
## tenure -6.960e-02 7.728e-03 -9.006 < 2e-16 ***
## PhoneServiceYes -1.368e-01 7.678e-01 -0.178 0.858579
## MultipleLinesYes 3.824e-01 2.088e-01 1.832 0.067023 .
## InternetServiceFiber optic 1.316e+00 9.422e-01 1.396 0.162633
## InternetServiceNo -1.700e+00 9.569e-01 -1.777 0.075603 .
## OnlineSecurityYes -2.218e-01 2.102e-01 -1.055 0.291466
## OnlineBackupYes -1.189e-01 2.074e-01 -0.573 0.566495
## DeviceProtectionYes 3.831e-02 2.080e-01 0.184 0.853874
## TechSupportYes -3.033e-01 2.136e-01 -1.420 0.155750
## StreamingTVYes 4.271e-01 3.854e-01 1.108 0.267716
## StreamingMoviesYes 4.323e-01 3.863e-01 1.119 0.263076
## ContractOne year -6.228e-01 1.293e-01 -4.816 1.46e-06 ***
## ContractTwo year -1.389e+00 2.145e-01 -6.473 9.63e-11 ***
## PaperlessBillingYes 3.205e-01 8.915e-02 3.595 0.000324 ***
## PaymentMethodCredit card (automatic) -2.102e-01 1.355e-01 -1.551 0.120894
## PaymentMethodElectronic check 2.365e-01 1.125e-01 2.103 0.035466 *
## PaymentMethodMailed check -2.345e-01 1.384e-01 -1.694 0.090308 .
## MonthlyCharges -2.912e-02 3.752e-02 -0.776 0.437718
## TotalCharges 4.636e-04 8.674e-05 5.344 9.08e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 5702.8 on 4923 degrees of freedom
## Residual deviance: 4074.2 on 4900 degrees of freedom
## AIC: 4122.2
##
## Number of Fisher Scoring iterations: 6As variáveis tenure, Contract e TotalCharges têm os valores p mais baixos e podem ser identificados como os melhores preditores de rotatividade de clientes.
Vamos examinar a matriz de confusão com base em nosso modelo de regressão logística.
lr_prob1 <- predict(lr_fit, dtest, type="response")
lr_pred1 <- ifelse(lr_prob1 > 0.5,"Yes","No")
table(Predicted = lr_pred1, Actual = dtest$Churn)## Actual
## Predicted No Yes
## No 1403 247
## Yes 145 313Semelhante aos outros modelos, a taxa de falsos negativos é baixa, porém não tão baixa. Em contrapartida, a taxa de falsos positivos está na verdade acima de 50%, portanto, tem um desempenho melhor do que os algoritmos de aprendizado de máquina anteriores.
A acuracidade pode ser obtida de forma semelhante aos modelos anteriores.
lr_prob2 <- predict(lr_fit, dtrain, type="response")
lr_pred2 <- ifelse(lr_prob2 > 0.5,"Yes","No")
lr_tab1 <- table(Predicted = lr_pred2, Actual = dtrain$Churn)
lr_tab2 <- table(Predicted = lr_pred1, Actual = dtest$Churn)# Treinamento
confusionMatrix(
as.factor(lr_pred2),
as.factor(dtrain$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3227 595
## Yes 388 714
##
## Accuracy : 0.8004
## 95% CI : (0.7889, 0.8115)
## No Information Rate : 0.7342
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4614
##
## Mcnemar's Test P-Value : 5.019e-11
##
## Sensitivity : 0.5455
## Specificity : 0.8927
## Pos Pred Value : 0.6479
## Neg Pred Value : 0.8443
## Prevalence : 0.2658
## Detection Rate : 0.1450
## Detection Prevalence : 0.2238
## Balanced Accuracy : 0.7191
##
## 'Positive' Class : Yes
## # Teste
confusionMatrix(
as.factor(lr_pred1),
as.factor(dtest$Churn),
positive = "Yes"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1403 247
## Yes 145 313
##
## Accuracy : 0.814
## 95% CI : (0.7968, 0.8304)
## No Information Rate : 0.7343
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.494
##
## Mcnemar's Test P-Value : 3.374e-07
##
## Sensitivity : 0.5589
## Specificity : 0.9063
## Pos Pred Value : 0.6834
## Neg Pred Value : 0.8503
## Prevalence : 0.2657
## Detection Rate : 0.1485
## Detection Prevalence : 0.2173
## Balanced Accuracy : 0.7326
##
## 'Positive' Class : Yes
## lr_acc <- sum(diag(lr_tab2))/sum(lr_tab2)
lr_acc## [1] 0.8140417A taxa de precisão de 81,4% do modelo de regressão logística supera ligeiramente os modelos de árvore de decisão e floresta aleatória.
6. Conclusão
Depois de passar por várias etapas preparatórias, incluindo carregamento de dados/biblioteca e pré-processamento, realizamos três métodos de classificação estatística comuns na análise de churn. Identificamos várias variáveis preditoras de rotatividade importantes desses modelos e comparamos esses modelos em medidas de precisão.
Em suma:
- Clientes com contratos mensais são menos engajados;
- Os clientes com serviço de Internet, em particular serviço de fibra ótica, têm maior probabilidade de rotatividade;
- Os clientes que possuem contratos longos ou que pagaram mais no total têm menos probabilidade de desistir;
- A regressão logística, embora seja um método menos complicado, superou os métodos baseados em aprendizado de máquina de árvore de decisão e análise de floresta aleatória. Embora a regressão logística tenha tido um desempenho ligeiramente inferior em termos de falsos negativos, ela teve uma taxa de falsos positivos melhor e foi mais precisa em geral.