GLM R: ssä: yleistetty lineaarinen malli esimerkillä

Mikä on logistinen regressio?

Logistista regressiota käytetään luokan eli todennäköisyyden ennustamiseen. Logistinen regressio voi ennustaa binäärisen tuloksen tarkasti.

Kuvittele, että haluat ennustaa, onko laina evätty / hyväksytty monien ominaisuuksien perusteella. Logistinen regressio on muodoltaan 0/1. y = 0, jos laina hylätään, y = 1, jos se hyväksytään.

Logistinen regressiomalli eroaa lineaarisesta regressiomallista kahdella tavalla.

• Ensinnäkin logistinen regressio hyväksyy vain dikotomisen (binäärisen) syötteen riippuvaiseksi muuttujaksi (ts. Vektoriksi 0 ja 1).
• Toiseksi tulos mitataan seuraavalla todennäköisyyslinkin toiminnolla, jota kutsutaan sigmoidiksi sen S-muotoisen johtuen:

Toiminnon lähtö on aina välillä 0 - 1. Tarkista alla oleva kuva

Sigmoidifunktio palauttaa arvot 0: sta 1. Luokitustehtävään tarvitaan erillinen lähtö 0 tai 1.

Jatkuvan virtauksen muuntamiseksi erilliseksi arvoksi voimme asettaa päätökseksi sidotun arvon 0,5. Kaikki tämän kynnyksen ylittävät arvot luokitellaan 1: ksi

Tässä opetusohjelmassa opit

• Mikä on logistinen regressio?
• Kuinka luoda yleinen viivamalli (GLM)
• Vaihe 1) Tarkista jatkuvat muuttujat
• Vaihe 2) Tarkista tekijämuuttujat
• Vaihe 3) Ominaisuuksien suunnittelu
• Vaihe 4) Yhteenvetotilasto
• Vaihe 5) Juna / testisarja
• Vaihe 6) Rakenna malli
• Vaihe 7) Arvioi mallin suorituskyky

Kuinka luoda yleinen viivamalli (GLM)

Käytetään aikuisten tietojoukkoa havainnollistamaan logistista regressiota. "Aikuinen" on loistava aineisto luokitustehtävälle. Tavoitteena on ennustaa, ylittävätkö henkilön vuotuiset tulot dollareina 50 000. Aineisto sisältää 46033 havaintoa ja kymmenen ominaisuutta:

• ikä: yksilön ikä. Numeerinen
• koulutus: Yksilön koulutustaso. Tekijä.
• Marital.status: Yksilön siviilisääty. Kerroin eli ei koskaan naimisissa, naimisissa-kansalaispuoliso,…
• sukupuoli: yksilön sukupuoli. Kerroin eli mies tai nainen
• tulot: Kohdemuuttuja. Tulot yli 50 kt. Kerroin eli> 50K, <= 50K

muiden joukossa

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

Tuotos:

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… 

Menemme seuraavasti:

• Vaihe 1: Tarkista jatkuvat muuttujat
• Vaihe 2: Tarkista tekijämuuttujat
• Vaihe 3: Ominaisuuksien suunnittelu
• Vaihe 4: Yhteenvetotilasto
• Vaihe 5: Juna / testisarja
• Vaihe 6: Rakenna malli
• Vaihe 7: Arvioi mallin suorituskyky
• vaihe 8: Paranna mallia

Sinun tehtäväsi on ennustaa, kenen yksilön tulot ovat yli 50 000.

Tässä opetusohjelmassa jokainen vaihe on yksityiskohtainen analyysin suorittamiseksi todelliselle tietojoukolle.

Vaihe 1) Tarkista jatkuvat muuttujat

Ensimmäisessä vaiheessa näet jatkuvien muuttujien jakauman.

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

Koodin selitys

• jatkuva <- select_if (data_adult, is.numeerinen): Käytä dplyr-kirjaston funktiota select_if () valitaksesi vain numeeriset sarakkeet
• yhteenveto (jatkuva): Tulosta yhteenvetotilasto

Tuotos:

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

Yllä olevasta taulukosta näet, että tiedoilla on täysin erilaiset asteikot ja tunnit.per.weeksillä on suuret poikkeamat (.ee tarkastele viimeistä kvartiilia ja maksimiarvoa).

Voit käsitellä sitä kahdella tavalla:

• 1: Piirrä tuntien jakauma viikossa
• 2: Jatkuvien muuttujien standardointi

1. Piirrä jakauma

Katsotaanpa tarkemmin tuntien jakautumista viikossa

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

Tuotos:

Muuttujalla on paljon poikkeamia eikä tarkasti määriteltyä jakaumaa. Voit osittain ratkaista tämän ongelman poistamalla 0,01 prosentin alimman prosentin viikoista.

Kvantiilin perussyntaksi:

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.

Laskemme ylimmän 2 prosentin prosenttipisteen

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

Koodin selitys

• kvantiili (data_adult $ hours.per.week, .99): Laske työajan 99 prosentin arvo

Tuotos:

## 99%## 80 

98 prosenttia väestöstä työskentelee alle 80 tuntia viikossa.

Voit pudottaa havainnot tämän kynnyksen yläpuolelle. Käytät dplyrin kirjaston suodatinta.

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


## [1] 45537 10 
 

Standardoi jatkuvat muuttujat

Voit standardoida jokaisen sarakkeen suorituskyvyn parantamiseksi, koska tietojesi mittakaava ei ole sama. Voit käyttää funktiota mutate_if dplyr-kirjastosta. Perussyntaksi on:
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
Voit standardoida numeeriset sarakkeet seuraavasti:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Koodin selitys

mutate_if (is.numeerinen, funs (asteikko)): Ehto on vain numeerinen sarake ja funktio on asteikko

Tuotos:
## 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
Vaihe 2) Tarkista tekijämuuttujat
Tällä vaiheella on kaksi tavoitetta:

Tarkista kunkin kategorisen sarakkeen taso
Määritä uudet tasot

Jaamme tämän vaiheen kolmeen osaan:

Valitse kategoriset sarakkeet
Tallenna kunkin sarakkeen pylväsdiagrammi luetteloon
Tulosta kaaviot

Voimme valita tekijäsarakkeet alla olevalla koodilla:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Koodin selitys

data.frame (select_if (data_adult, is.factor)): Tallennamme tekijäsarakkeet tekijäksi datakehystyyppiin. Kirjasto ggplot2 vaatii datakehysobjektin.

Tuotos:
## [1] 6 
Aineisto sisältää 6 kategorista muuttujaa
Toinen vaihe on taitavampi. Haluat piirtää pylväsdiagrammin jokaiselle sarakkeelle datakehystekijässä. On helpompaa automatisoida prosessi, varsinkin tilanteissa, joissa on paljon sarakkeita.
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)))
Koodin selitys

lapply (): Käytä funktiota lapply () siirtääksesi funktion kaikkiin tietojoukon sarakkeisiin. Tallennat lähdön luetteloon
function (x): Funktio käsitellään jokaiselle x: lle. Tässä x on sarakkeet
ggplot (kerroin, aes (get (x))) + geom_bar () + teema (akseli.teksti.x = elementti_teksti (kulma = 90)): Luo pylväskaavio jokaiselle x-elementille. Huomaa, että palautat x: n sarakkeeksi, sinun on sisällytettävä se get (): een

Viimeinen vaihe on suhteellisen helppo. Haluat tulostaa 6 kuvaajaa.
# Print the graphgraph
Tuotos:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Huomaa: Käytä seuraavaa painiketta siirtyäksesi seuraavaan kaavioon

Vaihe 3) Ominaisuuksien suunnittelu
Uudelleenlaadittu koulutus
Yllä olevasta kaaviosta näet, että muuttujan koulutuksella on 16 tasoa. Tämä on huomattavaa, ja joillakin tasoilla on suhteellisen vähän havaintoja. Jos haluat parantaa tästä muuttujasta saatavien tietojen määrää, voit muotoilla ne uudelleen korkeammalle tasolle. Nimittäin luot suurempia ryhmiä, joilla on samanlainen koulutustaso. Esimerkiksi matala koulutustaso muutetaan keskeyttäjinä. Korkeampi koulutus muutetaan masteriksi.
Tässä on yksityiskohta:
 

 
 

Vanha taso
 

Uusi taso
 

 

 

 
 

Esikoulu
 

lopettaa
 

 
 

10.
 

Lopettaa
 

 
 

11. päivä
 

Lopettaa
 

 
 

12
 

Lopettaa
 

 
 

1.-4
 

Lopettaa
 

 
 

5.-6
 

Lopettaa
 

 
 

7.-8
 

Lopettaa
 

 
 

Yhdeksäs
 

Lopettaa
 

 
 

HS-Grad
 

HighGrad
 

 
 

Joku yliopisto
 

Yhteisö
 

 
 

Assoc-acdm
 

Yhteisö
 

 
 

Assoc-voc
 

Yhteisö
 

 
 

Poikamies
 

Poikamies
 

 
 

Mestarit
 

Mestarit
 

 
 

Prof-koulu
 

Mestarit
 

 
 

Tohtorin tutkinto
 

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")))))))
Koodin selitys

Käytämme verbimutaatiota dplyr-kirjastosta. Muutamme koulutuksen arvoja lausunnolla ifelse

Seuraavassa taulukossa luot yhteenvetotilaston, jotta näet keskimäärin kuinka monen vuoden koulutuksen (z-arvo) kestää kandidaatin, maisterin tai tohtorin tutkinnon suorittamiseksi.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Tuotos:
## # 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
Laaditaan uudelleen siviilisääty
On myös mahdollista luoda alemmalle tasolle siviilisääty. Seuraavassa koodissa muutat tasoa seuraavasti:
 

 
 

Vanha taso
 

Uusi taso
 

 

 

 
 

Ei koskaan naimisissa
 

Ei naimisissa
 

 
 

Naimisissa oleva puoliso poissa
 

Ei naimisissa
 

 
 

Naimisissa - AF-puoliso
 

Naimisissa
 

 
 

Naimisissa-civ-puoliso
 
 

 
 

Erillään
 

Erillään
 

 
 

Eronnut
 
 

 
 

Lesket
 

Leski
 

 

 

 
# 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")))))
 Voit tarkistaa yksilöiden määrän kussakin ryhmässä. 
table(recast_data$marital.status)
Tuotos:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Vaihe 4) Yhteenvetotilasto
On aika tarkistaa joitain tilastoja kohdemuuttujistamme. Alla olevassa kaaviossa lasketaan niiden henkilöiden prosenttiosuus, jotka ansaitsevat yli 50 kt sukupuolensa perusteella.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Tuotos:

Tarkista seuraavaksi, vaikuttaako henkilön alkuperä hänen ansaintaansa.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Tuotos:

Työtuntien määrä sukupuolen mukaan.
# 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()
Tuotos:

Laatikkokaavio vahvistaa, että työajan jakautuminen sopii eri ryhmille. Laatikkokaaviossa molemmilla sukupuolilla ei ole homogeenisia havaintoja.
Voit tarkistaa viikoittaisen työajan tiheyden koulutuksen mukaan. Jakeluilla on monia erillisiä valintoja. Se voidaan todennäköisesti selittää sopimustyypillä Yhdysvalloissa.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Koodin selitys

ggplot (uudelleenlaadittu_data, aes (x = tuntia.viikko), tiheyskaavio vaatii vain yhden muuttujan
geom_density (aes (väri = koulutus), alfa = 0.5): geometrinen objekti tiheyden hallitsemiseksi

Tuotos:

Vahvista ajatuksesi suorittamalla yksisuuntainen ANOVA-testi:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Tuotos:
## 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-testi vahvistaa ryhmien keskimääräisen eron.
Epälineaarisuus
Ennen mallin käyttämistä näet, liittyykö tehtyjen tuntien määrä ikään.
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()
Koodin selitys

ggplot (uudelleenlaadittu_data, aes (x = ikä, y = tuntia.viikko)): Aseta kaavion esteettisyys
geom_point (aes (väri = tulo), koko = 0.5): Rakenna pistekaavio
stat_smooth (): Lisää trendirivi seuraavilla argumenteilla:

method = 'lm': Piirrä sovitettu arvo, jos lineaarinen regressio
kaava = y ~ poly (x, 2): Sovita polynomiregressio
se = TOSI: Lisää tavallinen virhe
aes (väri = tulo): Rajaa malli tulojen mukaan



Tuotos:

Lyhyesti sanottuna voit testata vuorovaikutustermejä mallissa saadaksesi epälineaarisuuden vaikutuksen viikoittaisen työajan ja muiden ominaisuuksien välillä. On tärkeää havaita, missä olosuhteissa työaika eroaa.
Korrelaatio
Seuraava tarkistus on visualisoida muuttujien välinen korrelaatio. Muunat tekijätason tyypin numeeriseksi, jotta voit piirtää lämpökartan, joka sisältää Spearman-menetelmällä lasketun korrelaatiokertoimen.
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")
Koodin selitys

data.frame (lapply (uudelleenlaadittu_data, as.integer)): Muunna data numeeriseksi
ggcorr () piirtää lämpökartan seuraavilla argumenteilla:

method: Menetelmä korrelaation laskemiseksi
nmurtumat = 6: Taukojen lukumäärä
hjust = 0,8: Muuttujan nimen ohjauspaikka kuvaajassa
label = TRUE: Lisää tarroja ikkunoiden keskelle
label_size = 3: Koko tarrat
color = "grey50"): Etiketin väri



Tuotos:

Vaihe 5) Juna / testisarja
Kaikki valvotut koneoppimistehtävät edellyttävät tietojen jakamista junajoukon ja testijoukon kesken. Voit käyttää muissa valvotuissa oppimisoppaissa luomasi "toimintoa" juna- tai testisarjan luomiseen.
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)
Tuotos:
## [1] 36429 9
 
dim(data_test)
Tuotos:
## [1] 9108 9 
Vaihe 6) Rakenna malli
Jos haluat nähdä algoritmin toiminnan, käytä glm () -pakettia. Yleistetty lineaarinen malli on kokoelma malleja. Perussyntaksi on:
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")
Olet valmis arvioimaan logistisen mallin jakamaan tulotaso ominaisuuksien joukon välillä.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Koodin selitys

kaava <- tulo ~.: Luo malli sopivaksi
logit <- glm (kaava, data = data_train, perhe = 'binomial'): Sovita logistinen malli (family = 'binomial') data_train-tietoihin.
yhteenveto (logit): Tulosta mallin yhteenveto

Tuotos:
#### 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
Mallin yhteenveto paljastaa mielenkiintoista tietoa. Logistisen regression suorituskyky arvioidaan erityisillä keskeisillä mittareilla.

AIC (Akaike Information Criteria): Tämä vastaa R2 : ta logistisessa regressiossa. Se mittaa sopivuutta, kun parametrien lukumäärälle määrätään rangaistus. Pienemmät AIC- arvot osoittavat, että malli on lähempänä totuutta.
Nollapoikkeama: Sopii malliin vain leikkauksella. Vapauden aste on n-1. Voimme tulkita sen Chi-neliöarvoksi (sovitettu arvo poikkeaa todellisen arvon hypoteesin testauksesta).
Jäännöspoikkeama: Malli kaikilla muuttujilla. Se tulkitaan myös Chi-neliön hypoteesin testauksena.
Fisher-pisteytys-iteraatioiden lukumäärä: Iteraatioiden määrä ennen lähentymistä.

Toiminnon glm () tulos on tallennettu luetteloon. Alla oleva koodi näyttää kaikki logit-muuttujassa käytettävissä olevat kohteet, jotka olemme rakentaneet logistisen regression arvioimiseksi.
# Luettelo on hyvin pitkä, tulosta vain kolme ensimmäistä elementtiä
lapply(logit, class)[1:3]
Tuotos:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Jokainen arvo voidaan purkaa $ -merkillä ja sen jälkeen mittarien nimellä. Esimerkiksi olet tallentanut mallin logitina. Voit purkaa AIC-kriteerit käyttämällä:
logit$aic
Tuotos:
## [1] 27086.65
Vaihe 7) Arvioi mallin suorituskyky
Sekaannusmatriisi
Sekaannus matriisi on parempi vaihtoehto arvioida luokituksen suorituskykyä verrattuna eri tietoja näit ennen. Yleisenä ajatuksena on laskea, kuinka monta kertaa todelliset esiintymät luokitellaan vääriksi.

Sekaannusmatriisin laskemiseksi sinulla on ensin oltava joukko ennusteita, jotta niitä voidaan verrata todellisiin kohteisiin.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Koodin selitys

ennustaa (logit, data_test, type = 'vastaus'): Laske testijoukon ennuste. Aseta type = 'response' vasteen todennäköisyyden laskemiseksi.
taulukko (data_test $ -tulot, ennustaa> 0,5): Laske sekaannusmatriisi. ennustaa> 0,5 tarkoittaa, että se palauttaa arvon 1, jos ennustetut todennäköisyydet ovat yli 0,5, muuten 0.

Tuotos:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Sekoitusmatriisin kukin rivi edustaa todellista kohdetta, kun taas kukin sarake edustaa ennustettua kohdetta. Tämän matriisin ensimmäisellä rivillä tulot ovat alle 50k (väärä luokka): 6241 luokiteltiin oikein henkilöiksi, joiden tulot olivat alle 50k ( tosi negatiivinen ), kun taas loput luokiteltiin virheellisesti yli 50k ( väärä positiivinen ). Toisella rivillä tulot ovat yli 50 000, positiivinen luokka oli 1229 ( tosi positiivinen ), kun taas tosi negatiivinen oli 1074.
Voit laskea mallin tarkkuuden laskemalla yhteen todellinen positiivinen + tosi negatiivinen koko havainnosta

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Koodin selitys

summa (diag (taulukko_mat)): Lävistäjän summa
summa (taulukon_matti): Matriisin summa.

Tuotos:
## [1] 0.8277339 
Malli näyttää kärsivän yhdestä ongelmasta, se yliarvioi väärien negatiivien määrän. Tätä kutsutaan tarkkuustestin paradoksiksi . Totesimme, että tarkkuus on oikeiden ennusteiden suhde tapausten kokonaismäärään. Meillä voi olla suhteellisen korkea tarkkuus, mutta hyödytön malli. Se tapahtuu, kun on hallitseva luokka. Jos katsot sekaannusmatriisia, näet, että suurin osa tapauksista on luokiteltu tosi negatiivisiksi. Kuvittele nyt, että malli luokitteli kaikki luokat negatiivisiksi (ts. Alle 50 kt). Sinulla olisi tarkkuus 75 prosenttia (6718/6718 + 2257). Mallisi toimii paremmin, mutta pyrkii erottamaan todellisen positiivisen todellisesta negatiivisesta.
Tällaisessa tilanteessa on suositeltavaa olla suppeampi metriikka. Voimme tarkastella:

Tarkkuus = TP / (TP + FP)
Palautus = TP / (TP + FN)

Tarkkuus vs. palautus
Tarkkuus tarkastelee positiivisen ennusteen tarkkuutta. Palautus on niiden positiivisten instanssien suhde, jotka luokittelija on havainnut oikein;
Voit rakentaa kaksi toimintoa näiden kahden mittarin laskemiseksi

Rakenna tarkkuus

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

mat [1,1]: Palauttaa datakehyksen ensimmäisen sarakkeen ensimmäisen solun eli todellisen positiivisen
matto [1,2]; Palauta datakehyksen toisen sarakkeen ensimmäinen solu, eli väärä positiivinen

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

mat [1,1]: Palauttaa datakehyksen ensimmäisen sarakkeen ensimmäisen solun eli todellisen positiivisen
matto [2,1]; Palauta datakehyksen ensimmäisen sarakkeen toinen solu, eli väärä negatiivinen

Voit testata toimintojasi
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Tuotos:
## [1] 0.712877## [2] 0.5336518
Kun malli sanoo, että se on yli 50 kt: n yksilö, se on oikea vain 54 prosentissa tapauksista, ja se voi vaatia yli 50 kt: n yksilöitä 72 prosentissa tapauksesta.
Voit luoda On harmoninen keskiarvo näistä kaksi tietoa, eli se antaa enemmän painoa pienempiä arvoja.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Tuotos:
## [1] 0.6103799 
Precision vs Recall -vaihto
On mahdotonta saada sekä tarkka tarkkuus että suuri palautus.
Jos kasvatamme tarkkuutta, oikea yksilö ennustetaan paremmin, mutta menetämme paljon niistä (alempi palautus). Joissakin tilanteissa suosimme suurempaa tarkkuutta kuin palautus. Tarkkuuden ja muistamisen välillä on kovera suhde.

Kuvittele, sinun on ennustettava, onko potilaalla sairaus. Haluat olla mahdollisimman tarkka.
Jos sinun on löydettävä kadulla potentiaaliset vilpilliset ihmiset kasvojentunnistuksen avulla, olisi parempi saada kiinni monet vilpilliseksi luokitelluista ihmisistä, vaikka tarkkuus on heikko. Poliisi voi vapauttaa vilpillisen henkilön.

ROC-käyrä
Toimintaominaiskäyrää käyrä on toinen yhteinen työkalu käyttää kaksijakoinen luokittelu. Se on hyvin samanlainen kuin tarkkuus / palautuskäyrä, mutta sen sijaan, että piirtäisi tarkkuutta vs. palautus, ROC-käyrä näyttää todellisen positiivisen määrän (ts. Palautuksen) väärän positiivisen määrän suhteen. Väärin positiivinen osuus on virheellisesti positiivisiksi luokiteltujen negatiivisten tapausten suhde. Se on yhtä kuin miinus todellinen negatiivinen osuus. Todellista negatiivista määrää kutsutaan myös spesifisyydeksi . Siksi ROC-käyrä kuvaa herkkyyttä (palautus) vs. 1-spesifisyys
ROC-käyrän piirtämiseksi meidän on asennettava kirjasto nimeltä RORC. Voimme löytää huoneistokirjastosta. Voit kirjoittaa koodin:
conda install -cr r-rocr - kyllä
Voimme piirtää ROC: n ennustus () ja suorituskyky () funktioilla.
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Koodin selitys

ennustus (ennustaa, data_test $ -tulot): ROCR-kirjaston on luotava ennustusobjekti syötetietojen muuntamiseksi
suorituskyky (ROCRpred, 'tpr', 'fpr'): Palauta kaksi yhdistelmää, jotka saadaan kaavioon. Tässä rakennetaan tpr ja fpr. Piirrä tarkkuus ja hae yhdessä, käytä "prec", "rec".

Tuotos:

Vaihe 8) Paranna mallia
Voit yrittää lisätä epälineaarisuutta malliin niiden välisen vuorovaikutuksen kanssa

ikä ja tunnit viikossa
sukupuoli ja tunnit viikossa.

Sinun on käytettävä pistetestiä verrata molempia malleja
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
Tuotos:
## [1] 0.6109181 
Pisteet ovat hieman korkeammat kuin edellinen. Voit jatkaa tietojen käsittelyä ja yrittää voittaa pisteet.

Yhteenveto
Voimme tiivistää logistisen regressioharjoittelun toiminnon seuraavassa taulukossa:
 

 
 

Paketti
 

Tavoite
 

toiminto
 

Perustelu
 

 

 

 
 

-
 

Luo juna- / testitietojoukko
 

create_train_set ()
 

tiedot, koko, juna
 

 
 

glm
 

Kouluta yleistetty lineaarinen malli
 

glm ()
 

kaava, data, perhe *
 

 
 

glm
 

Tee yhteenveto mallista
 

yhteenveto()
 

asennettu malli
 

 
 

pohja
 

Tee ennuste
 

ennustaa()
 

asennettu malli, tietojoukko, tyyppi = 'vastaus'
 

 
 

pohja
 

Luo sekaannusmatriisi
 

pöytä()
 

y, ennusta ()
 

 
 

pohja
 

Luo tarkkuuspisteet
 

summa (diag (taulukko ()) / summa (taulukko ()
 

 
 

ROCR
 

Luo ROC: Vaihe 1 Luo ennuste
 

ennustus ()
 

ennustaa (), y
 

 
 

ROCR
 

Luo ROC: Vaihe 2 Luo suorituskyky
 

esitys()
 

ennustus (), 'tpr', 'fpr'
 

 
 

ROCR
 

Luo ROC: Vaihe 3 Piirrä kaavio
 

juoni ()
 

esitys()
 

 

 

Muut GLM- mallit ovat:
- binomi: (link = "logit")
- gaussian: (link = "identiteetti")
- Gamma: (link = "käänteinen")
- käänteinen.gaussian: (link = "1 / mu 2")
- poisson: (link = "loki")
- lähes: (link = "identiteetti", varianssi = "vakio")
- quasibinomial: (link = "logit")
- quasipoisson: (link = "log")