GLM u R: Generalizirani linearni model s primjerom

Što je logistička regresija?

Logistička regresija koristi se za predviđanje klase, tj. Vjerojatnosti. Logistička regresija može točno predvidjeti binarni ishod.

Zamislite da želite predvidjeti hoće li se zajam odbiti / prihvatiti na temelju mnogih atributa. Logistička regresija je oblika 0/1. y = 0 ako je zajam odbijen, y = 1 ako je prihvaćen.

Logistički regresijski model razlikuje se od linearne regresijskog modela na dva načina.

• Prije svega, logistička regresija prihvaća samo dihotomni (binarni) ulaz kao ovisnu varijablu (tj. Vektor 0 i 1).
• Drugo, ishod se mjeri pomoću sljedeće vjerojatnosne funkcije veze koja se naziva sigmoidna zbog svog oblika S:

Izlaz funkcije je uvijek između 0 i 1. Provjerite sliku dolje

Sigmoidna funkcija vraća vrijednosti od 0 do 1. Za zadatak klasifikacije trebamo diskretni izlaz 0 ili 1.

Da bismo pretvorili kontinuirani protok u diskretnu vrijednost, možemo postaviti odluku vezanu na 0,5. Sve vrijednosti iznad ovog praga klasificirane su kao 1

U ovom ćete tutorijalu naučiti

• Što je logistička regresija?
• Kako stvoriti generalizirani linijski model (GLM)
• Korak 1) Provjerite kontinuirane varijable
• Korak 2) Provjerite varijable faktora
• Korak 3) Inženjering značajki
• Korak 4) Sažeti statistički podaci
• Korak 5) Vlak / testni set
• Korak 6) Izgradite model
• Korak 7) Procijenite izvedbu modela

Kako stvoriti generalizirani linijski model (GLM)

Upotrijebimo skup podataka za odrasle da ilustriramo logističku regresiju. "Odrasla osoba" izvrstan je skup podataka za klasifikacijski zadatak. Cilj je predvidjeti hoće li godišnji prihod pojedinca u dolarima premašiti 50.000. Skup podataka sadrži 46.033 promatranja i deset značajki:

• dob: dob pojedinca. Numerički
• obrazovanje: Obrazovna razina pojedinca. Faktor.
• bračni.status: Bračno stanje pojedinca. Čimbenik, tj. Nikad vjenčani, vjenčani-bračni drug,…
• spol: Spol pojedinca. Čimbenik, odnosno muški ili ženski
• prihod: Ciljana varijabla. Prihod veći od ili ispod 50K. Faktor tj.> 50K, <= 50K

između ostalog

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

Izlaz:

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… 

Nastavit ćemo kako slijedi:

• Korak 1: Provjerite kontinuirane varijable
• Korak 2: Provjerite varijable faktora
• Korak 3: Inženjering značajki
• Korak 4: Sažeti statistički podaci
• Korak 5: Vlak / testni set
• Korak 6: Izgradite model
• Korak 7: Procijenite izvedbu modela
• korak 8: Poboljšajte model

Vaš je zadatak predvidjeti koja će osoba imati prihod veći od 50.000.

U ovom vodiču svaki će korak biti detaljan kako bi se izvršila analiza na stvarnom skupu podataka.

Korak 1) Provjerite kontinuirane varijable

U prvom koraku možete vidjeti raspodjelu kontinuiranih varijabli.

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

Objašnjenje koda

• kontinuirano <- select_if (data_adult, is.numeric): Upotrijebite funkciju select_if () iz biblioteke dplyr za odabir samo numeričkih stupaca
• sažetak (kontinuirano): ispis sažetke statistike

Izlaz:

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

Iz gornje tablice možete vidjeti da podaci imaju potpuno različite razmjere i sate. Per.weeks ima velike odstupanja (.pogledamo posljednji kvartil i maksimalnu vrijednost).

S tim se možete nositi u dva koraka:

• 1: Nacrtajte raspodjelu sati po tjednu
• 2: Standardizirajte kontinuirane varijable

1. Zacrtajte distribuciju

Pogledajmo bliže raspodjelu sati.na tjedan

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

Izlaz:

Varijabla ima puno odstupanja i nije dobro definirana distribucija. S tim se problemom možete djelomično riješiti brisanjem najviših 0,01 posto sati u tjednu.

Osnovna sintaksa kvantila:

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.

Izračunavamo 2 postotna percentila

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

Objašnjenje koda

• kvantil (data_adult $ hours.per.week, .99): Izračunajte vrijednost 99 posto radnog vremena

Izlaz:

## 99%## 80 

98 posto stanovništva radi ispod 80 sati tjedno.

Možete ispustiti opažanja iznad ovog praga. Koristite filtar iz biblioteke dplyr.

data_adult_drop <-data_adult %>%filter(hours.per.week
Izlaz:


## [1] 45537 10 
 

Standardizirajte kontinuirane varijable

Možete standardizirati svaki stupac kako biste poboljšali izvedbu jer vaši podaci nemaju istu ljestvicu. Možete koristiti funkciju mutate_if iz biblioteke dplyr. Osnovna sintaksa 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
Numeričke stupce možete standardizirati na sljedeći način:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Objašnjenje koda

mutate_if (is.numeric, funs (scale)): Uvjet je samo numerički stupac, a funkcija razmjera

Izlaz:
## 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
Korak 2) Provjerite varijable faktora
Ovaj korak ima dva cilja:

Provjerite razinu u svakom kategoričkom stupcu
Definirajte nove razine

Podijelit ćemo ovaj korak u tri dijela:

Odaberite kategorijske stupce
Spremite trakasti grafikon svakog stupca na popis
Ispišite grafikone

S stupcem ispod možemo odabrati stupce faktora:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Objašnjenje koda

data.frame (select_if (data_adult, is.factor)): Stupce faktora pohranjujemo u faktor u vrstu okvira podataka. Biblioteka ggplot2 zahtijeva objekt okvira podataka.

Izlaz:
## [1] 6 
Skup podataka sadrži 6 kategorijskih varijabli
Drugi korak je vještiji. Želite ucrtati trakasti grafikon za svaki stupac u faktoru okvira podataka. Prikladnije je automatizirati postupak, posebno u situaciji u kojoj ima puno stupaca.
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)))
Objašnjenje koda

lapply (): Upotrijebite funkciju lapply () za prosljeđivanje funkcije u svim stupcima skupa podataka. Izlaz spremate na popis
funkcija (x): funkcija će se obraditi za svaki x. Ovdje je x stupac
ggplot (faktor, aes (get (x))) + geom_bar () + tema (axis.text.x = element_text (angle = 90)): Stvorite trakasti grafikon za svaki x element. Napomena, da biste x vratili kao stupac, trebate ga uključiti u get ()

Posljednji je korak relativno lagan. Želite ispisati 6 grafika.
# Print the graphgraph
Izlaz:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Napomena: Upotrijebite sljedeći gumb za navigaciju do sljedećeg grafikona

Korak 3) Inženjering značajki
Preuređeno obrazovanje
Iz gornjeg grafikona možete vidjeti da varijabla obrazovanja ima 16 razina. To je značajno, a neke razine imaju relativno nizak broj opažanja. Ako želite poboljšati količinu podataka koje možete dobiti od ove varijable, možete ih preoblikovati u višu razinu. Naime, stvarate veće grupe sa sličnim stupnjem obrazovanja. Primjerice, nizak stupanj obrazovanja pretvorit će se u napuštanje škole. Viši nivoi obrazovanja bit će promijenjeni u master.
Evo detalja:
 

 
 

Stara razina
 

Nova razina
 

 

 

 
 

Predškolski
 

napustiti
 

 
 

10.
 

Napustiti
 

 
 

11.
 

Napustiti
 

 
 

12.
 

Napustiti
 

 
 

1.-4
 

Napustiti
 

 
 

5.-6
 

Napustiti
 

 
 

7.-8
 

Napustiti
 

 
 

9
 

Napustiti
 

 
 

HS-Grad
 

HighGrad
 

 
 

Neki fakulteti
 

Zajednica
 

 
 

Izv.-acdm
 

Zajednica
 

 
 

Izv. Vok
 

Zajednica
 

 
 

Prvostupnici
 

Prvostupnici
 

 
 

Majstori
 

Majstori
 

 
 

Prof-škola
 

Majstori
 

 
 

Doktorat
 

Dr. Sc
 

 

 

 
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")))))))
Objašnjenje koda

Koristimo glagol mutate iz biblioteke dplyr. Vrijednosti obrazovanja mijenjamo izjavom ifelse

U donjoj tablici izrađujete sažetu statistiku kako biste u prosjeku vidjeli koliko godina obrazovanja (z-vrijednost) treba da biste postigli stupanj prvostupnika, magistra ili doktora znanosti.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Izlaz:
## # 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
Preinaka Bračni status
Također je moguće stvoriti niže razine za bračni status. U sljedećem kodu mijenjate razinu kako slijedi:
 

 
 

Stara razina
 

Nova razina
 

 

 

 
 

Nikad oženjen
 

Neoženjen
 

 
 

Oženjen-supružnik-odsutan
 

Neoženjen
 

 
 

Oženjen-AF-supružnik
 

Oženjen
 

 
 

Oženjen-civil-supružnik
 
 

 
 

Odvojeno
 

Odvojeno
 

 
 

Rastavljen
 
 

 
 

Udovice
 

Udovica
 

 

 

 
# 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")))))
 Možete provjeriti broj pojedinaca unutar svake grupe. 
table(recast_data$marital.status)
Izlaz:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Korak 4) Sažeti statistički podaci
Vrijeme je da provjerimo neke statistike o našim ciljnim varijablama. Na donjem grafikonu računate postotak osoba koje zarađuju više od 50 tisuća s obzirom na njihov spol.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Izlaz:

Zatim provjerite utječe li podrijetlo pojedinca na zaradu.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Izlaz:

Broj radnih sati prema spolu.
# 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()
Izlaz:

Okvir potvrđuje da raspodjela radnog vremena odgovara različitim skupinama. U zaokretnoj plohi oba spola nemaju homogena zapažanja.
Gustoću tjednog radnog vremena možete provjeriti prema vrsti obrazovanja. Distribucije imaju mnogo različitih izbora. To se vjerojatno može objasniti vrstom ugovora u SAD-u.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Objašnjenje koda

ggplot (recast_data, aes (x = hours.per.week)): Grafikon gustoće zahtijeva samo jednu varijablu
geom_density (aes (boja = obrazovanje), alfa = 0,5): Geometrijski objekt za kontrolu gustoće

Izlaz:

Da biste potvrdili svoje misli, možete provesti jednosmjerni ANOVA test:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Izlaz:
## 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 test potvrđuje razliku u prosjeku među skupinama.
Nelinearnost
Prije pokretanja modela možete vidjeti je li broj odrađenih sati povezan s dobi.
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()
Objašnjenje koda

ggplot (preinačeni_podatci, aes (x = dob, y = sati u tjednu)): Postavite estetiku grafa
geom_point (aes (boja = prihod), veličina = 0,5): Konstruirajte točku
stat_smooth (): Dodajte liniju trenda sa sljedećim argumentima:

method = 'lm': Nacrtajte ugrađenu vrijednost ako je linearna regresija
formula = y ~ poli (x, 2): Uklapa se polinomska regresija
se = TRUE: dodajte standardnu ​​pogrešku
aes (boja = prihod): Razbijte model prema prihodu



Izlaz:

Ukratko, možete testirati pojmove interakcije u modelu kako biste prepoznali učinak nelinearnosti između tjednog radnog vremena i drugih značajki. Važno je otkriti pod kojim se uvjetima radno vrijeme razlikuje.
Poveznica
Sljedeća provjera je vizualizacija korelacije između varijabli. Tip faktorske razine pretvorite u numerički kako biste mogli ucrtati toplinsku kartu koja sadrži koeficijent korelacije izračunat Spearmanovom metodom.
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")
Objašnjenje koda

data.frame (lapply (recast_data, as.integer)): Pretvori podatke u numeričke
ggcorr () crta toplinsku kartu sa sljedećim argumentima:

metoda: Metoda za izračunavanje korelacije
nbreaks = 6: Broj prekida
hjust = 0,8: Kontrolni položaj imena varijable u grafikonu
label = TRUE: dodajte oznake u središte prozora
label_size = 3: Oznake veličine
color = "grey50"): Boja naljepnice



Izlaz:

Korak 5) Vlak / testni set
Bilo koji zadatak nadziranog strojnog učenja zahtijeva razdvajanje podataka između vlaka i testa. Možete koristiti "funkciju" koju ste kreirali u drugim vodičima za učenje pod nadzorom da biste stvorili vlak / testni set.
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)
Izlaz:
## [1] 36429 9
 
dim(data_test)
Izlaz:
## [1] 9108 9 
Korak 6) Izgradite model
Da biste vidjeli kako algoritam funkcionira, koristite glm () paket. Generaliziranog linearnog modela je skup više modela. Osnovna sintaksa 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")
Spremni ste za procjenu logističkog modela za podjelu razine dohotka između skupa značajki.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Objašnjenje koda

formula <- prihod ~.: Stvorite model koji odgovara
logit <- glm (formula, data = data_train, family = 'binomial'): Uklapajte logistički model (family = 'binomial') s podacima data_train.
sažetak (logit): Ispis sažetka modela

Izlaz:
#### 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
Sažetak našeg modela otkriva zanimljive informacije. Izvedba logističke regresije procjenjuje se pomoću određenih ključnih mjernih podataka.

AIC (Akaike informacijski kriteriji): Ovo je ekvivalent R2 u logističkoj regresiji. Mjeri se prikladnost kada se primijeni kazna na broj parametara. Manje vrijednosti AIC ukazuju da je model bliži istini.
Null deviance: Uklapa se u model samo uz presretanje. Stupanj slobode je n-1. Možemo ga protumačiti kao hi-kvadrat vrijednost (uklopljena vrijednost različita od stvarnog testiranja hipoteze vrijednosti).
Preostali odstupanje: Model sa svim varijablama. Također se tumači kao hi-kvadrat testiranje hipoteze.
Broj iteracija Fisher bodovanja: Broj iteracija prije konvergiranja.

Izlaz funkcije glm () pohranjen je na popisu. Kôd u nastavku prikazuje sve stavke dostupne u logit varijabli koju smo konstruirali za procjenu logističke regresije.
# Popis je vrlo dugačak, ispišite samo prva tri elementa
lapply(logit, class)[1:3]
Izlaz:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Svaka vrijednost može se izdvojiti znakom $ iza kojeg slijedi naziv mjernih podataka. Na primjer, pohranili ste model kao logit. Da biste izdvojili AIC kriterije, koristite:
logit$aic
Izlaz:
## [1] 27086.65
Korak 7) Procijenite izvedbu modela
Matrica zbrke
Zbunjenost matrica je bolji izbor za procjenu uspješnosti klasifikacije u usporedbi s različitim mjernim podacima koje ste vidjeli prije. Općenita je ideja računati koliko su puta istinite instance klasificirane kao Lažne.

Da biste izračunali matricu zbrke, prvo morate imati set predviđanja kako bi se mogla usporediti sa stvarnim ciljevima.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Objašnjenje koda

predviđanje (logit, data_test, type = 'response'): Izračunajte predviđanje na testnom skupu. Postavite type = 'response' za izračunavanje vjerojatnosti odgovora.
tablica (data_test $ prihod, predviđa> 0,5): Izračunajte matricu zbrke. predviđa> 0,5 znači da vraća 1 ako su predviđene vjerojatnosti veće od 0,5, inače 0.

Izlaz:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Svaki redak u matrici zabune predstavlja stvarni cilj, dok svaki stupac predstavlja predviđeni cilj. Prvi redak ove matrice uzima u obzir dohodak niži od 50k (False klasa): 6241 je ispravno klasificirano kao pojedinac s prihodom manjim od 50k ( Točno negativno ), dok je preostali pogrešno klasificiran kao iznad 50k ( Lažno pozitivno ). Drugi red uzima u obzir prihod veći od 50.000, pozitivna je klasa 1229 ( točno pozitivna ), dok je istinita negativna 1074.
Točnost modela možete izračunati zbrajanjem istinitih pozitivnih + istinitih negativnih u ukupnom promatranju

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Objašnjenje koda

zbroj (diag (table_mat)): zbroj dijagonale
zbroj (table_mat): Zbroj matrice.

Izlaz:
## [1] 0.8277339 
Čini se da model pati od jednog problema, on precjenjuje broj lažnih negativa. To se naziva paradoksom ispitivanja točnosti . Izjavili smo da je točnost omjer točnih predviđanja i ukupnog broja slučajeva. Možemo imati relativno visoku točnost, ali beskoristan model. To se događa kad postoji dominantna klasa. Ako se osvrnete na matricu zbrke, možete vidjeti da je većina slučajeva klasificirana kao istinski negativna. Zamislite sada, model je klasificirao sve klase kao negativne (tj. Niže od 50 k). Imali biste točnost od 75 posto (6718/6718 + 2257). Vaš model ima bolju izvedbu, ali se bori da razlikuje istinsko pozitivno od istinskog negativnog.
U takvoj je situaciji poželjnije imati sažetiju metriku. Možemo pogledati:

Preciznost = TP / (TP + FP)
Povrat = TP / (TP + FN)

Preciznost protiv opoziva
Preciznost gleda na točnost pozitivnog predviđanja. Prisjećanje je omjer pozitivnih slučajeva koje je klasifikator ispravno otkrio;
Možete izračunati dvije funkcije za izračunavanje ove dvije metrike

Konstruirajte preciznost

precision <- function(matrix) {# True positivetp <- matrix[2, 2]# false positivefp <- matrix[1, 2]return (tp / (tp + fp))}
Objašnjenje koda

mat [1,1]: Vrati prvu ćeliju prvog stupca okvira podataka, tj. istinski pozitiv
prostirka [1,2]; Vrati prvu ćeliju drugog stupca podatkovnog okvira, tj. Lažno pozitivno

recall <- function(matrix) {# true positivetp <- matrix[2, 2]# false positivefn <- matrix[2, 1]return (tp / (tp + fn))}
Objašnjenje koda

mat [1,1]: Vrati prvu ćeliju prvog stupca okvira podataka, tj. istinski pozitiv
prostirka [2,1]; Vrati drugu ćeliju prvog stupca okvira podataka, tj. Lažno negativno

Možete testirati svoje funkcije
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Izlaz:
## [1] 0.712877## [2] 0.5336518
Kad model kaže da se radi o pojedincu iznad 50 tisuća, to je točno u samo 54 posto slučajeva, a može zatražiti osobe iznad 50 tisuća u 72 posto slučajeva.
Rezultat možete stvoriti Je harmonijski sredina tih dvaju mjerenja, što znači da daje više težine na niže vrijednosti.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Izlaz:
## [1] 0.6103799 
Preciznost i povrat opoziva
Nemoguće je imati visoku preciznost i visok opoziv.
Ako povećamo preciznost, točniji pojedinac bit će bolje predviđen, ali propustili bismo puno njih (niži opoziv). U nekim situacijama preferiramo veću preciznost od opoziva. Između preciznosti i opoziva postoji konkavni odnos.

Zamislite, trebate predvidjeti ima li pacijent bolest. Želite biti što precizniji.
Ako trebate prepoznati potencijalne prevarante na ulici prepoznavanjem lica, bilo bi bolje uhvatiti mnoge ljude koji su označeni kao prevaranti iako je preciznost niska. Policija će moći pustiti osobu koja nije prevara.

ROC krivulja
Za uspored krivulja je još jedan čest alat koji se koristi s binarnim klasifikacije. Vrlo je slična krivulji preciznosti / opoziva, ali umjesto crtanja preciznosti u odnosu na opoziv, ROC krivulja pokazuje istinsku pozitivnu stopu (tj. Opoziv) u odnosu na lažno pozitivnu stopu. Stopa lažno pozitivnih je omjer negativnih slučajeva koji su pogrešno klasificirani kao pozitivni. Jednako je jedinici minus minus stvarna negativna stopa. Prava negativna stopa također se naziva specifičnost . Stoga ROC krivulja crta osjetljivost (opoziv) nasuprot 1-specifičnosti
Da bismo ucrtali ROC krivulju, moramo instalirati knjižnicu pod nazivom RORC. Možemo pronaći u knjižnici conda. Možete upisati kod:
conda install -cr r-rocr --da
ROC možemo zacrtati s funkcijama predviđanja () i izvedbe ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Objašnjenje koda

predviđanje (predviđanje, data_test $ prihod): ROCR knjižnica treba stvoriti objekt predviđanja za transformiranje ulaznih podataka
izvedba (ROCRpred, 'tpr', 'fpr'): Vratite dvije kombinacije koje će se stvoriti na grafikonu. Ovdje se grade tpr i fpr. Za preciznost crtanja i opoziva zajedno koristite "prec", "rec".

Izlaz:

Korak 8) Poboljšajte model
Možete pokušati dodati nelinearnost modelu uz interakciju između

starost i sati.na tjedan
spol i sati.na tjedan.

Za usporedbu oba modela trebate koristiti test rezultata
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
Izlaz:
## [1] 0.6109181 
Rezultat je nešto veći od prethodnog. Možete nastaviti raditi na podacima i pokušati nadmašiti rezultat.

Sažetak
Možemo sažeti funkciju za vježbanje logističke regresije u donjoj tablici:
 

 
 

Paket
 

Cilj
 

funkcija
 

argument
 

 

 

 
 

-
 

Stvorite skup podataka za vlak / test
 

create_train_set ()
 

podaci, veličina, vlak
 

 
 

glm
 

Osposobiti generalizirani linearni model
 

glm ()
 

formula, podaci, obitelj *
 

 
 

glm
 

Sažeti model
 

Sažetak()
 

ugrađeni model
 

 
 

baza
 

Napravite predviđanje
 

predvidjeti()
 

ugrađeni model, skup podataka, type = 'response'
 

 
 

baza
 

Stvorite matricu zbrke
 

stol()
 

y, predvidjeti ()
 

 
 

baza
 

Stvorite rezultat točnosti
 

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

 
 

ROCR
 

Stvaranje ROC: 1. korak Stvaranje predviđanja
 

predviđanje ()
 

predvidjeti (), y
 

 
 

ROCR
 

Stvaranje ROC: Korak 2 Stvaranje izvedbe
 

izvođenje()
 

predviđanje (), 'tpr', 'fpr'
 

 
 

ROCR
 

Stvaranje ROC: Korak 3 Crtanje grafa
 

zemljište()
 

izvođenje()
 

 

 

Drugi GLM modeli su:
- binom: (veza = "logit")
- gaussian: (veza = "identitet")
- Gama: (veza = "inverzna")
- inverse.gaussian: (veza = "1 / mu 2")
- poisson: (link = "log")
- kvazi: (veza = "identitet", varijansa = "konstanta")
- kvazibinomialni: (link = "logit")
- kvazipoisson: (link = "log")