GLM v R: Zovšeobecnený lineárny model s príkladom

Čo je to logistická regresia?

Logistická regresia sa používa na predpovedanie triedy, tj. Pravdepodobnosti. Logistická regresia dokáže presne predpovedať binárny výsledok.

Predstavte si, že chcete predpovedať, či je pôžička zamietnutá / prijatá na základe mnohých atribútov. Logistická regresia má tvar 0/1. y = 0, ak je pôžička zamietnutá, y = 1, ak je pôžička prijatá.

Logistický regresný model sa líši od lineárneho regresného modelu dvoma spôsobmi.

• Najskôr logistická regresia akceptuje iba dichotomický (binárny) vstup ako závislú premennú (tj. Vektor 0 a 1).
• Po druhé, výsledok sa meria pomocou nasledujúcej pravdepodobnostnej spojovacej funkcie nazývanej sigmoid kvôli jej tvaru S .:

Výstup funkcie je vždy medzi 0 a 1. Skontrolujte obrázok nižšie

Funkcia sigmoid vracia hodnoty od 0 do 1. Pre úlohu klasifikácie potrebujeme diskrétny výstup 0 alebo 1.

Aby sme mohli prevádzať spojitý tok na diskrétnu hodnotu, môžeme nastaviť rozhodnutie viazané na 0,5. Všetky hodnoty nad touto prahovou hodnotou sú klasifikované ako 1

V tomto návode sa naučíte

• Čo je to logistická regresia?
• Ako vytvoriť model generalizovanej linky (GLM)
• Krok 1) Skontrolujte spojité premenné
• Krok 2) Skontrolujte premenné faktora
• Krok 3) Funkčné inžinierstvo
• Krok 4) Súhrnná štatistika
• Krok 5) Vlak / testovacia súprava
• Krok 6) Vytvorte model
• Krok 7) Posúďte výkonnosť modelu

Ako vytvoriť model generalizovanej linky (GLM)

Na ilustráciu logistickej regresie použijeme množinu údajov pre dospelých . „Dospelý“ je vynikajúci súbor údajov pre úlohu klasifikácie. Cieľom je predpovedať, či ročný príjem jednotlivca v dolároch prekročí 50 000. Dataset obsahuje 46 033 pozorovaní a desať funkcií:

• vek: vek jednotlivca. Číselné
• vzdelanie: Úroveň vzdelania jednotlivca. Faktor.
• marital.status: Rodinný stav jednotlivca. Faktor, tj. Nikdy ženatý / vydatá, vydatá-manžel / manželka,…
• pohlavie: Pohlavie jednotlivca. Faktor, tj. Muž alebo žena
• príjem: cieľová premenná. Príjem nad alebo pod 50 tis. Faktor tj> 50 kB, <= 50 kB

medzi ostatnými

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

Výkon:

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… 

Budeme postupovať nasledovne:

• Krok 1: Skontrolujte spojité premenné
• Krok 2: Skontrolujte premenné faktora
• Krok 3: Inžinierstvo funkcií
• Krok 4: Súhrnná štatistika
• Krok 5: Vlak / testovacia súprava
• Krok 6: Zostavte model
• Krok 7: Posúďte výkonnosť modelu
• krok 8: Vylepšenie modelu

Vašou úlohou je predpovedať, ktorý jednotlivec bude mať príjem vyšší ako 50 000.

V tomto výučbe bude každý krok podrobne opísaný, aby sa mohla vykonať analýza na skutočnom súbore údajov.

Krok 1) Skontrolujte spojité premenné

V prvom kroku môžete vidieť rozdelenie spojitých premenných.

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

Vysvetlenie kódu

• spojitý <- select_if (data_adult, is.numeric): Pomocou funkcie select_if () z knižnice dplyr vyberte iba číselné stĺpce
• Summary (Continuous): Vytlačí súhrnnú štatistiku

Výkon:

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

Z vyššie uvedenej tabuľky môžete vidieť, že údaje majú úplne odlišné stupnice a hodiny. Per.weeks má veľké odľahlé hodnoty (.ie pozrite sa na posledný kvartil a maximálnu hodnotu).

Môžete to vyriešiť dvoma krokmi:

• 1: Vykreslite rozdelenie hodín.na.týždeň
• 2: Štandardizácia spojitých premenných

1. Vykreslite rozdelenie

Pozrime sa bližšie na rozdelenie hodín.za.týždeň

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

Výkon:

Premenná má veľa odľahlých hodnôt a nedefinovanú distribúciu. Tento problém môžete čiastočne vyriešiť odstránením horných 0,01 percenta hodín týždenne.

Základná syntax kvantilu:

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.

Vypočítame horný 2 percentil

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

Vysvetlenie kódu

• kvantil (data_adult $ hours.per.week, 0,99): Vypočítajte hodnotu 99 percent pracovného času

Výkon:

## 99%## 80 

98 percent populácie pracuje do 80 hodín týždenne.

Pozorovania môžete pustiť nad túto hranicu. Použijete filter z knižnice dplyr.

data_adult_drop <-data_adult %>%filter(hours.per.week
Výkon:


## [1] 45537 10 
 

Štandardizujte spojité premenné

Každý stĺpec môžete štandardizovať, aby ste zlepšili výkon, pretože vaše údaje nemajú rovnakú mierku. Môžete použiť funkciu mutate_if z knižnice dplyr. Základná syntax je:
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
Číselné stĺpce môžete štandardizovať takto:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Vysvetlenie kódu

mutate_if (is.numeric, funs (scale)): Podmienkou je iba číselný stĺpec a funkciou je scale

Výkon:
## 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
Krok 2) Skontrolujte premenné faktora
Tento krok má dva ciele:

Skontrolujte hladinu v každom kategorickom stĺpci
Definujte nové úrovne

Tento krok rozdelíme na tri časti:

Vyberte kategorické stĺpce
Uložte stĺpcový graf každého stĺpca do zoznamu
Vytlačte grafy

Stĺpce faktora môžeme vybrať pomocou kódu uvedeného nižšie:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Vysvetlenie kódu

data.frame (select_if (data_adult, is.factor)): Stĺpce faktora ukladáme do faktora v type dátového rámca. Knižnica ggplot2 vyžaduje objekt dátového rámca.

Výkon:
## [1] 6 
Dataset obsahuje 6 kategorických premenných
Druhý krok je zručnejší. Chcete vykresliť stĺpcový graf pre každý stĺpec vo faktore údajového rámca. Je pohodlnejšie proces automatizovať, najmä v situáciách, keď existuje veľa stĺpcov.
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)))
Vysvetlenie kódu

lapply (): Pomocou funkcie lapply () odovzdáme funkciu vo všetkých stĺpcoch množiny údajov. Výstup uložíte do zoznamu
function (x): Funkcia sa spracuje pre každé x. Tu x sú stĺpce
ggplot (factor, aes (get (x))) + geom_bar () + téma (axis.text.x = element_text (angle = 90)): Vytvorte stĺpcový char chart pre každý x prvok. Ak chcete vrátiť x ako stĺpec, musíte ho zahrnúť do get ()

Posledný krok je pomerne ľahký. Chcete vytlačiť 6 grafov.
# Print the graphgraph
Výkon:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Poznámka: Pomocou nasledujúceho tlačidla prejdite na nasledujúci graf

Krok 3) Funkčné inžinierstvo
Prepracované vzdelávanie
Z vyššie uvedeného grafu vidno, že premenná vzdelanie má 16 úrovní. To je podstatné a na niektorých úrovniach je zaznamenaný relatívne nízky počet pozorovaní. Ak chcete zlepšiť množstvo informácií, ktoré môžete získať z tejto premennej, môžete ju prepracovať na vyššiu úroveň. Menovite vytvárate väčšie skupiny s podobnou úrovňou vzdelania. Napríklad nízka úroveň vzdelania sa premení na predčasne ukončené štúdium. Vyššie stupne vzdelávania sa zmenia na magisterské.
Tu je detail:
 

 
 

Stará úroveň
 

Nová úroveň
 

 

 

 
 

Predškolské zariadenie
 

vypadnúť
 

 
 

10
 

Vypadnúť
 

 
 

11
 

Vypadnúť
 

 
 

12
 

Vypadnúť
 

 
 

1.-4
 

Vypadnúť
 

 
 

5.-6
 

Vypadnúť
 

 
 

7.-8
 

Vypadnúť
 

 
 

9
 

Vypadnúť
 

 
 

HS-Grad
 

HighGrad
 

 
 

Nejaká vysoká škola
 

Spoločenstva
 

 
 

Doc
 

Spoločenstva
 

 
 

Doc
 

Spoločenstva
 

 
 

Bakalári
 

Bakalári
 

 
 

Majstri
 

Majstri
 

 
 

Prof
 

Majstri
 

 
 

Doktorát
 

PhD
 

 

 

 
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")))))))
Vysvetlenie kódu

Používame sloveso mutovať z knižnice dplyr. Hodnoty vzdelávania meníme výrokom ifelse

V tabuľke nižšie vytvoríte súhrnnú štatistiku, ktorá v priemere informuje o tom, koľko rokov vzdelávania (z-hodnota) je potrebných na získanie bakalárskeho, magisterského alebo doktorandského titulu.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Výkon:
## # 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
Prepracovať rodinný stav
Je tiež možné vytvoriť nižšie úrovne pre rodinný stav. V nasledujúcom kóde zmeníte úroveň nasledovne:
 

 
 

Stará úroveň
 

Nová úroveň
 

 

 

 
 

Nikdy nebol ženatý
 

Nie je vydatá
 

 
 

Ženatý-manžel-neprítomný
 

Nie je vydatá
 

 
 

Ženatý-AF-manžel
 

Vydatá
 

 
 

Ženatý - občiansky manžel
 
 

 
 

Oddelené
 

Oddelené
 

 
 

Rozvedeny
 
 

 
 

Vdovy
 

Vdova
 

 

 

 
# 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")))))
 Môžete skontrolovať počet jednotlivcov v každej skupine. 
table(recast_data$marital.status)
Výkon:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Krok 4) Súhrnná štatistika
Je čas skontrolovať niektoré štatistické údaje o našich cieľových premenných. V nižšie uvedenom grafe spočítate percento jednotlivcov, ktorí zarobia viac ako 50 000 osôb, podľa pohlavia.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Výkon:

Ďalej skontrolujte, či pôvod jednotlivca ovplyvňuje ich zárobky.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Výkon:

Počet hodín práce podľa pohlavia.
# 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()
Výkon:

Krabicový graf potvrdzuje, že rozloženie pracovného času vyhovuje rôznym skupinám. Na grafe poľa nemajú obe pohlavia homogénne pozorovania.
Môžete skontrolovať hustotu týždenného pracovného času podľa typu vzdelania. Distribúcie majú veľa odlišných možností. Pravdepodobne sa to dá vysvetliť typom zmluvy v USA.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Vysvetlenie kódu

ggplot (recast_data, aes (x = hours.per.week)): Graf hustoty vyžaduje iba jednu premennú
geom_density (aes (color = education), alpha = 0,5): Geometrický objekt na riadenie hustoty

Výkon:

Na potvrdenie svojich myšlienok môžete vykonať jednosmerný test ANOVA:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Výkon:
## 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
Test ANOVA potvrdzuje rozdiel v priemere medzi skupinami.
Nelineárnosť
Pred spustením modelu môžete zistiť, či počet odpracovaných hodín súvisí s vekom.
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()
Vysvetlenie kódu

ggplot (recast_data, aes (x = vek, y = hours.per.week)): Nastaví estetiku grafu
geom_point (aes (color = income), size = 0,5): Zostrojte bodkový graf
stat_smooth (): Pridajte trendovú čiaru s nasledujúcimi argumentmi:

method = 'lm': Vynesie sa prispôsobená hodnota, ak ide o lineárnu regresiu
vzorec = y ~ poly (x, 2): Prispôsobí polynomiálnu regresiu
se = TRUE: Pridajte štandardnú chybu
aes (farba = príjem): Zlomte model podľa príjmu



Výkon:

Stručne povedané, môžete vyskúšať podmienky interakcie v modeli a zistiť tak efekt nelinearity medzi týždenným pracovným časom a ďalšími funkciami. Je dôležité zistiť, za akých podmienok sa líši pracovný čas.
Korelácia
Ďalšou kontrolou je vizualizácia korelácie medzi premennými. Typ úrovne faktora prevediete na numerický, aby ste mohli vykresliť teplotnú mapu obsahujúcu korelačný koeficient vypočítaný Spearmanovou metódou.
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")
Vysvetlenie kódu

data.frame (lapply (recast_data, as.integer)): Konvertuje údaje na číselné
ggcorr () vykreslí tepelnú mapu s nasledujúcimi argumentmi:

metóda: Metóda na výpočet korelácie
nbreaks = 6: Počet prestávok
hjust = 0,8: Kontrolná pozícia názvu premennej v grafe
label = TRUE: Pridajte štítky do stredu okien
label_size = 3: Menovky veľkosti
color = "grey50"): Farba štítku



Výkon:

Krok 5) Vlak / testovacia súprava
Akákoľvek úloha strojového učenia pod dohľadom vyžaduje rozdelenie údajov medzi vlakovú súpravu a skúšobnú súpravu. Môžete použiť "funkciu", ktorú ste vytvorili v iných supervidovaných učebných príručkách, na vytvorenie vlakovej / testovacej sady.
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)
Výkon:
## [1] 36429 9
 
dim(data_test)
Výkon:
## [1] 9108 9 
Krok 6) Vytvorte model
Ak chcete zistiť, ako si algoritmus funguje, použite balíček glm (). Generalized Linear Model je zbierka modelov. Základná syntax je:
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")
Ste pripravení odhadnúť logistický model na rozdelenie úrovne príjmu medzi súbor funkcií.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Vysvetlenie kódu

vzorec <- príjem ~.: Vytvorte model tak, aby vyhovoval
logit <- glm (formula, data = data_train, family = 'binomial'): Prispôsobte logistický model (family = 'binomial') údajmi data_train.
summary (logit): Vytlačí sa súhrn modelu

Výkon:
#### 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
Zhrnutie nášho modelu prezrádza zaujímavé informácie. Výkon logistickej regresie sa hodnotí pomocou konkrétnych kľúčových metrík.

AIC (Akaike Information Criteria): Toto je ekvivalent R2 v logistickej regresii. Meria prispôsobenie, keď sa na počet parametrov uplatní pokuta. Menšie hodnoty AIC naznačujú, že model je bližšie k pravde.
Nulová odchýlka: Hodí sa k modelu iba s úsekom. Stupeň slobody je n-1. Môžeme ju interpretovať ako hodnotu chí-kvadrát (prispôsobená hodnota odlišná od testovania hypotézy skutočnej hodnoty).
Zvyšková odchýlka: Model so všetkými premennými. Interpretuje sa tiež ako testovanie hypotézy chí-kvadrát.
Počet iterácií Fisherovho skórovania: Počet iterácií pred konvergenciou.

Výstup funkcie glm () je uložený v zozname. Nasledujúci kód zobrazuje všetky položky dostupné v premennej logit, ktorú sme vytvorili na vyhodnotenie logistickej regresie.
# Zoznam je veľmi dlhý, tlačte iba prvé tri prvky
lapply(logit, class)[1:3]
Výkon:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Každú hodnotu je možné extrahovať znakom $, za ktorým nasleduje názov metriky. Napríklad ste uložili model ako logit. Na získanie kritérií AIC použijete:
logit$aic
Výkon:
## [1] 27086.65
Krok 7) Posúďte výkonnosť modelu
Matica zmätku
Zmätok matrix je lepšou voľbou pre hodnotenie výkonu klasifikácie v porovnaní s rôznymi metrikami si videl predtým. Všeobecnou myšlienkou je spočítať, koľkokrát sú prípady True klasifikované ako nepravdivé.

Ak chcete vypočítať maticu zmätku, najskôr musíte mať súbor predpovedí, aby ich bolo možné porovnať so skutočnými cieľmi.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Vysvetlenie kódu

predpovedať (logit, data_test, type = 'response'): Vypočítať predpoveď na testovacej sade. Nastavením type = 'response' vypočítajte pravdepodobnosť odpovede.
tabuľka (data_test $ príjem, predpovedať> 0,5): Vypočítajte maticu zámeny. predpovedať> 0,5 znamená, že vráti 1, ak sú predpovedané pravdepodobnosti nad 0,5, inak 0.

Výkon:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Každý riadok v konfúznej matici predstavuje skutočný cieľ, zatiaľ čo každý stĺpec predstavuje predpovedaný cieľ. Prvý riadok tejto matice považuje príjem nižší ako 50k (trieda False): 6241 bolo správne klasifikovaných ako jednotlivcov s príjmom nižším ako 50k ( skutočná záporná hodnota ), zatiaľ čo ten zvyšný bol nesprávne klasifikovaný ako príjem vyšší ako 50k ( nesprávna kladná hodnota ). Druhý riadok považuje príjem nad 50 000, pozitívna trieda bola 1229 ( skutočne pozitívna ), zatiaľ čo skutočná záporná hodnota bola 1074.
Presnosť modelu môžete vypočítať súčtom skutočného kladného a záporného výsledku za celé pozorovanie

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Vysvetlenie kódu

sum (diag (table_mat)): Súčet uhlopriečky
sum (table_mat): Súčet matice.

Výkon:
## [1] 0.8277339 
Zdá sa, že model trpí jedným problémom, nadhodnocuje počet falošných negatívov. Tomu sa hovorí paradox skúšky presnosti . Uviedli sme, že presnosť je pomer správnych predpovedí k celkovému počtu prípadov. Môžeme mať relatívne vysokú presnosť, ale zbytočný model. Stáva sa to, keď existuje dominantná trieda. Ak sa pozriete späť na maticu zmätku, uvidíte, že väčšina prípadov je klasifikovaná ako skutočne negatívna. Teraz si predstavte, že model klasifikoval všetky triedy ako negatívne (tj. Menej ako 50 tis.). Mali by ste presnosť 75 percent (6718/6718 + 2257). Váš model podáva lepšie výsledky, ale snaží sa odlíšiť skutočné pozitívne od skutočných negatívnych.
V takejto situácii je lepšie mať stručnejšiu metriku. Môžeme sa pozrieť na:

Presnosť = TP / (TP + FP)
Odvolanie = TP / (TP + FN)

Presnosť vs Pripomeňme
Presnosť sleduje presnosť pozitívnej predpovede. Pripomenutie je pomer pozitívnych prípadov, ktoré klasifikátor správne zistil;
Na výpočet týchto dvoch metrík môžete vytvoriť dve funkcie

Zostrojte presnosť

precision <- function(matrix) {# True positivetp <- matrix[2, 2]# false positivefp <- matrix[1, 2]return (tp / (tp + fp))}
Vysvetlenie kódu

mat [1,1]: Vráti prvú bunku prvého stĺpca dátového rámca, tj skutočnú kladnú hodnotu
rohož [1,2]; Vráti prvú bunku druhého stĺpca dátového rámca, tj falošne pozitívnu

recall <- function(matrix) {# true positivetp <- matrix[2, 2]# false positivefn <- matrix[2, 1]return (tp / (tp + fn))}
Vysvetlenie kódu

mat [1,1]: Vráti prvú bunku prvého stĺpca dátového rámca, tj skutočnú kladnú hodnotu
rohož [2,1]; Vráťte druhú bunku prvého stĺpca dátového rámca, tj falošne negatívny výsledok

Môžete vyskúšať svoje funkcie
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Výkon:
## [1] 0.712877## [2] 0.5336518
Keď model hovorí, že ide o jednotlivca nad 50 000, je to správne iba v 54 percentách prípadov a v 72 percentách prípadov si môže nárokovať osoby nad 50 000.
harmonický priemer týchto dvoch metrík, čo znamená, že kladie väčší dôraz na nižšie hodnoty.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Výkon:
## [1] 0.6103799 
Precíznosť vs Odvolanie
Je nemožné mať vysokú presnosť aj vysokú vybavenosť.
Ak zvýšime presnosť, lepšie sa predpovedá správny jedinec, ale veľa z nich by nám chýbalo (nižšie pripomenutie). V niektorých situáciách uprednostňujeme vyššiu presnosť ako vyvolanie. Medzi presnosťou a stiahnutím z obehu existuje konkávny vzťah.

Predstavte si, že musíte predvídať, či má pacient chorobu. Chcete byť čo najpresnejší.
Ak potrebujete odhaliť potenciálnych podvodníkov na ulici pomocou rozpoznávania tváre, bolo by lepšie chytiť veľa ľudí označených ako podvodníkov, aj keď je ich presnosť nízka. Polícia bude môcť nepodvodného jedinca prepustiť na slobodu.

ROC krivka
Charakteristika Prijímač Prevádzkové krivka je ďalší častý nástroj používaný s binárnym klasifikáciu. Je to veľmi podobné krivke presnosti / vyvolania, ale namiesto vykreslenia presnosti proti vyvolaniu zobrazuje krivka ROC skutočnú pozitívnu mieru (tj. Vyvolanie) oproti miere falošne pozitívnej. Miera falošne pozitívnych výsledkov je pomer negatívnych prípadov, ktoré sú nesprávne klasifikované ako pozitívne. Rovná sa jednej mínus skutočná záporná sadzba. Skutočná záporná sadzba sa nazýva aj špecifickosť . Preto krivka ROC vykresľuje citlivosť (vyvolanie) proti 1 špecifickosti
Na vykreslenie krivky ROC musíme nainštalovať knižnicu s názvom RORC. Nájdeme v knižnici conda. Môžete zadať kód:
conda install -cr r-rocr - áno
ROC môžeme vykresliť pomocou funkcií predikcie () a výkonu ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Vysvetlenie kódu

predikcia (predpovedať, data_test $ príjem): Knižnica ROCR musí vytvoriť objekt predikcie na transformáciu vstupných údajov
performance (ROCRpred, 'tpr', 'fpr'): Vráti dve kombinácie, ktoré sa majú vytvoriť v grafe. Tu sú konštruované tpr a fpr. Celkovú presnosť vykreslenia a vyvolanie, použite „prec“, „rec“.

Výkon:

Krok 8) Vylepšite model
Môžete sa pokúsiť pridať do modelu nelinearitu pomocou interakcie medzi

vek a hodiny.za.týždeň
pohlavie a hodiny.za.týždeň.

Na porovnanie oboch modelov musíte použiť test skóre
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
Výkon:
## [1] 0.6109181 
Skóre je o niečo vyššie ako predchádzajúce. Na dátach môžete ďalej pracovať a pokúsiť sa prekonať skóre.

Zhrnutie
V nasledujúcej tabuľke môžeme zhrnúť funkciu na trénovanie logistickej regresie:
 

 
 

Balenie
 

Cieľ
 

funkcia
 

argument
 

 

 

 
 

-
 

Vytvorte súbor údajov o vlaku / teste
 

create_train_set ()
 

údaje, veľkosť, vlak
 

 
 

glm
 

Trénujte zovšeobecnený lineárny model
 

glm ()
 

vzorec, údaje, rodina *
 

 
 

glm
 

Zhrňte model
 

súhrn ()
 

vybavený model
 

 
 

základňa
 

Urobte predpoveď
 

predpovedať ()
 

vybavený model, množina údajov, typ = „odpoveď“
 

 
 

základňa
 

Vytvorte maticu zmätku
 

tabuľka ()
 

y, predpovedať ()
 

 
 

základňa
 

Vytvorte skóre presnosti
 

súčet (diag (tabuľka ()) / súčet (tabuľka ()
 

 
 

ROCR
 

Vytvorenie ROC: Krok 1 Vytvorenie predikcie
 

predpoveď ()
 

predpovedať (), r
 

 
 

ROCR
 

Vytvorte ROC: Krok 2 Vytvorte výkon
 

výkon ()
 

prediction (), 'tpr', 'fpr'
 

 
 

ROCR
 

Vytvorte ROC: Krok 3 Vytvorte graf
 

zápletka ()
 

výkon ()
 

 

 

Ďalšími typmi modelov GLM sú:
- dvojčlen: (link = "logit")
- gaussian: (link = "identita")
- Gama: (link = "inverzný")
- inverse.gaussian: (link = "1 / mu 2")
- poisson: (link = "log")
- kvázi: (link = "identita", odchýlka = "konštanta")
- quasibinomial: (link = "logit")
- quasipoisson: (link = "log")