====== Логистическая регрессия в R на примере данных оттока клиентов из телекоммуникационной компании ====== ===== Постановка задачи ===== При решении задач бинарной классификации (вероятность имеет два значения 0 или 1) зачастую используют логистическую регрессию. Из определения — логистическая регрессия — это статистическая модель, которая применяется для предсказания вероятности возникновения некоторого события по значениям множества признаков. $$ P(y)=\frac{1}{1+e^{-F(y)}} $$ где $𝐹(y)$ — некоторая (в общем случая не линейная) функция от исследуемых переменных $y_𝑖$ вида: $𝐹(y)=𝐵_0+𝐵_1⋅y_1+⋯+𝐵_𝑛⋅y_𝑛$. Значение 𝑃(y) — есть вероятность события $(0 \leq 𝑃(y) \leq 0)$, тогда $𝐹(y)$ — некоторая функция, принимающая значения от $-\infty$ до $+\infty$. {{posts:logistic-fig1.png| Логистическая функция}} Как видно из графика, для большинства значений аргумента 𝑦 вероятность события $𝐹(y)$ может принимать одно из двух значений 0 или 1, однако вблизи точки x=0 значение 𝐹 испытывает скачок. Здесь чтобы разделить исходы на 0 и 1 мы должны ввести точку отсечки — значение вероятности события $𝐹(y)$ выше которой трактуются как 1, а ниже — как 0. По умолчанию, это значение равно 0.5. Тем не менее, в каждом конкретном случае мы модем изменять её для обеспечения лучших результатов в классификации. Например, если нас интересует только один из возможных исходов. ===== Описательный анализ ===== Ниже по ссылке лежат исходные {{posts:data.zip|данные}} для анализа. Их необходимо скачать и распаковать файл в директорию с проектом. # нам понядобятся следующие пакеты library(tidyverse) library(knitr) library(ROCR) library(caret) # обратите внимание на то, как мы читаем данные: # указываем, чтобы первая строка в файле трактовалась как строка заголовка # также говорим чтобы при чтении строковые значения воспринимались как категориальные teleco.raw.data <- read.csv("WA_Fn-UseC_-Telco-Customer-Churn.csv", header = TRUE, stringsAsFactors = TRUE) ^customerID ^gender ^SeniorCitizen ^Partner ^Dependents ^tenure ^PhoneService ^MultipleLines ^InternetService ^OnlineSecurity ^OnlineBackup ^DeviceProtection ^TechSupport ^StreamingTV ^StreamingMovies ^Contract ^PaperlessBilling ^PaymentMethod ^MonthlyCharges ^TotalCharges ^Churn^ |7590-VHVEG |Female |0 |Yes |No |1 |No |No phone service |DSL |No |Yes |No |No |No |No |Month-to-month |Yes |Electronic check |29.85 |29.85 |No| |5575-GNVDE |Male |0 |No |No |34 |Yes |No |DSL |Yes |No |Yes |No |No |No |One year |No |Mailed check |56.95 |1889.50 |No| |3668-QPYBK |Male |0 |No |No |2 |Yes |No |DSL |Yes |Yes |No |No |No |No |Month-to-month |Yes |Mailed check |53.85 |108.15 |Yes| |7795-CFOCW |Male |0 |No |No |45 |No |No phone service |DSL |Yes |No |Yes |Yes |No |No |One year |No |Bank transfer (automatic) |42.30 |1840.75 |No| |9237-HQITU |Female |0 |No |No |2 |Yes |No |Fiber optic |No |No |No |No |No |No |Month-to-month |Yes |Electronic check |70.70 |151.65 |Yes| При загрузке файла система сама определила тип каждого из столбцов, но во избежание проблем мы должны проверить их str(teleco.raw.data) ## 'data.frame': 7043 obs. of 21 variables: ## $ customerID : Factor w/ 7043 levels "0002-ORFBO","0003-MKNFE",..: 5376 3963 2565 5536 6512 6552 1003 4771 5605 4535 ... ## $ gender : Factor w/ 2 levels "Female","Male": 1 2 2 2 1 1 2 1 1 2 ... ## $ SeniorCitizen : int 0 0 0 0 0 0 0 0 0 0 ... ## $ Partner : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 2 1 ... ## $ Dependents : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 2 1 1 2 ... ## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ... ## $ PhoneService : Factor w/ 2 levels "No","Yes": 1 2 2 1 2 2 2 1 2 2 ... ## $ MultipleLines : Factor w/ 3 levels "No","No phone service",..: 2 1 1 2 1 3 3 2 3 1 ... ## $ InternetService : Factor w/ 3 levels "DSL","Fiber optic",..: 1 1 1 1 2 2 2 1 2 1 ... ## $ OnlineSecurity : Factor w/ 3 levels "No","No internet service",..: 1 3 3 3 1 1 1 3 1 3 ... ## $ OnlineBackup : Factor w/ 3 levels "No","No internet service",..: 3 1 3 1 1 1 3 1 1 3 ... ## $ DeviceProtection: Factor w/ 3 levels "No","No internet service",..: 1 3 1 3 1 3 1 1 3 1 ... ## $ TechSupport : Factor w/ 3 levels "No","No internet service",..: 1 1 1 3 1 1 1 1 3 1 ... ## $ StreamingTV : Factor w/ 3 levels "No","No internet service",..: 1 1 1 1 1 3 3 1 3 1 ... ## $ StreamingMovies : Factor w/ 3 levels "No","No internet service",..: 1 1 1 1 1 3 1 1 3 1 ... ## $ Contract : Factor w/ 3 levels "Month-to-month",..: 1 2 1 2 1 1 1 1 1 2 ... ## $ PaperlessBilling: Factor w/ 2 levels "No","Yes": 2 1 2 1 2 2 2 1 2 1 ... ## $ PaymentMethod : Factor w/ 4 levels "Bank transfer (automatic)",..: 3 4 4 1 3 3 2 4 3 1 ... ## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ... ## $ TotalCharges : num 29.9 1889.5 108.2 1840.8 151.7 ... ## $ Churn : Factor w/ 2 levels "No","Yes": 1 1 2 1 2 2 1 1 2 1 ... Ага, фактор `SeniorCitizen` помечен как числовой, но очевидно, что он категориальный, заменим его. Также переместим фактор `Churn` на первое место для удобства. teleco.raw.data$SeniorCitizen=as.factor(teleco.raw.data$SeniorCitizen) teleco.raw.data %>% relocate(Churn) -> prepared.data Теперь посмотрим, в каких столбцах находятся пропущенные данные и сколько их: sapply(prepared.data,function(x) sum(is.na(x))) ## Churn 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 Замечательно, пустые значения есть только в столбце `TotalCharges` и их всего 11. Потому можем просто удалить записи, которые содержат пустые значения. teleco.raw.data[complete.cases(teleco.raw.data),]->teleco.raw.data # мы воспользовались функцией complete.cases, котора возвращает # логический индекс строк, которые не содержат пустые значения prepared.data[complete.cases(prepared.data),] ->prepared.data ===== Подготовим тренировочную и тестовю выборки из наших данных ===== Соотношение числа элементов тренировочной и тестовой выборки будет 75%:25%. #Предварительно закодируем наши факторы как серию столбцов из 0 и 1, так называемое `one_hot` кодирование. require(mltools) one_hot(as.data.table(prepared.data), dropUnusedLevels=T)->prepared.data smp_size <- floor(0.75 * nrow(prepared.data)) set.seed(123) train_ind <- sample(seq_len(nrow(prepared.data)), size = smp_size) train_df <- prepared.data[train_ind, ] test_df <- prepared.data[-train_ind, ] Теперь у нас есть тренировочный и тестовый наборы, определим модель: model <- glm(Churn ~.,family=binomial(link='logit'),data=train_df) # Вариационный анализ покажет нам наиболее важные факторы anova(model, test="Chisq")->res res[with(res, order(-Deviance)),] ## ## Analysis of Deviance Table ## ## Model: binomial, link: logit ## ## Response: Churn ## ## Terms added sequentially (first to last) ## ## ## Df Deviance Resid. Df Resid. Dev ## tenure 1 637.02 5268 5217.6 ## `InternetService_Fiber optic` 1 370.10 5264 4644.5 ## MultipleLines_No 1 143.90 5266 5073.2 ## Partner_No 1 124.20 5270 5891.6 ## SeniorCitizen_0 1 91.70 5271 6015.8 ## `Contract_Month-to-month` 1 80.86 5257 4479.0 ## InternetService_DSL 1 58.65 5265 5014.6 ## Dependents_No 1 36.94 5269 5854.6 ## OnlineSecurity_No 1 28.75 5263 4615.7 ## StreamingTV_No 1 23.88 5259 4571.4 ## TechSupport_No 1 19.90 5260 4595.3 ## TotalCharges 1 15.58 5250 4415.5 ## `Contract_One year` 1 14.79 5256 4464.2 ## PaperlessBilling_No 1 12.68 5255 4451.5 ## StreamingMovies_No 1 11.60 5258 4559.8 ## `PaymentMethod_Electronic check` 1 10.46 5252 4433.3 ## `PaymentMethod_Credit card (automatic)` 1 7.06 5253 4443.7 ## MonthlyCharges 1 2.20 5251 4431.1 ## `PaymentMethod_Bank transfer (automatic)` 1 0.70 5254 4450.8 ## gender_Female 1 0.57 5272 6107.5 ## PhoneService_No 1 0.47 5267 5217.1 ## OnlineBackup_No 1 0.27 5262 4615.5 ## DeviceProtection_No 1 0.26 5261 4615.2 ===== Анализ результатов ===== Теперь давайте посмотрим, как наша модель работает на тестовой выборке: fitted.results <- predict(model,newdata=test_df,type='response') fitted.results <- ifelse(fitted.results > 0.5,1,0) misClasificError <- mean(fitted.results != test_df$Churn) print(paste('Accuracy',1-misClasificError)) ## [1] "Accuracy 0.82" Здесь мы получили, что модель дает правильные результаты в 82% случаев, при этом это процент верно предсказанных позитивных исходов (в нашем случае это сигнал, что клиент остался с поставщиком) Sensitivity=TP/(TP+FN) И его можно оценить из матрицы неточностей (см. ниже) # матрица неточностей имеет вид confusionMatrix(data=factor(fitted.results), reference = factor(test_df$Churn)) ## Confusion Matrix and Statistics ## ## Reference ## Prediction 0 1 ## 0 1180 196 ## 1 111 271 ## ## Accuracy : 0.8254 ## 95% CI : (0.8068, 0.8428) ## No Information Rate : 0.7344 ## P-Value [Acc > NIR] : < 2.2e-16 ## ## Kappa : 0.5248 ## ## Mcnemar's Test P-Value : 1.634e-06 ## ## Sensitivity : 0.9140 ## Specificity : 0.5803 ## Pos Pred Value : 0.8576 ## Neg Pred Value : 0.7094 ## Prevalence : 0.7344 ## Detection Rate : 0.6712 ## Detection Prevalence : 0.7827 ## Balanced Accuracy : 0.7472 ## ## 'Positive' Class : 0 Здесь $Accuracy=\frac{TP+TN}{P+N}$, $Senitivity = \frac{TP}{P}$, $Specificity=\frac{TN}{N}$, $Precisiob=\frac{TP}{TP+FP}$. В нашем случае Specificity=58% — специфичность - процент верно предсказанных негативных исходов, то есть случаев, когда клиент ушел от поставщика услуг. В то же время Sensitivity=91%, число верно предсказанных положительных исходов, тоесть случаев, когда клиент остался с поставщиком услуг. Общая точность модели составляет 82%. Построим теперь график зависимости True negative rate от False negative rate. {{posts:tnr_performance.png | Производительность модели в зависимости от выбора точки отсечки.}} Здесь на графике мы видим, что увеличение порога отсечки увеличивает как TPR, так и TNR. Здесь варе баланс. В зависимости от того, предсказание какого исход предпочтительнее, выбирается та или иная точка отсечки. ====== Вывод ====== Что в итоге: мы натренировали модель логистической регрессии, которая по имеющимся данным предсказывает уйдет ли клиент в другую компанию, или останется здесь. Полученная модель в 58% случаев верно указывает на такие ситуации. Модель обучена не идеально, выбор точки отсечки может существенно улучшить предсказательную способность модели к тому или иному исходу.