Esempi di Business Analytics/Clienti fedeli

Esempi di Business Analytics

Categoria · Copertina · Sviluppo · Modifica il template

Caricamento librerie

library(dplyr)
library(ggplot2)
library(caret)

Parte 1: Dati

Il dataset WA_Fn-UseC_-Telco-Customer-Churn.csv scaricabile da qui: https://community.ibm.com/accelerators/catalog/content/Customer-churn contiene 7032 osservazioni relative ai clienti di una società di telecomunicazioni . In particolare le 21 variabili del dataset sono :

customerID: ID cliente
gender: genere (femmina, maschio)
SeniorCitizen: se il cliente è un anziano o meno (1, 0)
PartnerWhether: il cliente ha un partner o meno (Sì, No)
Dependents: se il cliente ha dipendenti o meno (Sì, No)
tenure: numero di mesi in cui il cliente è rimasto in azienda
PhoneService: se il cliente dispone o meno di un servizio telefonico (Sì, No)
MultipleLines: se il cliente ha più linee o meno (Sì, No, Nessun servizio telefonico)
InternetService: provider di servizi Internet del cliente (DSL, fibra ottica, no)
OnlineSecurity: se il cliente dispone o meno della sicurezza online (Sì, No, Nessun servizio Internet)
OnlineBackup: se il cliente ha o meno un backup online (Sì, No, Nessun servizio Internet)
DeviceProtection: se il cliente dispone o meno della protezione del dispositivo (Sì, No, Nessun servizio Internet)
TechSupport: se il cliente ha o meno supporto tecnico (Sì, No, Nessun servizio Internet)
StreamingTV: se il cliente ha o meno la TV in streaming (Sì, No, Nessun servizio Internet)
StreamingMovies: se il cliente ha o meno film in streaming (Sì, No, Nessun servizio Internet)
Contract: la durata del contratto del cliente (mese per mese, un anno, due anni)
PaperlessBilling: se il cliente ha o meno la fatturazione senza carta (Sì, No)
PaymentMethod: il metodo di pagamento del cliente (assegno elettronico, assegno postale, bonifico bancario (automatico), carta di credito (automatico))
MonthlyCharges: l'importo addebitato mensilmente al cliente
TotalCharges: L'importo totale addebitato al cliente
Churn: se il cliente ha abbandonato o meno (Sì o No)

Caricamento dati:

data=read.table('WA_Fn-UseC_-Telco-Customer-Churn.csv',header = T,sep=',')

Parte 2: Domanda di ricerca

Si vuole valutare se un cliente abbandonerà l'azienda prevedendo il valore della variabile Churn con le altre variabili tramite la regressione logistica e si vogliono individuare le variabili maggiormente implicate in questa scelta da parte del cliente.

Parte 3: Modellizzazione

Tramite la funzione table si valuta la frequenza e la percentuale di cliente che vuole abbandonare l'azienda e quelli che invece vogliono rimanere:

table(data2$Churn)
table(data2$Churn)*100/nrow(data2)

  No  Yes 
5174 1869

      No      Yes 
73.46301 26.53699

Si convertono le variabili categoriche nel dataset in numeriche e si fattorizza la variabile Churn:

mat<- data.matrix(data[,-1])
#scale_data <- scale(mat)
data2<- as.data.frame(mat)
data2$Churn <- as.factor(ifelse(data2$Churn==1,"No","Yes"))

Si partiziona il dataset in un 70% che costituisce il training su cui costruire il modello di regressione logistica e in 30% che costituisce il testing su cui verranno testati i dati. Si visualizza la matrice di confusione e si ottiene sul testing set un'Accuracy nella previsione dell'80% che è un buon risultato:

trainIndex <- createDataPartition(data2$Churn,p=0.7, list = FALSE)
training <- data2[trainIndex,]
testing <- data2[-trainIndex,]
    
model <-  glm(Churn ~ ., family=binomial(logit), data=training) 
p1 <- predict(model,newdata = testing)

cutoff<-0.3
f<-ifelse(p1<cutoff,"No","Yes")
print(confusionMatrix(as.factor(f),testing$Churn))

Confusion Matrix and Statistics
         Reference
Prediction   No  Yes
       No  1443  319
       Yes  103  241
                                         
              Accuracy : 0.7996          
                95% CI : (0.7819, 0.8165)
   No Information Rate : 0.7341          
   P-Value [Acc > NIR] : 1.457e-12       
                                         
                 Kappa : 0.4147          
                                         
Mcnemar's Test P-Value : < 2.2e-16       
                                         
           Sensitivity : 0.9334          
           Specificity : 0.4304          
        Pos Pred Value : 0.8190          
        Neg Pred Value : 0.7006          
            Prevalence : 0.7341          
        Detection Rate : 0.6852          
  Detection Prevalence : 0.8367          
     Balanced Accuracy : 0.6819          
                                         
      'Positive' Class : No

Tramite la funzione summary si valutano le variabili più significative nella previsione e da un punto di vista statistico che hanno 3 asterischi . In particolare quelle con "z value" negativo favoriscono il No della variabile Churn, quelle con "z value" positivo favoriscono il Si.

summary(model)

Call:
glm(formula = Churn ~ ., family = binomial(logit), data = training)

Deviance Residuals: 
   Min       1Q   Median       3Q      Max  
-1.8401  -0.6728  -0.2765   0.7263   3.4221

Coefficients:
                  Estimate Std. Error z value Pr(>|z|)    
(Intercept)       1.285e+00  4.440e-01   2.895 0.003797 ** 
gender           -2.411e-02  7.770e-02  -0.310 0.756284    
SeniorCitizen     1.696e-01  1.008e-01   1.682 0.092488 .  
Partner           1.676e-02  9.289e-02   0.180 0.856785    
Dependents       -1.987e-01  1.084e-01  -1.833 0.066786 .  
tenure           -5.518e-02  7.384e-03  -7.473 7.85e-14 ***
PhoneService     -9.592e-01  1.747e-01  -5.491 3.99e-08 ***
MultipleLines     1.054e-01  4.917e-02   2.143 0.032113 *  
InternetService   2.155e-01  7.892e-02   2.731 0.006320 ** 
OnlineSecurity   -2.172e-01  4.955e-02  -4.383 1.17e-05 ***
OnlineBackup     -1.770e-01  4.592e-02  -3.854 0.000116 ***
DeviceProtection -8.927e-02  4.714e-02  -1.894 0.058255 .  
TechSupport      -3.058e-01  5.062e-02  -6.042 1.52e-09 ***
StreamingTV      -1.800e-02  4.960e-02  -0.363 0.716685    
StreamingMovies   3.635e-02  4.927e-02   0.738 0.460702    
Contract         -7.691e-01  9.359e-02  -8.217  < 2e-16 ***
PaperlessBilling  4.451e-01  8.831e-02   5.040 4.64e-07 ***
PaymentMethod     4.783e-02  4.291e-02   1.115 0.264974    
MonthlyCharges    2.266e-02  2.680e-03   8.457  < 2e-16 ***
TotalCharges      2.764e-04  8.405e-05   3.288 0.001008 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
   Null deviance: 5704.0  on 4925  degrees of freedom
Residual deviance: 4057.1  on 4906  degrees of freedom
 (5 osservazioni eliminate a causa di valori mancanti)
AIC: 4097.1
Number of Fisher Scoring iterations: 6

La variabile tenure è numerica, rappresenta il numero di mesi in cui la persona è cliente aziendale, ha 3 asterischi e z value negativo e infatti come si vede dal boxplot è in media maggiore nei clienti che non se ne vanno rispetto a quelli che se ne vanno:

data %>%
  ggplot(aes(Churn,tenure)) +
  geom_boxplot()

Come si vede dal seguente grafico se un cliente sta per molti mesi in azienda è difficile che se ne vada.

data3 <- data2
data3$tenure <- as.factor(data3$tenure)

data3 %>%
  group_by(tenure,Churn) %>%
  summarise(totale=n()) %>%
  ggplot(aes(tenure,totale, colour=Churn, size=totale)) +
  geom_point()+
  theme(axis.text.x = element_text(angle=90,hjust=1,size = 7))