Data description

The telecommunications company Telco is concerned about the number of customers leaving their landline business for cable competitors. They need to understand who is leaving and why. We’ll analyze all relevant customer data to provide the marketing department with insights to develop focused customer retention programs.

The data set provides info about 7 thousand customers of the company Telco. It contains 21 variable:

• Customers who left within the last month – variable Churn
• Services that each customer has signed up for – phone, multiple lines, internet, online security, online backup, device protection, tech support, and streaming TV and movies
• Customer account information – how long they’ve been a customer, contract, payment method, paperless billing, monthly charges, and total charges
• Demographic info about customers – gender, age range, and if they have partners and dependents.

The original data set is located on www.ibm.com

Loading and preprocessing data

We load data using fread() function from data.table package:

library(data.table)

Churn <- as.data.frame(fread("WA_Fn-UseC_-Telco-Customer-Churn.csv", encoding = 'UTF-8'))
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" ...

The data set contains variables of numeric, integer and character classes. We convert character variables to factor variables using as.factor() function:

Churn$gender <- as.factor(Churn$gender)
Churn$Partner <- as.factor(Churn$Partner)
Churn$Dependents <- as.factor(Churn$Dependents)
Churn$PhoneService <- as.factor(Churn$PhoneService)
Churn$Contract <- as.factor(Churn$Contract)
Churn$PaperlessBilling <- as.factor(Churn$PaperlessBilling)
Churn$Churn <- as.factor(Churn$Churn)
Churn$PaymentMethod <- as.factor(Churn$PaymentMethod)
Churn$InternetService <- as.factor(Churn$InternetService)

Converting integer variable SeniorCitizen to factor using mapvalues() function from plyr package:

library(plyr)

Churn$SeniorCitizen <- as.factor(mapvalues(Churn$SeniorCitizen,
                                           from=c("0","1"),
                                           to=c("No", "Yes")))

Replacing “No phone service” and “No internet service” values with “No”:

Churn$MultipleLines <- as.factor(mapvalues(Churn$MultipleLines, 
                                        from=c("No phone service"),
                                        to=c("No")))
Churn$OnlineSecurity <- as.factor(mapvalues(Churn$OnlineSecurity, 
                                         from=c("No internet service"),
                                         to=c("No")))
Churn$OnlineBackup <- as.factor(mapvalues(Churn$OnlineBackup, 
                                         from=c("No internet service"),
                                         to=c("No")))
Churn$DeviceProtection <- as.factor(mapvalues(Churn$DeviceProtection, 
                                         from=c("No internet service"),
                                         to=c("No")))
Churn$TechSupport <- as.factor(mapvalues(Churn$TechSupport, 
                                         from=c("No internet service"),
                                         to=c("No")))
Churn$StreamingTV <- as.factor(mapvalues(Churn$StreamingTV, 
                                         from=c("No internet service"),
                                         to=c("No")))
Churn$StreamingMovies <- as.factor(mapvalues(Churn$StreamingMovies,
                                          from=c("No internet service"),
                                          to=c("No")))

Recoding numeric values of tenure variable to factor levels with recode() function from car package:

library(car)

Churn$tenure <- as.factor(recode(Churn$tenure, "1:9 = 'ShortTenure';10:35 = 'MediumTenure'; 
                                         else = 'LongTenure'"))

Saving customerID as row names and removing customerID and TotalCharges columns:

row.names(Churn) <- Churn$customerID
Churn <- Churn[, -c(1, 20)]

Checking the data set for missing values:

any(is.na(Churn))

## [1] FALSE

Customer Churn rate

26.54% of clients left the company within the last month. It’s necessary to determine the relevant factors of customer churn by building statistical models.

Building the models

To build a model, we need to divide the original data set into two data sets:

1. data set for training a model (70%) – trainChurn
2. control data set for model testing (30%). – testChurn

library(caTools)

set.seed(101)
sample <- sample.split(Churn$Churn, SplitRatio = 0.7)
trainChurn <- subset(Churn, sample == TRUE)
testChurn <- subset(Churn, sample == FALSE)

Let’s build a logistic model using glm() function:

options(width = 160)
Churn.lm <- glm(Churn ~., data = trainChurn, family = binomial("logit"))
summary(Churn.lm)

## 
## Call:
## glm(formula = Churn ~ ., family = binomial("logit"), data = trainChurn)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0735  -0.6597  -0.2745   0.6396   3.1657  
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.76066    0.98253  -0.774 0.438821    
## genderMale                           -0.02819    0.07816  -0.361 0.718340    
## SeniorCitizenYes                      0.26189    0.10108   2.591 0.009568 ** 
## PartnerYes                           -0.09824    0.09327  -1.053 0.292172    
## DependentsYes                        -0.12862    0.10864  -1.184 0.236433    
## tenureMediumTenure                    0.45028    0.11606   3.880 0.000105 ***
## tenureShortTenure                     1.44254    0.13840  10.423  < 2e-16 ***
## PhoneServiceYes                      -0.02419    0.78447  -0.031 0.975398    
## MultipleLinesYes                      0.44142    0.21538   2.050 0.040413 *  
## InternetServiceFiber optic            1.53896    0.96666   1.592 0.111376    
## InternetServiceNo                    -1.58736    0.97577  -1.627 0.103786    
## OnlineSecurityYes                    -0.29587    0.21620  -1.368 0.171163    
## OnlineBackupYes                      -0.05030    0.21310  -0.236 0.813417    
## DeviceProtectionYes                   0.01561    0.21401   0.073 0.941859    
## TechSupportYes                       -0.22392    0.21968  -1.019 0.308062    
## StreamingTVYes                        0.51211    0.39412   1.299 0.193814    
## StreamingMoviesYes                    0.50426    0.39427   1.279 0.200907    
## ContractOne year                     -0.88071    0.12721  -6.923 4.41e-12 ***
## ContractTwo year                     -1.92504    0.21370  -9.008  < 2e-16 ***
## PaperlessBillingYes                   0.39112    0.09066   4.314 1.60e-05 ***
## PaymentMethodCredit card (automatic)  0.04082    0.13555   0.301 0.763322    
## PaymentMethodElectronic check         0.38890    0.11386   3.415 0.000637 ***
## PaymentMethodMailed check             0.01982    0.13943   0.142 0.886953    
## MonthlyCharges                       -0.02786    0.03840  -0.725 0.468193    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 5704.4  on 4929  degrees of freedom
## Residual deviance: 4042.4  on 4906  degrees of freedom
## AIC: 4090.4
## 
## Number of Fisher Scoring iterations: 6

Let’s also build a Random Forest model using randomForest() function:

library(randomForest)

Churn.rf <- randomForest(Churn ~., data = trainChurn, importance = TRUE)
varImpPlot(Churn.rf, type = 2, main = "The significance of variables in the Random Forest model")

Now that we have built both models, we apply them to the test data set using predict() function:

Churn.lm.Test.Preds <- predict(Churn.lm, testChurn, type = "response")
Churn.rf.Test.Preds <- predict(Churn.rf, testChurn, type = "prob")

Let’s check both models for true positive and false positive predictions (type one error):

library(ROCR)

pred.lm <- prediction(Churn.lm.Test.Preds, testChurn$Churn)
pred.rf <- prediction(Churn.rf.Test.Preds[,2], testChurn$Churn)
perf.lm <- performance(pred.lm, "tpr", "fpr")
perf.rf <- performance(pred.rf, "tpr", "fpr")

The logistic model gives a bit more true positive predictions.

The Factors of Customer Churn

According to both models, the factors that have the greatest impact on the customer churn are the following:

• Senior Citizen status
• Internet Service type
• Paperless Billing status
• Payment Method
• Tenure
• Contract type
• Monthly Charges

Let’s look at each of these factors in more detail.

ggplot(Churn, aes(SeniorCitizen, fill = Churn)) +
  geom_bar(position = "fill") +
  xlab("Senior Citizen status") +
  ylab("Percent") +
  scale_y_continuous(labels = scales::percent) +
  scale_x_discrete(labels = c("Non-Senior Citizens", "Senior Citizens")) +
  scale_fill_manual(name = "Churn Status", values = c("green2", "red1"), labels = c("No", "Yes")) +
  ggtitle("The Ratio of Churns by Senior Citizen status") +
  theme_classic() +
  theme(legend.position = "bottom",
        plot.title = element_text(hjust = 0.5, size = 15))

Conclusion

By creating statistical models and conducting futher exploratory analysis, we identified most impactful factors on customer churn of Telco’s clients. The identified factors are: Senior Citizen status, Internet Service type, Paperless Billing status, Payment Method, Tenure, Contract type, Monthly Charges and Dependents status. These factors need futher investigation with additional data. Using that information the marketing department would be able to develop a data-driven loalty program.