Esempi di Business Analytics/Clienti fedeli
Caricamento librerie
[modifica | modifica sorgente]library(dplyr)
library(ggplot2)
library(caret)
Parte 1: Dati
[modifica | modifica sorgente]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
[modifica | modifica sorgente]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
[modifica | modifica sorgente]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()
![](http://upload.wikimedia.org/wikipedia/commons/a/a9/Mesi_di_permanenza_del_cliente_in_azienda_ed_eventuale_abbandono.png)
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))
![](http://upload.wikimedia.org/wikipedia/commons/2/21/Mesi_di_permanenza_del_cliente_in_azienda.png)