GLM v R: Splošni linearni model s primerom

Kaj je logistična regresija?

Logistična regresija se uporablja za napovedovanje razreda, tj. Verjetnosti. Logistična regresija lahko natančno napove binarni izid.

Predstavljajte si, da želite na podlagi številnih lastnosti napovedati, ali je posojilo zavrnjeno / sprejeto. Logistična regresija je v obliki 0/1. y = 0, če je posojilo zavrnjeno, y = 1, če je sprejeto.

Logistični regresijski model se od linearnega regresijskega modela razlikuje na dva načina.

• Najprej logistična regresija kot odvisno spremenljivko (tj. Vektor 0 in 1) sprejme samo dihotomni (binarni) vhod.
• Drugič, rezultat se meri z naslednjo funkcijo verjetnostne povezave, imenovano sigmoid zaradi svoje oblike S:

Izhodna vrednost funkcije je vedno med 0 in 1. Preverite sliko spodaj

Sigmoidna funkcija vrne vrednosti od 0 do 1. Za klasifikacijsko nalogo potrebujemo diskretni izhod 0 ali 1.

Za pretvorbo neprekinjenega pretoka v diskretno vrednost lahko nastavimo odločitev, vezano na 0,5. Vse vrednosti nad tem pragom so razvrščene kot 1

V tej vadnici boste izvedeli

• Kaj je logistična regresija?
• Kako ustvariti generalizirani linijski model (GLM)
• Korak 1) Preverite neprekinjene spremenljivke
• Korak 2) Preverite spremenljivke faktorja
• 3. korak) Inženiring funkcij
• Korak 4) Povzetek statistike
• 5. korak) Vlak / testni niz
• 6. korak) Zgradite model
• Korak 7) Ocenite delovanje modela

Kako ustvariti generalizirani linijski model (GLM)

Za ponazoritev logistične regresije uporabimo nabor podatkov za odrasle . "Odrasla oseba" je odličen nabor podatkov za razvrščanje. Cilj je predvideti, ali bo letni dohodek posameznika v dolarjih presegel 50.000. Nabor podatkov vsebuje 46.033 opazovanj in deset funkcij:

• starost: starost posameznika. Številsko
• izobrazba: izobrazbena stopnja posameznika. Faktor.
• marital.status: Zakonski status posameznika. Dejansko, tj. Nikoli poročen, poročen-zakonski partner,…
• spol: spol posameznika. Faktor, tj. Moški ali ženska
• dohodek: ciljna spremenljivka. Dohodek nad ali pod 50K. Faktor tj.> 50K, <= 50K

med drugim

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

Izhod:

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… 

Nadaljevali bomo, kot sledi:

• 1. korak: Preverite neprekinjene spremenljivke
• 2. korak: Preverite spremenljivke faktorja
• 3. korak: Inženiring funkcij
• 4. korak: Povzetek statistike
• 5. korak: Vlak / testni niz
• 6. korak: zgradite model
• 7. korak: Ocenite zmogljivost modela
• 8. korak: Izboljšajte model

Vaša naloga je predvideti, kateri posameznik bo imel prihodek večji od 50K.

V tej vadnici bodo podrobno opisani vsi koraki za izvedbo analize na resničnem naboru podatkov.

Korak 1) Preverite neprekinjene spremenljivke

V prvem koraku lahko vidite porazdelitev zveznih spremenljivk.

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

Razlaga kode

• neprekinjeno <- select_if (data_adult, is.numeric): S funkcijo select_if () iz knjižnice dplyr izberite samo številske stolpce
• povzetek (neprekinjeno): natisnite povzetek statistike

Izhod:

## 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 zgornje tabele lahko vidite, da imajo podatki popolnoma različne lestvice in ur. Na teden ima velike odstopanja (.poglejmo zadnji kvartil in največjo vrednost).

Z njim se lahko spoprimete v dveh korakih:

• 1: Načrtujte razporeditev ur na teden
• 2: Standardizirajte zvezne spremenljivke

1. Načrtujte distribucijo

Poglejmo si podrobneje razporeditev ur na teden

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

Izhod:

Spremenljivka ima veliko izstopajočih in slabo definirano porazdelitev. Te težave lahko delno rešite tako, da izbrišete največ 0,01 odstotka ur na teden.

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čunamo zgornja 2-odstotna percentila

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

Razlaga kode

• kvantil (data_adult $ hours.per.week, .99): Izračunajte vrednost 99 odstotkov delovnega časa

Izhod:

## 99%## 80 

98 odstotkov prebivalstva dela manj kot 80 ur na teden.

Opažanja lahko spustite nad ta prag. Uporabljate filter iz knjižnice dplyr.

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


## [1] 45537 10 
 

Standardizirajte zvezne spremenljivke

Vsak stolpec lahko standardizirate za izboljšanje učinkovitosti, ker vaši podatki nimajo enake lestvice. Uporabite lahko funkcijo mutate_if iz knjižnice 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
Številske stolpce lahko standardizirate na naslednji način:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Razlaga kode

mutate_if (is.numeric, funs (scale)): Pogoj je le številski stolpec, funkcija pa obseg

Izhod:
## 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) Preverite spremenljivke faktorja
Ta korak ima dva cilja:

Preverite nivo v vsakem kategoričnem stolpcu
Določite nove ravni

Ta korak bomo razdelili na tri dele:

Izberite kategorične stolpce
Palični grafikon vsakega stolpca shranite na seznam
Natisnite grafe

Stolpe faktorja lahko izberemo s spodnjo kodo:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Razlaga kode

data.frame (select_if (data_adult, is.factor)): Stolpce faktorja shranimo v faktor v tipu podatkovnega okvira. Knjižnica ggplot2 zahteva objekt podatkovnega okvira.

Izhod:
## [1] 6 
Nabor podatkov vsebuje 6 kategoričnih spremenljivk
Drugi korak je bolj vešč. Za vsak stolpec v faktorju podatkovnega okvira želite izrisati stolpčni grafikon. Bolj priročno je avtomatizirati postopek, zlasti v razmerah, ko je veliko stolpcev.
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)))
Razlaga kode

lapply (): uporabite funkcijo lapply () za posredovanje funkcije v vseh stolpcih nabora podatkov. Rezultate shranite na seznam
funkcija (x): funkcija bo obdelana za vsak x. Tu je x stolpci
ggplot (faktor, aes (get (x))) + geom_bar () + tema (axis.text.x = element_text (kot = 90)): ustvarite stolpčni grafikon za vsak element x. Opomba: če želite x vrniti kot stolpec, ga morate vključiti v get ()

Zadnji korak je razmeroma enostaven. Želite natisniti 6 grafov.
# Print the graphgraph
Izhod:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Opomba: Z naslednjim gumbom se pomaknite do naslednjega grafa

3. korak) Inženiring funkcij
Prenovljeno izobraževanje
Iz zgornjega grafa lahko vidite, da ima spremenljivka izobrazba 16 stopenj. To je bistveno in na nekaterih ravneh je razmeroma malo opazovanj. Če želite izboljšati količino informacij, ki jih lahko dobite s to spremenljivko, jih lahko preoblikujete v višjo raven. Ustvarite namreč večje skupine s podobno stopnjo izobrazbe. Na primer, nizka stopnja izobrazbe se bo pretvorila v osip. Višje stopnje izobrazbe bodo spremenjene v mojstrske.
Tu je podrobnost:
 

 
 

Stara raven
 

Nova raven
 

 

 

 
 

Vrtec
 

osip
 

 
 

10.
 

Osip
 

 
 

11.
 

Osip
 

 
 

12.
 

Osip
 

 
 

1.-4
 

Osip
 

 
 

5.-6
 

Osip
 

 
 

7.-8
 

Osip
 

 
 

9.
 

Osip
 

 
 

HS-Grad
 

HighGrad
 

 
 

Nekaj ​​fakultete
 

Skupnosti
 

 
 

Assoc-acdm
 

Skupnosti
 

 
 

Izr
 

Skupnosti
 

 
 

Diplomanti
 

Diplomanti
 

 
 

Mojstri
 

Mojstri
 

 
 

Prof-šola
 

Mojstri
 

 
 

Doktorat
 

Doktorat
 

 

 

 
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")))))))
Razlaga kode

Uporabljamo glagol mutate iz knjižnice dplyr. Vrednote izobrazbe spreminjamo s trditvijo ifelse

V spodnji tabeli ustvarite zbirno statistiko, s katero boste v povprečju videli, koliko let izobrazbe (vrednost z) potrebujete za pridobitev diplome, magistra ali doktorata.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Izhod:
## # 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
Prenovljeno poročno stanje
Možno je tudi ustvariti nižje ravni za zakonski stan. V naslednji kodi spremenite nivo, kot sledi:
 

 
 

Stara raven
 

Nova raven
 

 

 

 
 

Nikoli poročen
 

Ni poročen
 

 
 

Poročen-zakonec-odsoten
 

Ni poročen
 

 
 

Poročen-AF-zakonec
 

Poročena
 

 
 

Poročena-civil-zakonec
 
 

 
 

Ločeni
 

Ločeni
 

 
 

Ločen
 
 

 
 

Vdove
 

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")))))
 Število posameznikov v vsaki skupini lahko preverite. 
table(recast_data$marital.status)
Izhod:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Korak 4) Povzetek statistike
Čas je, da preverimo nekaj statističnih podatkov o naših ciljnih spremenljivkah. V spodnjem grafu preštejete odstotek posameznikov, ki zaslužijo več kot 50.000 glede na njihov spol.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Izhod:

Nato preverite, ali izvor posameznika vpliva na zaslužek.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Izhod:

Število ur dela po 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()
Izhod:

Škatla potrjuje, da porazdelitev delovnega časa ustreza različnim skupinam. V okvirčku ploskev oba spola nimata homogenih opažanj.
Gostoto tedenskega delovnega časa lahko preverite glede na vrsto izobrazbe. Distribucije imajo številne različne izbire. Verjetno je to mogoče razložiti z vrsto pogodbe v ZDA.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Razlaga kode

ggplot (recast_data, aes (x = hours.per.week)): Graf gostote zahteva samo eno spremenljivko
geom_density (aes (barva = izobrazba), alfa = 0,5): geometrijski objekt za nadzor gostote

Izhod:

Za potrditev svojih misli lahko izvedete enosmerni test ANOVA:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Izhod:
## 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 potrjuje razliko v povprečju med skupinami.
Nelinearnost
Preden zaženete model, lahko vidite, ali je število opravljenih ur povezano s starostjo.
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()
Razlaga kode

ggplot (recast_data, aes (x = starost, y = ure na teden)): nastavite estetiko grafa
geom_point (aes (barva = dohodek, velikost = 0,5)): zgradite pikčasto ploskev
stat_smooth (): Dodajte vrstico trenda z naslednjimi argumenti:

method = 'lm': Vnesite vgrajeno vrednost, če je linearna regresija
formula = y ~ poli (x, 2): prilagodi polinomsko regresijo
se = TRUE: dodajte standardno napako
aes (barva = dohodek): razčlenite model glede na dohodek



Izhod:

Na kratko lahko v modelu preizkusite pogoje interakcije, da izberete učinek nelinearnosti med tedenskim delovnim časom in drugimi funkcijami. Pomembno je zaznati, pod katerimi pogoji se delovni čas razlikuje.
Korelacija
Naslednje preverjanje je vizualizacija korelacije med spremenljivkami. Tip ravni faktorja pretvorite v številčno, tako da lahko narišete toplotno karto, ki vsebuje koeficient korelacije, izračunan z metodo Spearman.
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")
Razlaga kode

data.frame (lapply (recast_data, as.integer)): Pretvori podatke v številske
ggcorr () pripravi toplotni zemljevid z naslednjimi argumenti:

metoda: metoda za izračun korelacije
nbreaks = 6: Število prekinitev
hjust = 0,8: Nadzorni položaj imena spremenljivke v grafikonu
label = TRUE: dodajte oznake na sredino oken
label_size = 3: Velikost nalepk
color = "grey50"): Barva nalepke



Izhod:

5. korak) Vlak / testni niz
Vsaka naloga nadzorovanega strojnega učenja zahteva razdelitev podatkov med vlakovnim in testnim sklopom. Za ustvarjanje nabora vlakov / preizkusov lahko uporabite "funkcijo", ki ste jo ustvarili v drugih vajenih vajah pod nadzorom.
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)
Izhod:
## [1] 36429 9
 
dim(data_test)
Izhod:
## [1] 9108 9 
6. korak) Zgradite model
Če želite videti, kako deluje algoritem, uporabite paket glm (). Splošni Linearni model je zbirka modelov. 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")
Pripravljeni ste oceniti logistični model, da razdelite raven dohodka na nabor funkcij.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Razlaga kode

formula <- dohodek ~.: ustvarite model, ki ustreza
logit <- glm (formula, data = data_train, family = 'binomial'): Namestite logistični model (family = 'binomial') s podatki data_train.
povzetek (logit): natisnite povzetek modela

Izhod:
#### 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
Povzetek našega modela razkriva zanimive informacije. Uspešnost logistične regresije se ovrednoti s posebnimi ključnimi meritvami.

AIC (Akaike Information Criteria): To je enakovredno R2 v logistični regresiji. Izmeri primernost, ko se kaznuje število parametrov. Manjše vrednosti AIC kažejo, da je model bližje resnici.
Null deviance: Model ustreza samo prestrezanju. Stopnja svobode je n-1. Lahko si ga razlagamo kot vrednost hi-kvadrat (vgrajena vrednost se razlikuje od dejanskega preverjanja hipoteze vrednosti).
Preostalo odstopanje: Model z vsemi spremenljivkami. Razlaga se tudi kot preverjanje hipoteze Hi-kvadrat.
Število ponovitev Fisherjevega točkovanja: Število ponovitev pred konvergenco.

Izhod funkcije glm () je shranjen na seznamu. Spodnja koda prikazuje vse elemente, ki so na voljo v spremenljivki logit, ki smo jo izdelali za oceno logistične regresije.
# Seznam je zelo dolg, natisnite samo prve tri elemente
lapply(logit, class)[1:3]
Izhod:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Vsako vrednost je mogoče izvleči z znakom $, ki mu sledi ime meritev. Model ste na primer shranili kot logit. Za pridobivanje meril AIC uporabite:
logit$aic
Izhod:
## [1] 27086.65
Korak 7) Ocenite delovanje modela
Matrica zmede
Zmeda matrika je boljša izbira za oceno uspešnosti razvrščanje v primerjavi z različnimi meritvami ste videli prej. Splošna ideja je, da štejemo, kolikokrat so resnični primerki razvrščeni kot lažni.

Če želite izračunati matriko zmede, morate najprej imeti nabor napovedi, da jih lahko primerjate z dejanskimi cilji.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Razlaga kode

napovedi (logit, data_test, type = 'response'): Izračunajte napoved na testnem nizu. Nastavite type = 'response' za izračun verjetnosti odziva.
tabela (data_test $ dohodek, napoved> 0,5): Izračunajte matriko zmede. napovedi> 0,5 pomeni, da vrne 1, če so predvidene verjetnosti nad 0,5, sicer 0.

Izhod:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Vsaka vrstica v matriki zmede predstavlja dejanski cilj, medtem ko vsak stolpec predstavlja predvideni cilj. Prva vrstica te matrike obravnava dohodek, nižji od 50k (razred False): 6241 je bilo pravilno razvrščenih med posameznike z dohodkom nižjim od 50k ( resnično negativno ), preostalo pa je bilo napačno razvrščeno kot nad 50k ( lažno pozitivno ). Druga vrstica upošteva dohodek nad 50k, pozitivni razred je bil 1229 ( res pozitiven ), medtem ko je bil res negativni 1074.
Natančnost modela lahko izračunate s seštevanjem resničnega pozitivnega + resničnega negativnega v celotnem opazovanju

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Razlaga kode

vsota (diag (table_mat)): vsota diagonale
vsota (table_mat): vsota matrike.

Izhod:
## [1] 0.8277339 
Zdi se, da model trpi zaradi ene težave, saj precenjuje število lažnih negativov. To se imenuje paradoks preskusa natančnosti . Izjavili smo, da je natančnost razmerje med pravilnimi napovedmi in skupnim številom primerov. Lahko imamo razmeroma visoko natančnost, a neuporaben model. To se zgodi, ko obstaja prevladujoči razred. Če se ozrete nazaj na matriko zmede, lahko vidite, da je večina primerov razvrščena kot resnično negativna. Predstavljajte si zdaj, da je model vse razrede razvrstil kot negativne (tj. Nižje od 50 k). Dobili bi natančnost 75 odstotkov (6718/6718 + 2257). Vaš model deluje boljše, vendar se trudi ločiti resnično pozitivno od resnične negativne.
V takšnih razmerah je zaželena bolj jedrnata metrika. Lahko si ogledamo:

Natančnost = TP / (TP + FP)
Odpoklic = TP / (TP + FN)

Natančnost proti odpoklicu
Natančnost gleda na natančnost pozitivne napovedi. Odpoklic je razmerje pozitivnih primerov, ki jih je klasifikator pravilno zaznal;
Za izračun teh dveh meritev lahko sestavite dve funkciji

Natančnost konstrukcije

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

mat [1,1]: vrne prvo celico prvega stolpca podatkovnega okvira, tj. pravi pozitiv
podloga [1,2]; Vrne prvo celico drugega stolpca podatkovnega okvira, tj. Lažno pozitivno

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

mat [1,1]: vrne prvo celico prvega stolpca podatkovnega okvira, tj. pravi pozitiv
podloga [2,1]; Vrne drugo celico prvega stolpca podatkovnega okvira, to je lažno negativno

Lahko preizkusite svoje funkcije
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Izhod:
## [1] 0.712877## [2] 0.5336518
Ko model pravi, da gre za posameznika nad 50k, je to pravilno le v 54 odstotkih primerov, v 72 odstotkih pa lahko zahteva posameznike nad 50k.
Rezultat lahko ustvarite harmonična sredina teh dveh meritev, kar pomeni, da daje večjo težo spodnjim vrednostim.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Izhod:
## [1] 0.6103799 
Kompromis med natančnostjo in odpoklicem
Nemogoče je imeti visoko natančnost in visok odpoklic.
Če povečamo natančnost, bomo pravilnejšega posameznika bolje napovedali, vendar bi jih pogrešali (manjši odpoklic). V nekaterih primerih imamo raje večjo natančnost kot odpoklic. Med natančnostjo in odpoklicem je konkavno razmerje.

Predstavljajte si, da morate predvideti, ali ima pacient bolezen. Želite biti čim bolj natančni.
Če morate na ulici prepoznati morebitne prevarante s prepoznavanjem obraza, bi bilo bolje, če ujamete veliko ljudi, ki so označeni za prevarante, čeprav je natančnost nizka. Policisti bodo lahko goljufa izpustili.

Krivulja ROC
Značilen sprejemnik Operacijski krivulja je še en skupni orodje z binarno klasifikacijo. Zelo je podobna krivulji natančnosti / odpoklica, toda krivulja ROC namesto, da bi narisala natančnost in odpoklic, prikazuje resnično pozitivno stopnjo (tj. Odpoklic) v primerjavi z lažno pozitivno stopnjo. Stopnja lažno pozitivnih vrednosti je razmerje negativnih primerov, ki so nepravilno razvrščeni kot pozitivni. Enako je enaki minus resnični negativni stopnji. Resnična negativna stopnja se imenuje tudi specifičnost . Zato krivulja ROC nariše občutljivost (odpoklic) v primerjavi z 1-specifičnostjo
Za risanje krivulje ROC moramo namestiti knjižnico z imenom RORC. Najdemo v knjižnici conda. Kodo lahko vnesete:
conda install -cr r-rocr --da
ROC lahko narišemo s funkcijama predvidevanja () in učinkovitosti ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Razlaga kode

napoved (napoved, data_test $ dohodek): Knjižnica ROCR mora ustvariti objekt predvidevanja za pretvorbo vhodnih podatkov
uspešnost (ROCRpred, 'tpr', 'fpr'): Vrnite dve kombinaciji, ki se bosta ustvarili v grafu. Tu sta zgrajeni tpr in fpr. Za natančnost načrtovanja in priklica skupaj uporabite "prec", "rec".

Izhod:

Korak 8) Izboljšajte model
Modelu lahko poskusite dodati nelinearnost z interakcijo med

starost in ure na teden
spol in ure na teden.

Za primerjavo obeh modelov morate uporabiti rezultat
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
Izhod:
## [1] 0.6109181 
Ocena je nekoliko višja od prejšnje. Lahko še naprej delate na podatkih in poskusite premagati rezultat.

Povzetek
V spodnji tabeli lahko povzamemo funkcijo za urjenje logistične regresije:
 

 
 

Paket
 

Cilj
 

funkcijo
 

prepir
 

 

 

 
 

-
 

Ustvari nabor podatkov za vlak / preizkus
 

create_train_set ()
 

podatki, velikost, vlak
 

 
 

glm
 

Izurite splošni linearni model
 

glm ()
 

formula, podatki, družina *
 

 
 

glm
 

Povzemite model
 

povzetek ()
 

opremljen model
 

 
 

osnova
 

Naredite napovedi
 

napovedi ()
 

nameščen model, nabor podatkov, type = 'response'
 

 
 

osnova
 

Ustvari matriko zmede
 

tabela ()
 

y, napovedi ()
 

 
 

osnova
 

Ustvari rezultat natančnosti
 

vsota (diag (tabela ()) / vsota (tabela ()
 

 
 

ROCR
 

Ustvari ROC: 1. korak Ustvari napoved
 

napoved ()
 

napovedi (), y
 

 
 

ROCR
 

Ustvari ROC: 2. korak Ustvari zmogljivost
 

izvedba()
 

napoved (), 'tpr', 'fpr'
 

 
 

ROCR
 

Ustvari ROC: 3. korak Izriši graf
 

ploskev ()
 

izvedba()
 

 

 

Drugi modeli GLM so:
- binom: (povezava = "logit")
- gaussian: (povezava = "identiteta")
- gama: (povezava = "inverzna")
- inverse.gaussian: (povezava = "1 / mu 2")
- poisson: (povezava = "dnevnik")
- kvazi: (povezava = "identiteta", varianca = "konstanta")
- kvazibinomialno: (povezava = "logit")
- kvazipoisson: (povezava = "dnevnik")