GLM у R: Узагальнена лінійна модель з прикладом

Що таке логістична регресія?

Логістична регресія використовується для прогнозування класу, тобто ймовірності. Логістична регресія може точно передбачити двійковий результат.

Уявіть, що ви хочете передбачити, чи відмовляють / приймають позику на основі багатьох ознак. Логістична регресія має вигляд 0/1. y = 0, якщо позику відхилено, y = 1, якщо прийнято.

Модель логістичної регресії відрізняється від моделі лінійної регресії двома способами.

• Перш за все, логістична регресія приймає лише дихотомічний (двійковий) вхід як залежну змінну (тобто вектор 0 і 1).
• По-друге, результат вимірюється наступною імовірнісною функцією зв’язку, яка називається сигмовидною завдяки своїй S-подібній формі:

Вихід функції завжди знаходиться від 0 до 1. Перевірте зображення нижче

Сигмоїдна функція повертає значення від 0 до 1. Для завдання класифікації нам потрібен дискретний результат 0 або 1.

Щоб перетворити безперервний потік в дискретне значення, ми можемо встановити рішення, яке має обмеження 0,5. Усі значення, що перевищують цей поріг, класифікуються як 1

У цьому підручнику ви дізнаєтесь

• Що таке логістична регресія?
• Як створити узагальнену модель вкладиша (GLM)
• Крок 1) Перевірте безперервні змінні
• Крок 2) Перевірте змінні фактору
• Крок 3) Розробка функцій
• Крок 4) Зведена статистика
• Крок 5) Поїзд / тест
• Крок 6) Створення моделі
• Крок 7) Оцініть ефективність моделі

Як створити узагальнену модель вкладиша (GLM)

Давайте використаємо набір даних для дорослих , щоб проілюструвати логістичну регресію. "Дорослий" - чудовий набір даних для класифікаційного завдання. Мета полягає в тому, щоб передбачити, чи не перевищить річний дохід особи в доларах 50 000. Набір даних містить 46 033 спостереження та десять функцій:

• вік: вік особи. Числовий
• освіта: Освітній рівень особистості. Фактор.
• marital.status: Сімейний стан особи. Фактор, тобто не одружений, одружений / громадянин / дружина,…
• стать: Стать особи. Фактор, тобто чоловічий чи жіночий
• дохід: цільова змінна. Дохід вище або нижче 50 000. Коефіцієнт, тобто> 50K, <= 50K

серед інших

library(dplyr)data_adult <-read.csv("https://raw.githubusercontent.com/guru99-edu/R-Programming/master/adult.csv")glimpse(data_adult)

Вихід:

Observations: 48,842Variables: 10$ x  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,… $ age  25, 38, 28, 44, 18, 34, 29, 63, 24, 55, 65, 36, 26… $ workclass  Private, Private, Local-gov, Private, ?, Private,… $ education  11th, HS-grad, Assoc-acdm, Some-college, Some-col… $ educational.num  7, 9, 12, 10, 10, 6, 9, 15, 10, 4, 9, 13, 9, 9, 9,… $ marital.status  Never-married, Married-civ-spouse, Married-civ-sp… $ race  Black, White, White, Black, White, White, Black,… $ gender  Male, Male, Male, Male, Female, Male, Male, Male,… $ hours.per.week  40, 50, 40, 40, 30, 30, 40, 32, 40, 10, 40, 40, 39… $ income  <=50K, <=50K, >50K, >50K, <=50K, <=50K, <=50K, >5… 

Ми будемо діяти наступним чином:

• Крок 1: Перевірте безперервні змінні
• Крок 2: Перевірте змінні фактору
• Крок 3: Розробка функцій
• Крок 4: Зведена статистика
• Крок 5: Поїзд / тест
• Крок 6: Створіть модель
• Крок 7: Оцініть ефективність моделі
• Крок 8: Удосконалення моделі

Ваше завдання передбачити, яка особа матиме дохід вище 50 тис.

У цьому посібнику кожен крок буде детально описаний для проведення аналізу реального набору даних.

Крок 1) Перевірте безперервні змінні

На першому кроці ви можете побачити розподіл неперервних змінних.

continuous <-select_if(data_adult, is.numeric)summary(continuous)

Пояснення коду

• безперервний <- select_if (data_adult, is.numeric): Використовуйте функцію select_if () з бібліотеки dplyr, щоб вибрати лише числові стовпці
• резюме (безперервно): Друк короткої статистики

Вихід:

## X age educational.num hours.per.week## Min. : 1 Min. :17.00 Min. : 1.00 Min. : 1.00## 1st Qu.:11509 1st Qu.:28.00 1st Qu.: 9.00 1st Qu.:40.00## Median :23017 Median :37.00 Median :10.00 Median :40.00## Mean :23017 Mean :38.56 Mean :10.13 Mean :40.95## 3rd Qu.:34525 3rd Qu.:47.00 3rd Qu.:13.00 3rd Qu.:45.00## Max. :46033 Max. :90.00 Max. :16.00 Max. :99.00

З наведеної таблиці видно, що дані мають абсолютно різні масштаби та години. Per.weeks має великі відхилення (тобто ми дивимося на останній квартиль та максимальне значення).

Ви можете впоратися з цим, виконавши два кроки:

• 1: Побудуйте графік розподілу годин на тиждень
• 2: Стандартизуйте неперервні змінні

1. Складіть графік розподілу

Давайте розглянемо ближче розподіл годин. На тиждень

# Histogram with kernel density curvelibrary(ggplot2)ggplot(continuous, aes(x = hours.per.week)) +geom_density(alpha = .2, fill = "#FF6666")

Вихід:

Змінна має багато відхилень та не чітко визначений розподіл. Ви можете частково вирішити цю проблему, видаливши 0,01 відсотка годин на тиждень.

Основний синтаксис квантилю:

quantile(variable, percentile)arguments:-variable: Select the variable in the data frame to compute the percentile-percentile: Can be a single value between 0 and 1 or multiple value. If multiple, use this format: `c(A,B,C,… )- `A`,`B`,`C` and `… ` are all integer from 0 to 1.

Обчислюємо верхній 2-відсотковий процентиль

top_one_percent <- quantile(data_adult$hours.per.week, .99)top_one_percent

Пояснення коду

• квантиль (data_adult $ hours.per.week, .99): Обчислити значення 99 відсотків робочого часу

Вихід:

## 99%## 80 

98 відсотків населення працює менше 80 годин на тиждень.

Ви можете скинути спостереження вище цього порогу. Ви використовуєте фільтр із бібліотеки dplyr.

data_adult_drop <-data_adult %>%filter(hours.per.week
Вихід:


## [1] 45537 10 
 

Стандартизуйте неперервні змінні

Ви можете стандартизувати кожен стовпець для поліпшення продуктивності, оскільки ваші дані не мають однакового масштабу. Ви можете використовувати функцію mutate_if з бібліотеки dplyr. Основний синтаксис:
mutate_if(df, condition, funs(function))arguments:-`df`: Data frame used to compute the function- `condition`: Statement used. Do not use parenthesis- funs(function): Return the function to apply. Do not use parenthesis for the function
Ви можете стандартизувати числові стовпці наступним чином:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Пояснення коду

mutate_if (is.numeric, funs (масштаб)): умова є лише числовим стовпцем, а функцією є масштаб

Вихід:
## X age workclass education educational.num## 1 -1.732680 -1.02325949 Private 11th -1.22106443## 2 -1.732605 -0.03969284 Private HS-grad -0.43998868## 3 -1.732530 -0.79628257 Local-gov Assoc-acdm 0.73162494## 4 -1.732455 0.41426100 Private Some-college -0.04945081## 5 -1.732379 -0.34232873 Private 10th -1.61160231## 6 -1.732304 1.85178149 Self-emp-not-inc Prof-school 1.90323857## marital.status race gender hours.per.week income## 1 Never-married Black Male -0.03995944 <=50K## 2 Married-civ-spouse White Male 0.86863037 <=50K## 3 Married-civ-spouse White Male -0.03995944 >50K## 4 Married-civ-spouse Black Male -0.03995944 >50K## 5 Never-married White Male -0.94854924 <=50K## 6 Married-civ-spouse White Male -0.76683128 >50K
Крок 2) Перевірте змінні фактору
Цей крок має дві цілі:

Перевірте рівень у кожному категоріальному стовпці
Визначте нові рівні

Ми поділимо цей крок на три частини:

Виберіть категоріальні стовпці
Зберігайте гістограму кожного стовпця у списку
Роздрукуйте графіки

Ми можемо вибрати стовпці коефіцієнта з кодом нижче:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Пояснення коду

data.frame (select_if (data_adult, is.factor)): Ми зберігаємо стовпці факторів у факторі у типі кадру даних. Бібліотеці ggplot2 потрібен об'єкт кадру даних.

Вихід:
## [1] 6 
Набір даних містить 6 категоріальних змінних
Другий крок - більш кваліфікований. Ви хочете побудувати гістограму для кожного стовпця у факторі кадру даних. Більш зручно автоматизувати процес, особливо в ситуації, коли багато колонок.
library(ggplot2)# Create graph for each columngraph <- lapply(names(factor),function(x)ggplot(factor, aes(get(x))) +geom_bar() +theme(axis.text.x = element_text(angle = 90)))
Пояснення коду

lapply (): Використовуйте функцію lapply () для передачі функції у всіх стовпцях набору даних. Ви зберігаєте результати у списку
function (x): функція буде оброблена для кожного x. Тут x - стовпці
ggplot (коефіцієнт, aes (get (x))) + geom_bar () + тема (axis.text.x = element_text (кут = 90)): Створіть стовпчасту діаграму для кожного елемента x. Зверніть увагу, щоб повернути х як стовпець, вам потрібно включити його всередину get ()

Останній крок відносно легкий. Ви хочете надрукувати 6 графіків.
# Print the graphgraph
Вихід:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Примітка: Використовуйте наступну кнопку, щоб перейти до наступного графіку

Крок 3) Розробка функцій
Перероблення освіти
З графіку вище видно, що змінна освіта має 16 рівнів. Це суттєво, і деякі рівні мають відносно низьку кількість спостережень. Якщо ви хочете покращити обсяг інформації, яку ви можете отримати від цієї змінної, ви можете перетворити її на вищий рівень. А саме ви створюєте більші групи зі схожим рівнем освіти. Наприклад, низький рівень освіти буде перетворений на вибування. Вищі рівні освіти будуть змінені на магістерські.
Ось деталь:
 

 
 

Старий рівень
 

Новий рівень
 

 

 

 
 

Дошкільний заклад
 

опускати
 

 
 

10-й
 

Опускати
 

 
 

11-й
 

Опускати
 

 
 

12-й
 

Опускати
 

 
 

1-й-4-й
 

Опускати
 

 
 

5-6-й
 

Опускати
 

 
 

7-8-й
 

Опускати
 

 
 

9-й
 

Опускати
 

 
 

HS-Grad
 

HighGrad
 

 
 

Деякі-коледж
 

Громада
 

 
 

Assoc-ACDM
 

Громада
 

 
 

Доц
 

Громада
 

 
 

Холостяки
 

Холостяки
 

 
 

Майстри
 

Майстри
 

 
 

Проф-школа
 

Майстри
 

 
 

Докторантура
 

Кандидат наук
 

 

 

 
recast_data <- data_adult_rescale % > %select(-X) % > %mutate(education = factor(ifelse(education == "Preschool" | education == "10th" | education == "11th" | education == "12th" | education == "1st-4th" | education == "5th-6th" | education == "7th-8th" | education == "9th", "dropout", ifelse(education == "HS-grad", "HighGrad", ifelse(education == "Some-college" | education == "Assoc-acdm" | education == "Assoc-voc", "Community",ifelse(education == "Bachelors", "Bachelors",ifelse(education == "Masters" | education == "Prof-school", "Master", "PhD")))))))
Пояснення коду

Ми використовуємо дієслово mutate з бібліотеки dplyr. Ми змінюємо цінності освіти твердженням ifelse

У наведеній нижче таблиці ви створюєте зведену статистику, щоб в середньому побачити, скільки років освіти (значення z) потрібно для досягнення ступеня бакалавра, магістра чи доктора філософії.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Вихід:
## # A tibble: 6 x 3## education average_educ_year count##   ## 1 dropout -1.76147258 5712## 2 HighGrad -0.43998868 14803## 3 Community 0.09561361 13407## 4 Bachelors 1.12216282 7720## 5 Master 1.60337381 3338## 6 PhD 2.29377644 557
Переглянути сімейний стан
Також можна створити нижчі рівні для сімейного стану. У наступному коді ви змінюєте рівень наступним чином:
 

 
 

Старий рівень
 

Новий рівень
 

 

 

 
 

Ніколи не одружений
 

НЕ одружений
 

 
 

Одружений / подружжя відсутні
 

НЕ одружений
 

 
 

Одружений / дружина
 

Одружений
 

 
 

Одружений / громадянин / дружина
 
 

 
 

Відокремлено
 

Відокремлено
 

 
 

Розлучився
 
 

 
 

Вдови
 

Вдова
 

 

 

 
# Change level marryrecast_data <- recast_data % > %mutate(marital.status = factor(ifelse(marital.status == "Never-married" | marital.status == "Married-spouse-absent", "Not_married", ifelse(marital.status == "Married-AF-spouse" | marital.status == "Married-civ-spouse", "Married", ifelse(marital.status == "Separated" | marital.status == "Divorced", "Separated", "Widow")))))
 Ви можете перевірити кількість осіб у кожній групі. 
table(recast_data$marital.status)
Вихід:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Крок 4) Зведена статистика
Пора перевірити статистику щодо наших цільових змінних. На графіку нижче ви підраховуєте відсоток людей, які заробляють більше 50 тис. З урахуванням їхньої статі.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Вихід:

Далі перевірте, чи походження особи впливає на її заробіток.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Вихід:

Кількість годин роботи за статтю.
# box plot gender working timeggplot(recast_data, aes(x = gender, y = hours.per.week)) +geom_boxplot() +stat_summary(fun.y = mean,geom = "point",size = 3,color = "steelblue") +theme_classic()
Вихід:

Графічний графік підтверджує, що розподіл робочого часу відповідає різним групам. У графічному графіку обидва статі не мають однорідних спостережень.
Ви можете перевірити щільність робочого часу на тиждень за типом навчання. Дистрибутиви мають багато чітких виборів. Ймовірно, це можна пояснити типом контракту в США.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Пояснення коду

ggplot (recast_data, aes (x = hours.per.week)): Графік щільності вимагає лише однієї змінної
geom_density (aes (колір = освіта), альфа = 0,5): геометричний об'єкт для управління щільністю

Вихід:

Щоб підтвердити свої думки, ви можете виконати односторонній тест ANOVA:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Вихід:
## Df Sum Sq Mean Sq F value Pr(>F)## education 5 1552 310.31 321.2 <2e-16 ***## Residuals 45531 43984 0.97## ---## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Тест ANOVA підтверджує різницю в середньому між групами.
Нелінійність
Перш ніж запускати модель, ви зможете побачити, чи пов'язана кількість відпрацьованих годин з віком.
library(ggplot2)ggplot(recast_data, aes(x = age, y = hours.per.week)) +geom_point(aes(color = income),size = 0.5) +stat_smooth(method = 'lm',formula = y~poly(x, 2),se = TRUE,aes(color = income)) +theme_classic()
Пояснення коду

ggplot (recast_data, aes (x = вік, y = години на тиждень)): Встановіть естетику графіка
geom_point (aes (колір = дохід), розмір = 0,5): побудуйте точковий графік
stat_smooth (): Додайте рядок тренду з такими аргументами:

method = 'lm': Побудуйте графік встановленого значення, якщо лінійна регресія
формула = y ~ poly (x, 2): підходить поліноміальна регресія
se = TRUE: Додайте стандартну помилку
aes (колір = дохід): Розбийте модель за доходами



Вихід:

У двох словах, ви можете перевірити умови взаємодії в моделі, щоб зрозуміти ефект нелінійності між тижневим робочим часом та іншими функціями. Важливо виявити, за яких умов робочий час відрізняється.
Співвідношення
Наступна перевірка полягає у візуалізації кореляції між змінними. Ви перетворюєте тип рівня фактора в числовий, щоб можна було побудувати теплову карту, що містить коефіцієнт кореляції, обчислений методом Спірмена.
library(GGally)# Convert data to numericcorr <- data.frame(lapply(recast_data, as.integer))# Plot the graphggcorr(corr,method = c("pairwise", "spearman"),nbreaks = 6,hjust = 0.8,label = TRUE,label_size = 3,color = "grey50")
Пояснення коду

data.frame (lapply (recast_data, as.integer)): Перетворення даних у числові
ggcorr () побудуйте теплову карту з такими аргументами:

метод: метод обчислення кореляції
nbreaks = 6: Кількість обривів
hjust = 0,8: Контрольне положення імені змінної в графіку
label = TRUE: Додайте мітки в центр вікон
label_size = 3: розмір міток
color = "grey50"): Колір етикетки



Вихід:

Крок 5) Поїзд / тест
Будь-яке контрольоване завдання машинного навчання вимагає розподілу даних між набором поїздів та набором тестів. Ви можете використати "функцію", яку ви створили в інших навчальних посібниках, що контролюються, для створення набору поїздів / тестів.
set.seed(1234)create_train_test <- function(data, size = 0.8, train = TRUE) {n_row = nrow(data)total_row = size * n_rowtrain_sample <- 1: total_rowif (train == TRUE) {return (data[train_sample, ])} else {return (data[-train_sample, ])}}data_train <- create_train_test(recast_data, 0.8, train = TRUE)data_test <- create_train_test(recast_data, 0.8, train = FALSE)dim(data_train)
Вихід:
## [1] 36429 9
 
dim(data_test)
Вихід:
## [1] 9108 9 
Крок 6) Створення моделі
Щоб побачити, як працює алгоритм, ви використовуєте пакет glm (). Узагальнена лінійна модель являє собою набір моделей. Основний синтаксис:
glm(formula, data=data, family=linkfunction()Argument:- formula: Equation used to fit the model- data: dataset used- Family: - binomial: (link = "logit")- gaussian: (link = "identity")- Gamma: (link = "inverse")- inverse.gaussian: (link = "1/mu^2")- poisson: (link = "log")- quasi: (link = "identity", variance = "constant")- quasibinomial: (link = "logit")- quasipoisson: (link = "log")
Ви готові оцінити логістичну модель, щоб розподілити рівень доходу між набором функцій.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Пояснення коду

формула <- дохід ~.: Створіть модель відповідно
logit <- glm (формула, data = data_train, family = 'binomial'): Встановіть логістичну модель (family = 'binomial') з даними data_train.
резюме (logit): Друк короткого викладу моделі

Вихід:
#### Call:## glm(formula = formula, family = "binomial", data = data_train)## ## Deviance Residuals:## Min 1Q Median 3Q Max## -2.6456 -0.5858 -0.2609 -0.0651 3.1982#### Coefficients:## Estimate Std. Error z value Pr(>|z|)## (Intercept) 0.07882 0.21726 0.363 0.71675## age 0.41119 0.01857 22.146 < 2e-16 ***## workclassLocal-gov -0.64018 0.09396 -6.813 9.54e-12 ***## workclassPrivate -0.53542 0.07886 -6.789 1.13e-11 ***## workclassSelf-emp-inc -0.07733 0.10350 -0.747 0.45499## workclassSelf-emp-not-inc -1.09052 0.09140 -11.931 < 2e-16 ***## workclassState-gov -0.80562 0.10617 -7.588 3.25e-14 ***## workclassWithout-pay -1.09765 0.86787 -1.265 0.20596## educationCommunity -0.44436 0.08267 -5.375 7.66e-08 ***## educationHighGrad -0.67613 0.11827 -5.717 1.08e-08 ***## educationMaster 0.35651 0.06780 5.258 1.46e-07 ***## educationPhD 0.46995 0.15772 2.980 0.00289 **## educationdropout -1.04974 0.21280 -4.933 8.10e-07 ***## educational.num 0.56908 0.07063 8.057 7.84e-16 ***## marital.statusNot_married -2.50346 0.05113 -48.966 < 2e-16 ***## marital.statusSeparated -2.16177 0.05425 -39.846 < 2e-16 ***## marital.statusWidow -2.22707 0.12522 -17.785 < 2e-16 ***## raceAsian-Pac-Islander 0.08359 0.20344 0.411 0.68117## raceBlack 0.07188 0.19330 0.372 0.71001## raceOther 0.01370 0.27695 0.049 0.96054## raceWhite 0.34830 0.18441 1.889 0.05894 .## genderMale 0.08596 0.04289 2.004 0.04506 *## hours.per.week 0.41942 0.01748 23.998 < 2e-16 ***## ---## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1## ## (Dispersion parameter for binomial family taken to be 1)## ## Null deviance: 40601 on 36428 degrees of freedom## Residual deviance: 27041 on 36406 degrees of freedom## AIC: 27087#### Number of Fisher Scoring iterations: 6
Короткий зміст нашої моделі розкриває цікаву інформацію. Ефективність логістичної регресії оцінюється за певними ключовими показниками.

AIC (Інформаційні критерії Akaike): це еквівалент R2 в логістичній регресії. Він вимірює придатність, коли штраф застосовується до кількості параметрів. Менші значення AIC вказують на те, що модель ближча до істини.
Нульове відхилення: підходить для моделі лише з перехопленням. Ступінь свободи n-1. Ми можемо інтерпретувати це як значення Хі-квадрат (пристосоване значення, яке відрізняється від перевірки гіпотези фактичного значення).
Залишковий девіант: модель із усіма змінними. Це також інтерпретується як перевірка гіпотези хі-квадрат.
Кількість ітерацій, що оцінюються Фішером: Кількість ітерацій перед зближенням.

Висновок функції glm () зберігається у списку. У наведеному нижче коді показано всі елементи, доступні у змінній logit, яку ми створили для оцінки логістичної регресії.
# Список дуже довгий, надрукуйте лише перші три елементи
lapply(logit, class)[1:3]
Вихід:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Кожне значення можна витягти зі знаком $, за яким слідує назва метрик. Наприклад, ви зберегли модель як logit. Для отримання критеріїв AIC ви використовуєте:
logit$aic
Вихід:
## [1] 27086.65
Крок 7) Оцініть ефективність моделі
Матриця плутанини
Матриця неточностей є кращим вибором для оцінки ефективності класифікації по порівнянні з різними метриками ви бачили раніше. Загальна ідея полягає в тому, щоб підрахувати, скільки разів справжні екземпляри класифікуються як False.

Для обчислення матриці плутанини спочатку потрібно мати набір прогнозів, щоб їх можна було порівняти з фактичними цілями.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Пояснення коду

передбачити (logit, data_test, type = 'response'): обчислити передбачення на наборі тестів. Встановіть type = 'response' для обчислення ймовірності відповіді.
таблиця (data_test $ доходу, прогнозувати> 0,5): Обчислити матрицю плутанини. передбачити> 0,5 означає, що він повертає 1, якщо передбачувані ймовірності перевищують 0,5, інакше 0.

Вихід:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Кожен рядок у матриці плутанини представляє фактичну ціль, тоді як кожен стовпець - передбачену мету. Перший рядок цієї матриці розглядає дохід нижчий за 50 тис. (Фальшивий клас): 6241 були правильно класифіковані як особи з доходом нижче 50 тис. ( Справді негативний ), тоді як решта була помилково класифікована як вище 50 тис. ( Хибнопозитивні ). Другий рядок враховує дохід вище 50 тис., Позитивний клас становив 1229 ( справді позитивний ), тоді як справжній негативний - 1074.
Ви можете розрахувати точність моделі шляхом підсумовування істинного позитивного + істинного негативного за загальне спостереження

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Пояснення коду

sum (diag (table_mat)): Сума діагоналі
sum (table_mat): Сума матриці.

Вихід:
## [1] 0.8277339 
Здається, модель страждає від однієї проблеми, вона завищує кількість помилкових негативів. Це називається парадоксом перевірки точності . Ми заявили, що точність - це відношення правильних прогнозів до загальної кількості випадків. Ми можемо мати відносно високу точність, але марну модель. Це трапляється, коли існує домінуючий клас. Якщо озирнутися на матрицю плутанини, можна побачити, що більшість випадків класифікуються як справді негативні. Уявіть собі, зараз модель класифікувала всі класи як негативні (тобто нижче 50k). Ви мали б точність 75 відсотків (6718/6718 + 2257). Ваша модель працює краще, але намагається відрізнити справжній позитив від справжнього негативу.
У такій ситуації переважно мати більш лаконічну метрику. Ми можемо подивитися на:

Точність = TP / (TP + FP)
Відкликання = TP / (TP + FN)

Точність проти відкликання
Точність розглядає точність позитивного прогнозу. Recall - це співвідношення позитивних випадків, які правильно виявив класифікатор;
Ви можете побудувати дві функції для обчислення цих двох показників

Точність побудови

precision <- function(matrix) {# True positivetp <- matrix[2, 2]# false positivefp <- matrix[1, 2]return (tp / (tp + fp))}
Пояснення коду

mat [1,1]: Повертає першу комірку першого стовпця кадру даних, тобто справжній позитив
килимок [1,2]; Повернути першу комірку другого стовпця кадру даних, тобто помилково позитивне

recall <- function(matrix) {# true positivetp <- matrix[2, 2]# false positivefn <- matrix[2, 1]return (tp / (tp + fn))}
Пояснення коду

mat [1,1]: Повертає першу комірку першого стовпця кадру даних, тобто справжній позитив
килимок [2,1]; Повернути другу комірку першого стовпця кадру даних, тобто помилково негативний результат

Ви можете перевірити свої функції
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Вихід:
## [1] 0.712877## [2] 0.5336518
Коли модель каже, що це особа, яка перевищує 50 тис., Це вірно лише у 54 відсотках випадків, а може претендувати на осіб, що перевищує 50 тис. У 72 відсотках випадків.
Ви можете створити середнє гармонічне значення цих двох показників, тобто воно надає більшої ваги нижчим значенням.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Вихід:
## [1] 0.6103799 
Точність проти відкликання компромісу
Неможливо мати як високу точність, так і високу відкликаність.
Якщо ми збільшимо точність, правильного індивіда буде краще передбачити, але ми б пропустили багато з них (нижча відкликання). У деяких ситуаціях ми віддаємо перевагу більшій точності, ніж відкликання. Між точністю та відкликанням існує увігнута залежність.

Уявіть, вам потрібно передбачити, чи є у пацієнта захворювання. Ви хочете бути максимально точними.
Якщо вам потрібно виявити потенційних шахраїв на вулиці за допомогою розпізнавання обличчя, було б краще зловити багатьох людей, яких позначили як шахраїв, хоча точність низька. Поліція зможе звільнити особу, яка не є шахраєм.

Крива ROC
Характеристика приймач Операційний кривої є ще одним поширеним інструментом , використовуваним з бінарної класифікації. Це дуже схоже на криву точності / відкликання, але замість побудови графіків точності проти відкликання крива ROC показує справжній позитивний коефіцієнт (тобто відкликання) проти хибнопозитивного коефіцієнта. Помилковий позитивний показник - це відношення негативних випадків, які неправильно класифікуються як позитивні. Він дорівнює одиниці мінус справжній від’ємний показник. Справжній негативний показник також називають специфічністю . Звідси крива ROC будує графіки чутливості (відкликання) проти 1-специфічності
Щоб побудувати криву ROC, нам потрібно встановити бібліотеку під назвою RORC. Ми можемо знайти в бібліотеці conda. Ви можете ввести код:
conda install -cr r-rocr - так
Ми можемо побудувати ROC за допомогою функцій передбачення () та продуктивності ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Пояснення коду

передбачення (прогнозувати, тестувати $_доходу): Бібліотеці ROCR потрібно створити об'єкт передбачення для перетворення вхідних даних
продуктивність (ROCRpred, 'tpr', 'fpr'): повертає дві комбінації для створення на графіку. Тут побудовані tpr та fpr. Поміркуйте точність побудови та відкликання разом, використовуйте "prec", "rec".

Вихід:

Крок 8) Удосконалення моделі
Ви можете спробувати додати нелінійність моделі за взаємодії між

вік і години. на тиждень
стать і години. на тиждень.

Вам потрібно скористатися оціночним тестом, щоб порівняти обидві моделі
formula_2 <- income~age: hours.per.week + gender: hours.per.week + .logit_2 <- glm(formula_2, data = data_train, family = 'binomial')predict_2 <- predict(logit_2, data_test, type = 'response')table_mat_2 <- table(data_test$income, predict_2 > 0.5)precision_2 <- precision(table_mat_2)recall_2 <- recall(table_mat_2)f1_2 <- 2 * ((precision_2 * recall_2) / (precision_2 + recall_2))f1_2
Вихід:
## [1] 0.6109181 
Оцінка трохи вища за попередню. Ви можете продовжувати працювати над даними, намагаючись перевершити рахунок.

Резюме
Ми можемо резюмувати функцію тренування логістичної регресії в таблиці нижче:
 

 
 

Пакет
 

Об’єктивна
 

функція
 

аргумент
 

 

 

 
 

-
 

Створіть набір даних про поїзд / тест
 

create_train_set ()
 

дані, розмір, поїзд
 

 
 

glm
 

Навчіть узагальнену лінійну модель
 

glm ()
 

формула, дані, сім'я *
 

 
 

glm
 

Підсумуйте модель
 

резюме ()
 

приталена модель
 

 
 

база
 

Зробити прогноз
 

передбачити ()
 

вмонтована модель, набір даних, type = 'response'
 

 
 

база
 

Створіть матрицю плутанини
 

таблиця ()
 

y, передбачити ()
 

 
 

база
 

Створити оцінку точності
 

sum (diag (table ()) / sum (table ()
 

 
 

РПЦЗ
 

Створення ROC: Крок 1 Створення прогнозу
 

передбачення ()
 

передбачити (), y
 

 
 

РПЦЗ
 

Створення ROC: Крок 2 Створення продуктивності
 

продуктивність ()
 

передбачення (), 'tpr', 'fpr'
 

 
 

РПЦЗ
 

Створення ROC: Крок 3 Графічний графік
 

сюжет ()
 

продуктивність ()
 

 

 

Іншими моделями GLM є:
- двочлен: (посилання = "logit")
- гауссова: (посилання = "ідентичність")
- Гама: (посилання = "зворотне")
- inverse.gaussian: (посилання = "1 / mu 2")
- пуассон: (посилання = "журнал")
- квазі: (посилання = "ідентичність", дисперсія = "константа")
- квазібіноміальне: (посилання = "logit")
- квазіпоассон: (посилання = "журнал")