ГЛМ у Р: Генерализовани линеарни модел са примером

Шта је логистичка регресија?

Логистичка регресија користи се за предвиђање класе, односно вероватноће. Логистичка регресија може тачно предвидети бинарни исход.

Замислите да желите да предвидите да ли ће зајам бити одбијен / прихваћен на основу многих атрибута. Логистичка регресија је облика 0/1. и = 0 ако је кредит одбијен, и = 1 ако је прихваћен.

Логистички модел регресије разликује се од модела линеарне регресије на два начина.

• Пре свега, логистичка регресија прихвата само дихотомни (бинарни) улаз као зависну променљиву (тј. Вектор 0 и 1).
• Друго, исход се мери помоћу следеће функције пробабилистичке везе која се назива сигмоидна због свог облика С:

Излаз функције је увек између 0 и 1. Проверите слику испод

Сигмоидна функција враћа вредности од 0 до 1. За задатак класификације потребан нам је дискретни излаз 0 или 1.

Да бисмо претворили континуирани проток у дискретну вредност, можемо поставити одлуку везану на 0,5. Све вредности изнад овог прага класификоване су као 1

У овом упутству ћете научити

• Шта је логистичка регресија?
• Како направити генерализовани линијски модел (ГЛМ)
• Корак 1) Проверите континуиране променљиве
• Корак 2) Проверите променљиве фактора
• Корак 3) Инжењеринг карактеристика
• Корак 4) Резиме статистике
• Корак 5) Воз / тест сет
• Корак 6) Изградите модел
• Корак 7) Процените перформансе модела

Како направити генерализовани линијски модел (ГЛМ)

Користимо скуп података за одрасле да илуструјемо логистичку регресију. „Одрасла особа“ је сјајан скуп података за задатак класификације. Циљ је предвидети да ли ће годишњи приход појединца у доларима премашити 50.000. Скуп података садржи 46.033 запажања и десет карактеристика:

• старост: старост појединца. Нумерички
• образовање: Образовни ниво појединца. Фактор.
• брачни.статус: Брачно стање појединца. Чимбеник, тј. Никада ожењен, Ожењен / удата,…
• пол: Пол појединца. Фактор, односно мушки или женски
• приход: Циљна променљива. Приход изнад или испод 50К. Фактор тј.> 50К, <= 50К

између осталог

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.000.

У овом упутству, сваки корак ће бити детаљан како би се извршила анализа на стварном скупу података.

Корак 1) Проверите континуиране променљиве

У првом кораку можете видети расподелу континуалних променљивих.

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

Објашњење кода

• континуирано <- селецт_иф (дата_адулт, ис.нумериц): Користите функцију селецт_иф () из библиотеке дплир да бисте изабрали само нумеричке колоне
• резиме (континуирано): Одштампајте резиме статистике

Излаз:

## 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

Из горње табеле можете да видите да подаци имају потпуно различите размере и хоурс.пер.веекс има велике одступања (.погледамо последњи квартил и максималну вредност).

Можете се носити са тим у два корака:

• 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

Објашњење кода

• квантил (дата_адулт $ хоурс.пер.веек, .99): Израчунајте вредност 99 процената радног времена

Излаз:

## 99%## 80 

98 процената становништва ради испод 80 сати недељно.

Можете испустити запажања изнад овог прага. Користите филтер из библиотеке дплир.

data_adult_drop <-data_adult %>%filter(hours.per.week
Излаз:


## [1] 45537 10 
 

Стандардизовати континуалне променљиве

Можете да стандардизирате сваку колону да бисте побољшали перформансе, јер ваши подаци немају исту скалу. Можете користити функцију мутате_иф из библиотеке дплир. Основна синтакса је:
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)
Објашњење кода

мутате_иф (ис.нумериц, фунс (сцале)): Услов је само нумерички ступац, а функција скала

Излаз:
## 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)
Објашњење кода

дата.фраме (селецт_иф (дата_адулт, ис.фацтор)): Колоне фактора чувамо у фактору у типу оквира података. Библиотека ггплот2 захтева објект оквира података.

Излаз:
## [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)))
Објашњење кода

лаппли (): Користите функцију лаппли () да бисте проследили функцију у свим колонама скупа података. Излаз чувате на листи
функција (к): Функција ће се обрадити за сваки к. Овде је к колона
ггплот (фактор, аес (гет (к))) + геом_бар () + тема (акис.тект.к = елемент_тект (англе = 90)): Створите тракасти графикон за сваки к елемент. Напомена, да бисте вратили к као колону, морате га укључити у гет ()

Последњи корак је релативно лак. Желите да одштампате 6 графика.
# Print the graphgraph
Излаз:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Напомена: Користите следеће дугме за навигацију до следећег графикона

Корак 3) Инжењеринг карактеристика
Преобликовање образовања
Из горњег графикона можете видети да варијабла образовања има 16 нивоа. Ово је значајно, а неки нивои имају релативно мали број запажања. Ако желите да побољшате количину информација које можете добити од ове променљиве, можете је преправити на виши ниво. Наиме, ви стварате веће групе са сличним нивоом образовања. На пример, низак ниво образовања претвориће се у одустајање. Виши нивои образовања биће промењени у мастер.
Ево детаља:
 

 
 

Стари ниво
 

Нови ниво
 

 

 

 
 

Предшколско
 

одустати
 

 
 

10тх
 

Одустати
 

 
 

11тх
 

Одустати
 

 
 

12тх
 

Одустати
 

 
 

1.-4
 

Одустати
 

 
 

5.-6
 

Одустати
 

 
 

7-8
 

Одустати
 

 
 

9тх
 

Одустати
 

 
 

ХС-Град
 

ХигхГрад
 

 
 

Неки факултет
 

Заједница
 

 
 

Ассоц-ацдм
 

Заједница
 

 
 

Доц
 

Заједница
 

 
 

Бацхелорс
 

Бацхелорс
 

 
 

Мастерс
 

Мастерс
 

 
 

Проф-школа
 

Мастерс
 

 
 

Докторат
 

Др
 

 

 

 
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")))))))
Објашњење кода

Користимо глагол мутате из библиотеке дплир. Вредности образовања мењамо изјавом ифелсе

У доњој табели креирате збирну статистику да бисте у просеку видели колико година образовања (з-вредност) је потребно да бисте стекли звање првоступника, магистра или доктора наука.
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()
Објашњење кода

ггплот (рецаст_дата, аес (к = хоурс.пер.веек)): Графикон густине захтева само једну променљиву
геом_денсити (аес (боја = образовање), алфа = 0,5): Геометријски објекат за контролу густине

Излаз:

Да бисте потврдили своје мисли, можете да изведете једносмерни АНОВА тест:
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
АНОВА тест потврђује разлику у просеку између група.
Нелинералност
Пре него што покренете модел, можете да видите да ли је број одрађених сати повезан са годинама.
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()
Објашњење кода

ггплот (рецаст_дата, аес (к = старост, и = број сати по недељи)): Подесите естетику графика
геом_поинт (аес (боја = приход), величина = 0,5): Конструисати тачкасти приказ
стат_смоотх (): Додајте линију тренда са следећим аргументима:

метход = 'лм': Нацртати уграђену вредност ако је линеарна регресија
формула = и ~ поли (к, 2): Уклапа се полиномска регресија
се = ТРУЕ: Додајте стандардну грешку
аес (боја = приход): Поделите модел према приходу



Излаз:

Укратко, можете тестирати термине интеракције у моделу да бисте препознали нелинеарни ефекат између недељног радног времена и других карактеристика. Важно је открити под којим се условима разликује радно време.
Корелација
Следећа провера је да се визуализује корелација између променљивих. Тип факторског нивоа претварате у нумерички тако да можете уцртати мапу топлоте која садржи коефицијент корелације израчунат Спеармановом методом.
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")
Објашњење кода

дата.фраме (лаппли (рецаст_дата, ас.интегер)): Претвори податке у нумеричке
ггцорр () црта топлотну мапу са следећим аргументима:

метода: Метода за израчунавање корелације
нбреакс = 6: Број прекида
хјуст = 0,8: Контролни положај имена променљиве у графикону
лабел = ТРУЕ: Додајте ознаке у средину прозора
лабел_сизе = 3: Ознаке величине
цолор = "греи50"): Боја етикете



Излаз:

Корак 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(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)
Објашњење кода

формула <- приход ~.: Направите модел који одговара
логит <- глм (формула, дата = дата_траин, фамили = 'биномиал'): Уклапа се логистички модел (фамили = 'биномиал') са подацима дата_траин.
резиме (логит): Одштампајте резиме модела

Излаз:
#### 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
Резиме нашег модела открива занимљиве информације. Учинак логистичке регресије процењује се помоћу одређених кључних показатеља.

АИЦ (Акаике информативни критеријуми): Ово је еквивалент Р2 у логистичкој регресији. Он мери погодност када се на број параметара примени казна. Мање вредности АИЦ указују на то да је модел ближи истини.
Нулл девианце: Уклапа се у модел само уз пресретање. Степен слободе је н-1. Можемо је протумачити као вредност хи-квадрата (уклопљена вредност различита од тестирања хипотезе стварне вредности).
Преостали одступање: Модел са свим променљивим. Такође се тумачи као тестирање хи-квадрат хипотезе.
Број итерација Фисхер бодовања: Број итерација пре конвергирања.

Излаз функције глм () чува се на листи. Доњи код приказује све ставке доступне у логит променљивој коју смо конструисали за процену логистичке регресије.
# Листа је врло дугачка, одштампајте само прва три елемента
lapply(logit, class)[1:3]
Излаз:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Свака вредност се може издвојити знаком $ иза којег следи назив метрике. На пример, сачували сте модел као логит. Да бисте издвојили АИЦ критеријуме, користите:
logit$aic
Излаз:
## [1] 27086.65
Корак 7) Процените перформансе модела
Матрица забуне
Матрица конфузија је бољи избор за процену учинка класификације у поређењу са различитим показатељима сте видели раније. Општа идеја је да се изброји колико пута су истините инстанце класификоване као Нетачне.

Да бисте израчунали матрицу забуне, прво треба да имате сет предвиђања како би се могла упоредити са стварним циљевима.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Објашњење кода

предвиђање (логит, дата_тест, типе = 'респонсе'): Израчунајте предвиђање на скупу тестова. Подесите типе = 'респонсе' да бисте израчунали вероватноћу одговора.
табела (дата_тест $ приход, предвиђа> 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
Објашњење кода

сума (диаг (табле_мат)): Збир дијагонале
сума (табле_мат): Збир матрице.

Излаз:
## [1] 0.8277339 
Изгледа да модел пати од једног проблема, он прецењује број лажних негатива. То се назива парадоксом теста тачности . Изјавили смо да је тачност однос тачних предвиђања и укупног броја случајева. Можемо имати релативно високу тачност, али бескористан модел. То се дешава када постоји доминантна класа. Ако се осврнете на матрицу забуне, можете видети да је већина случајева класификована као истински негативна. Замислите сада, модел је класификовао све класе као негативне (тј. Ниже од 50к). Имали бисте тачност од 75 процената (6718/6718 + 2257). Ваш модел има боље резултате, али се бори да разликује истинско позитивно од истинског негативног.
У таквој ситуацији пожељно је имати сажетију метрику. Можемо погледати:

Прецизност = ТП / (ТП + ФП)
Поврат = ТП / (ТП + ФН)

Прецизност против опозива
Прецизност гледа на тачност позитивног предвиђања. Опозив је однос позитивних случајева које је класификатор тачно открио;
Можете израчунати две функције за израчунавање ове две метрике

Прецизност конструкције

precision <- function(matrix) {# True positivetp <- matrix[2, 2]# false positivefp <- matrix[1, 2]return (tp / (tp + fp))}
Објашњење кода

мат [1,1]: Врати прву ћелију прве колоне оквира података, тј. истински позитив
подлога [1,2]; Врати прву ћелију друге колоне оквира података, односно лажно позитивно

recall <- function(matrix) {# true positivetp <- matrix[2, 2]# false positivefn <- matrix[2, 1]return (tp / (tp + fn))}
Објашњење кода

мат [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 
Прецизност и поврат опозива
Немогуће је имати високу прецизност и висок опозив.
Ако повећамо прецизност, тачнији појединац ће бити боље предвиђен, али бисмо пропустили пуно њих (нижи опозив). У некој ситуацији преферирамо већу прецизност него опозив. Између прецизности и опозива постоји конкавни однос.

Замислите, треба да предвидите да ли пацијент има болест. Желите да будете што прецизнији.
Ако требате да препознате потенцијалне преваранте на улици препознавањем лица, било би боље ухватити многе људе који су означени као преваранти иако је прецизност ниска. Полиција ће моћи да пусти особу која није превара.

РОЦ крива
Пријемник Оперативни Карактеристика крива је још један заједнички алат који се користи у бинарном класификацији. Веома је слична кривој прецизности / опозива, али уместо да црта прецизност у односу на опозив, РОЦ крива показује истинску позитивну стопу (тј. Опозив) у односу на лажно позитивну стопу. Стопа лажно позитивних је однос негативних случајева који су погрешно класификовани као позитивни. Једнако је јединици минус минус стварна негативна стопа. Права негативна стопа се такође назива специфичност . Отуда РОЦ крива црта осетљивост (опозив) насупрот 1-специфичности
Да бисмо нацртали РОЦ криву, морамо да инсталирамо библиотеку под називом РОРЦ. Можемо пронаћи у библиотеци цонда. Можете да укуцате код:
цонда инсталл -цр р-роцр --да
РОЦ можемо да зацртамо помоћу функција предвиђања () и учинка ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Објашњење кода

предвиђање (предвиђање, дата_тест $ приход): РОЦР библиотека треба да креира објекат предвиђања да трансформише улазне податке
перформансе (РОЦРпред, 'тпр', 'фпр'): Врати две комбинације које ће се добити на графикону. Овде су конструисани тпр и фпр. За прецизност цртања и опозива заједно, користите „прец“, „рец“.

Излаз:

Корак 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 
Резултат је нешто већи од претходног. Можете наставити да радите на подацима и покушати да надмашите резултат.

Резиме
Можемо резимирати функцију за обуку логистичке регресије у доњој табели:
 

 
 

Пакет
 

објективан
 

функцију
 

расправа
 

 

 

 
 

-
 

Направите скуп података за воз / тест
 

цреате_траин_сет ()
 

подаци, величина, воз
 

 
 

глм
 

Обучити генерализовани линеарни модел
 

глм ()
 

формула, подаци, породица *
 

 
 

глм
 

Резимирајте модел
 

резиме ()
 

уграђени модел
 

 
 

база
 

Направите предвиђање
 

предвидети ()
 

уграђени модел, скуп података, типе = 'респонсе'
 

 
 

база
 

Направите матрицу забуне
 

сто()
 

и, предвидети ()
 

 
 

база
 

Направите резултат тачности
 

сум (диаг (табле ()) / сум (табле ()
 

 
 

РОЦР
 

Направите РОЦ: Корак 1 Креирајте предвиђање
 

предвиђање ()
 

предвидети (), г.
 

 
 

РОЦР
 

Направите РОЦ: Корак 2 Створите перформансе
 

перформансе()
 

предвиђање (), 'тпр', 'фпр'
 

 
 

РОЦР
 

Направите РОЦ: Корак 3 Графикон графикона
 

плот ()
 

перформансе()
 

 

 

Други ГЛМ модели су:
- бином: (линк = "логит")
- гауссиан: (линк = "идентитет")
- Гама: (веза = "инверзна")
- инверсе.гауссиан: (линк = "1 / му 2")
- поиссон: (линк = "лог")
- квази: (веза = "идентитет", варијанса = "константа")
- квазибиномиални: (линк = "логит")
- квазипоиссон: (линк = "лог")