GLM in R: Yleistetty lineaarinen malli esimerkin kanssa

Mikä on logistinen regressio?

Logistista regressiota käytetään ennustamaan luokkaa eli todennäköisyyttä. Logistinen regressio voi ennustaa binäärituloksen tarkasti.

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

Logistinen regressiomalli eroaa lineaarisesta regressiomallista kahdella tavalla.

Ensinnäkin logistinen regressio hyväksyy vain dikotomisen (binäärisyötteen) riippuvaiseksi muuttujaksi (eli vektorin 0 ja 1).
Toiseksi lopputulos mitataan seuraavalla todennäköisyyspohjaisella linkkifunktiolla nimeltään sigmoidi S-muotonsa ansiosta:

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

Sigmoidifunktio palauttaa arvot välillä 0–1. Luokittelutehtävää varten tarvitsemme erillisen tulosteen 0 tai 1.

Jatkuvan virtauksen muuttamiseksi diskreetiksi arvoksi voimme asettaa päätösrajaksi 0.5. Kaikki tämän kynnyksen ylittävät arvot luokitellaan 1:ksi

Generalized Liner Model (GLM) luominen

Käytetään aikuinen tietojoukko logistisen regression havainnollistamiseksi. "Aikuinen" on loistava tietojoukko luokitustehtävää varten. Tavoitteena on ennustaa, ylittääkö henkilön vuositulo dollareina 50.000 46,033. Aineisto sisältää XNUMX XNUMX havaintoa ja kymmenen ominaisuutta:

ikä: henkilön ikä. Numeerinen
koulutus: Yksilön koulutustaso. Tekijä.
siviilisääty: Marihenkilön asemasta. Factor eli ei koskaan naimisissa, Naimisissa-siviili-puoliso,…
sukupuoli: yksilön sukupuoli. Tekijä, eli mies tai nainen
tulo: Target muuttuja. Tulot yli tai alle 50 50. Kerroin eli >50K, <=XNUMXK

muiden joukossa

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

lähtö:

Observations: 48,842
Variables: 10
$ x               <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,...
$ age             <int> 25, 38, 28, 44, 18, 34, 29, 63, 24, 55, 65, 36, 26...
$ workclass       <fctr> Private, Private, Local-gov, Private, ?, Private,...
$ education       <fctr> 11th, HS-grad, Assoc-acdm, Some-college, Some-col...
$ educational.num <int> 7, 9, 12, 10, 10, 6, 9, 15, 10, 4, 9, 13, 9, 9, 9,...
$ marital.status  <fctr> Never-married, Married-civ-spouse, Married-civ-sp...
$ race            <fctr> Black, White, White, Black, White, White, Black, ...
$ gender          <fctr> Male, Male, Male, Male, Female, Male, Male, Male,...
$ hours.per.week  <int> 40, 50, 40, 40, 30, 30, 40, 32, 40, 10, 40, 40, 39...
$ income          <fctr> <=50K, <=50K, >50K, >50K, <=50K, <=50K, <=50K, >5...

Jatketaan seuraavasti:

Vaihe 1: Tarkista jatkuvat muuttujat
Vaihe 2: Tarkista tekijämuuttujat
Vaihe 3: Ominaisuussuunnittelu
Vaihe 4: Yhteenvetotilasto
Vaihe 5: Harjoittelu/testisarja
Vaihe 6: Rakenna malli
Vaihe 7: Arvioi mallin suorituskyky
Vaihe 8: Paranna mallia

Sinun tehtäväsi on ennustaa, kenen tulot ovat yli 50 XNUMX.

Tässä opetusohjelmassa jokainen vaihe on kuvattu yksityiskohtaisesti todellisen tietojoukon analysoimiseksi.

Vaihe 1) Tarkista jatkuvat muuttujat

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

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

Code Selitys

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

lähtö:

##        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.viikkoa kohden on suuria poikkeavuuksia (.eli katso viimeistä kvartiilia ja maksimiarvoa).

Voit käsitellä sen seuraavasti:

1: Piirrä tuntien.per.viikkojakauma
2: Standardoi jatkuvat muuttujat

Piirrä jakelu

Katsotaanpa tarkemmin tuntien.per.viikko-jakaumaa

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

lähtö:

Muuttujalla on paljon poikkeavuuksia eikä tarkka jakautuminen. Voit ratkaista tämän ongelman osittain poistamalla ylimmät 0.01 prosenttia viikon tunneista.

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

Code Selitys

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

lähtö:

## 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 suodatinta dplyr kirjasto.

data_adult_drop <-data_adult %>%
filter(hours.per.week<top_one_percent)
dim(data_adult_drop)

lähtö:

## [1] 45537    10

Standardoi jatkuvat muuttujat

Voit standardoida jokaisen sarakkeen tehokkuuden parantamiseksi, koska tiedoillasi ei ole samaa mittakaavaa. 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)

Code Selitys

mutate_if(is.numeric, funs(scale)): Ehto on vain numeerinen sarake ja funktio on skaala

lähtö:

##           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 taso kussakin kategoriassa sarakkeessa
Määrittele uusia tasoja

Jaamme tämän vaiheen kolmeen osaan:

Valitse kategorialliset sarakkeet
Tallenna kunkin sarakkeen pylväskaavio luetteloon
Tulosta kaaviot

Voimme valita tekijäsarakkeet alla olevalla koodilla:

# Select categorical column
factor <- data.frame(select_if(data_adult_rescale, is.factor))
	ncol(factor)

Code Selitys

data.frame(select_if(data_adult, is.factor)): Tallennamme tekijäsarakkeet kertoimena tietokehystyyppiin. Kirjasto ggplot2 vaatii tietokehysobjektin.

lähtö:

## [1] 6

Tietojoukko sisältää 6 kategorista muuttujaa

Toinen vaihe on taitavampi. Haluat piirtää pylväskaavion jokaiselle datakehystekijän sarakkeelle. Prosessi on kätevämpää automatisoida, varsinkin jos sarakkeita on paljon.

library(ggplot2)
# Create graph for each column
graph <- lapply(names(factor),
    function(x) 
	ggplot(factor, aes(get(x))) +
		geom_bar() +
		theme(axis.text.x = element_text(angle = 90)))

Code Selitys

lapply(): Käytä funktiota lapply() välittääksesi funktion kaikissa tietojoukon sarakkeissa. Tallennat tulosteen luetteloon
function(x): Funktio käsitellään jokaiselle x:lle. Tässä x on sarakkeet
ggplot(tekijä, aes(get(x))) + geom_bar()+ teema(akseli.teksti.x = elementin_teksti(kulma = 90)): Luo pylväsmerkkikaavio jokaiselle x-elementille. Huomaa, että jos haluat palauttaa x:n sarakkeena, sinun on sisällytettävä se get()

Viimeinen vaihe on suhteellisen helppo. Haluat tulostaa 6 kuvaajaa.

# Print the graph
graph

lähtö:

## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Huomautus: Käytä seuraava-painiketta siirtyäksesi seuraavaan kaavioon

Vaihe 3) Ominaisuussuunnittelu

Uudelleenlaadittu koulutus

Yllä olevasta kaaviosta näet, että muuttuvassa koulutuksessa on 16 tasoa. Tämä on merkittävää, ja joillakin tasoilla on suhteellisen vähän havaintoja. Jos haluat parantaa tästä muuttujasta saatavan tiedon määrää, voit muotoilla sen uudelleen korkeammalle tasolle. Nimittäin luot suurempia ryhmiä, joilla on samanlainen koulutustaso. Esimerkiksi alhainen koulutus muuttuu keskeyttäneiksi. Korkeammat koulutustasot muutetaan mestariksi.

Tässä on yksityiskohta:

Vanha taso	Uusi taso
Esikoulu	lopettaa
10.	Lopettaa
11.	Lopettaa
12.	Lopettaa
1.-4	Lopettaa
5th-6th	Lopettaa
7th-8th	Lopettaa
9.	Lopettaa
HS-Grad	HighGrad
Joku yliopisto	yhteisö
Assoc-acdm	yhteisö
Assoc-voc	yhteisö
Alempi	Alempi
Masters	Masters
Professorikoulu	Masters
Tohtorinarvo	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")))))))

Code Selitys

Käytämme verbiä mutate dplyr-kirjastosta. Muutamme koulutuksen arvoja lauseella ifelse

Alla olevaan taulukkoon luot yhteenvetotilaston, josta näet, kuinka monta vuotta koulutusta (z-arvo) keskimäärin kestää kandidaatin, maisterin tai tohtorin tutkinnon saavuttamiseen.

recast_data % > %
	group_by(education) % > %
	summarize(average_educ_year = mean(educational.num),
		count = n()) % > %
	arrange(average_educ_year)

lähtö:

## # A tibble: 6 x 3
## education average_educ_year count			
##      <fctr>             <dbl> <int>
## 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

uudelleenlaaditun Marital-status

On myös mahdollista luoda alempia tasoja siviilisäätyä varten. Seuraavassa koodissa muutat tasoa seuraavasti:

Vanha taso	Uusi taso
Ei koskaan naimisissa	Ei naimisissa
Aviopuoliso-poissa	Ei naimisissa
Naimisissa-AF-puoliso	Naimisissa
Naimisissa oleva puoliso
Asumuserossa	Asumuserossa
Eronnut
Widows	Leski

# Change level marry
recast_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 kunkin ryhmän yksilöiden lukumäärän.

table(recast_data$marital.status)

lähtö:

## ##     Married Not_married   Separated       Widow
##       21165       15359        7727        1286

Vaihe 4) Yhteenvetotilasto

On aika tarkistaa tilastotietoja tavoitemuuttujistamme. Alla olevassa kaaviossa lasket niiden henkilöiden prosenttiosuuden, jotka ansaitsevat yli 50 XNUMX sukupuolensa perusteella.

# Plot gender income
ggplot(recast_data, aes(x = gender, fill = income)) +
    geom_bar(position = "fill") +
    theme_classic()

lähtö:

Tarkista seuraavaksi, vaikuttaako henkilön alkuperä hänen tuloihinsa.

# Plot origin income
ggplot(recast_data, aes(x = race, fill = income)) +
    geom_bar(position = "fill") +
    theme_classic() +
    theme(axis.text.x = element_text(angle = 90))

lähtö:

Työtuntien määrä sukupuolen mukaan.

# box plot gender working time
ggplot(recast_data, aes(x = gender, y = hours.per.week)) +
    geom_boxplot() +
    stat_summary(fun.y = mean,
        geom = "point",
        size = 3,
        color = "steelblue") +
    theme_classic()

lähtö:

Laatikkokaavio vahvistaa, että työajanjako sopii eri ryhmiin. Laatikkokaaviossa molemmilla sukupuolilla ei ole homogeenisiä havaintoja.

Voit tarkistaa viikoittaisen työajan tiheyden koulutustyypin mukaan. Jakaumissa on useita erillisiä valintoja. Se voidaan luultavasti selittää koulutustyypin mukaan.tract Yhdysvalloissa.

# Plot distribution working time by education
ggplot(recast_data, aes(x = hours.per.week)) +
    geom_density(aes(color = education), alpha = 0.5) +
    theme_classic()

Code Selitys

ggplot(recast_data, aes(x= tuntia.per.viikko)): Tiheyskaavio vaatii vain yhden muuttujan
geom_density(aes(väri = koulutus), alfa =0.5): geometrinen objekti tiheyden ohjaamiseen

lähtö:

Vahvistaaksesi ajatuksesi voit suorittaa yksisuuntaisen ANOVA testi:

anova <- aov(hours.per.week~education, recast_data)
summary(anova)

lähtö:

##                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 välisen keskiarvon eron.

Ei-lineaarisuus

Ennen kuin suoritat mallin, voit nähdä, liittyykö työ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()

Code Selitys

ggplot(recast_data, aes(x = ikä, y = tuntia.per.viikko)): Aseta kaavion estetiikka
geom_point(aes(väri=tulo), koko =0.5): Muodosta pistekaavio
stat_smooth(): Lisää trendiviiva seuraavilla argumenteilla:
- method='lm': Piirrä sovitettu arvo, jos lineaarinen regressio
- kaava = y~poly(x,2): Sovita polynomiregressio
- se = TOSI: Lisää vakiovirhe
- aes(väri=tulot): Jaa malli tulojen mukaan

lähtö:

Lyhyesti sanottuna, voit testata vuorovaikutustermejä mallissa saadaksesi selville viikoittaisen työajan ja muiden ominaisuuksien epälineaarisuuden vaikutuksen. On tärkeää havaita, missä olosuhteissa työaika vaihtelee.

Korrelaatio

Seuraava tarkistus on visualisoida muuttujien välinen korrelaatio. Muunnat tekijätason tyypin numeeriseksi, jotta voit piirtää lämpökartan, joka sisältää Spearman-menetelmällä lasketun korrelaatiokertoimen.

library(GGally)
# Convert data to numeric
corr <- 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")

Code Selitys

data.frame(lapply(recast_data,as.integer)): Muunna tiedot numeerisiksi
ggcorr() piirtää lämpökartan seuraavilla argumenteilla:
- method: Menetelmä korrelaation laskemiseksi
- nbreaks = 6: Taukojen lukumäärä
- hjust = 0.8: Säätää muuttujan nimen sijaintia kaaviossa
- etiketti = TOSI: Lisää tunnisteet ikkunoiden keskelle
- label_size = 3: Kokotarrat
- väri = "grey50"): Tarran väri

lähtö:

Vaihe 5) Harjoittelu/testisarja

Kaikki valvotut koneoppiminen tehtävä edellyttää tietojen jakamista junajoukon ja testijoukon välillä. Voit käyttää muissa ohjatuissa opetusohjelmissa luomaasi "toimintoa" harjoitus-/testisarjan luomiseen.

set.seed(1234)
create_train_test <- function(data, size = 0.8, train = TRUE) {
    n_row = nrow(data)
    total_row = size * n_row
    train_sample <- 1: total_row
    if (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)

lähtö:

## [1] 36429     9

dim(data_test)

lähtö:

## [1] 9108    9

Vaihe 6) Rakenna malli

Jos haluat nähdä, kuinka algoritmi toimii, käytä glm()-pakettia. The 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 tulotason jakamiseksi eri ominaisuuksien kesken.

formula <- income~.
logit <- glm(formula, data = data_train, family = 'binomial')
summary(logit)

Code Selitys

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

lähtö:

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

Mallimme yhteenveto paljastaa mielenkiintoisia tietoja. Logistisen regression suorituskykyä arvioidaan tietyillä keskeisillä mittareilla.

AIC (Akaike Information Criteria): Tämä vastaa R2 logistisessa regressiossa. Se mittaa sovituksen, kun parametrien määrään sovelletaan rangaistusta. Pienempi AIC arvot osoittavat, että malli on lähempänä totuutta.
Nollapoikkeama: Sopii malliin vain leikkauspisteen kanssa. Vapausaste on n-1. Voimme tulkita sen Chi-neliöarvona (sovitettu arvo, joka eroaa todellisen arvon hypoteesin testauksesta).
Jäännöspoikkeama: Malli kaikilla muuttujilla. Se tulkitaan myös khin neliön hypoteesin testaamiseksi.
Fisher Scoring iteraatioiden määrä: Iteraatioiden määrä ennen konvergoimista.

Glm()-funktion tulos tallennetaan luetteloon. Alla oleva koodi näyttää kaikki saatavilla olevat kohteet logit-muuttujassa, jonka rakensimme arvioimaan logistista regressiota.

# Lista on erittäin pitkä, tulosta vain kolme ensimmäistä elementtiä

lapply(logit, class)[1:3]

lähtö:

## $coefficients
## [1] "numeric"
## 
## $residuals
## [1] "numeric"
## 
## $fitted.values
## [1] "numeric"

Jokainen arvo voi olla esim.tracja lisää $-merkki ja sen perään mittareiden nimet. Esimerkiksi tallensit mallin nimellä logit. Esim.tracAIC-kriteereissä käytät:

logit$aic

lähtö:

## [1] 27086.65

Vaihe 7) Arvioi mallin suorituskyky

Sekaannusmatriisi

sekaannusmatriisi on parempi valinta arvioida luokituksen tehokkuutta verrattuna eri mittareihin, jotka olet nähnyt aiemmin. 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 tavoitteisiin.

predict <- predict(logit, data_test, type = 'response')
# confusion matrix
table_mat <- table(data_test$income, predict > 0.5)
table_mat

Code Selitys

ennustaa(logit,data_testi, tyyppi = 'response'): Laske testijoukon ennuste. Aseta tyyppi = 'response' vastauksen todennäköisyyden laskemiseksi.
table(data_test$income, ennustaa > 0.5): Laske sekaannusmatriisi. ennustaa > 0.5 tarkoittaa, että se palauttaa 1, jos ennustetut todennäköisyydet ovat yli 0.5, muuten 0.

lähtö:

##        
##         FALSE TRUE
##   <=50K  6310  495
##   >50K   1074 1229

Jokainen sekoitusmatriisin rivi edustaa todellista kohdetta, kun taas jokainen sarake edustaa ennustettua kohdetta. Tämän matriisin ensimmäisellä rivillä tarkastellaan alle 50 6241 tuloja (väärä luokka): 50 XNUMX luokiteltiin oikein henkilöiksi, joiden tulot ovat alle XNUMX XNUMX (Tosi negatiivinen), kun taas loput luokiteltiin väärin yli 50 XNUMX (Väärä positiivinen). Toisella rivillä on yli 50 tk tulot, positiivinen luokka oli 1229 (Tosi positiivista), samalla kun Tosi negatiivinen oli 1074.

Voit laskea mallin tarkkuus summaamalla todellinen positiivinen + todellinen negatiivinen kokonaishavainto

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

Code Selitys

summa(diag(taulukko_matto)): Diagonaalin summa
sum(table_mat): Matriisin summa.

lähtö:

## [1] 0.8277339

Malli näyttää kärsivän yhdestä ongelmasta, se yliarvioi väärien negatiivien määrän. Tätä kutsutaan tarkkuustestin paradoksi. 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 taaksepäin hämmennysmatriisia, voit nähdä, että useimmat tapaukset luokitellaan todellisiksi negatiivisiksi. Kuvittele nyt, että malli luokitteli kaikki luokat negatiivisiksi (eli alle 50k). Sinulla olisi 75 prosentin tarkkuus (6718/6718+2257). Mallisi toimii paremmin, mutta sen on vaikea erottaa todellista positiivista todellisesta negatiivisesta.

Tällaisessa tilanteessa on parempi käyttää tiiviimpää mittaria. Voimme katsoa:

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

Tarkkuus vs muistaminen

Tarkkuus tarkastelee positiivisen ennusteen tarkkuutta. Palauttaa mieleen on positiivisten tapausten suhde, jotka luokittelija havaitsee oikein;

Voit rakentaa kaksi funktiota näiden kahden metriikan laskemiseksi

Rakenna tarkkuus

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

Code Selitys

mat[1,1]: Palauta tietokehyksen ensimmäisen sarakkeen ensimmäinen solu eli tosipositiivinen
matto[1,2]; Palauta tietokehyksen toisen sarakkeen ensimmäinen solu eli väärä positiivinen

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

Code Selitys

mat[1,1]: Palauta tietokehyksen ensimmäisen sarakkeen ensimmäinen solu eli tosipositiivinen
matto[2,1]; Palauta tietokehyksen ensimmäisen sarakkeen toinen solu eli väärä negatiivinen

Voit testata toimintojasi

prec <- precision(table_mat)
prec
rec <- recall(table_mat)
rec

lähtö:

## [1] 0.712877
## [2] 0.5336518

Kun malli sanoo, että kyseessä on yli 50 54 pitkä henkilö, se pitää paikkansa vain 50 prosentissa tapauksista, ja se voi vaatia yli 72 XNUMX henkilöitä XNUMX prosentissa tapauksista.

Voit luoda pisteet tarkkuuden ja muistamisen perusteella. The on näiden kahden mittarin harmoninen keskiarvo, mikä tarkoittaa, että se antaa enemmän painoa alemmille arvoille.

f1 <- 2 * ((prec * rec) / (prec + rec))
f1

lähtö:

## [1] 0.6103799

Precision vs Recall kompromissi

On mahdotonta saavuttaa sekä suurta tarkkuutta että korkeaa muistia.

Jos lisäämme tarkkuutta, oikea yksilö ennustetaan paremmin, mutta monet niistä jäävät paitsi (alempi muistaminen). Joissakin tilanteissa suosittelemme suurempaa tarkkuutta kuin muistamista. Tarkkuuden ja muistamisen välillä on kovera suhde.

Kuvittele, sinun täytyy ennustaa, onko potilaalla sairaus. Haluat olla mahdollisimman tarkka.
Jos haluat havaita mahdolliset petolliset ihmiset kadulla kasvojentunnistuksen avulla, olisi parempi saada kiinni monet petollisiksi leimatut ihmiset, vaikka tarkkuus on alhainen. Poliisi voi vapauttaa petollisen henkilön.

ROC-käyrä

Vastaanotin Operating Ominaisuus käyrä on toinen yleinen työkalu, jota käytetään binääriluokituksessa. Se on hyvin samankaltainen kuin tarkkuus/palautuskäyrä, mutta sen sijaan, että piirrettäisiin tarkkuus vs. muistaminen, ROC-käyrä näyttää todellisen positiivisen määrän (eli palauttamisen) väärän positiivisen nopeuden suhteen. Väärien positiivisten tapausten osuus on virheellisesti positiivisiksi luokiteltujen negatiivisten tapausten suhde. Se on yhtä suuri kuin yksi miinus todellinen negatiivinen korko. Todellista negatiivista korkoa kutsutaan myös erityispiirteet. Tästä syystä ROC-käyrä piirretään herkkyys (muistuta) vs. 1-spesifisyys

ROC-käyrän piirtämiseksi meidän on asennettava kirjasto nimeltä RORC. Voimme löytää condasta kirjasto. Voit kirjoittaa koodin:

conda install -cr r-rocr –kyllä

Voimme piirtää ROC:n ennuste()- ja performance()-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))

Code Selitys

ennuste(ennustus, data_testi$tulo): ROCR-kirjaston on luotava ennusteobjekti syöttötietojen muuttamiseksi
suorituskyky (ROCRpred, 'tpr', 'fpr'): Palauta kaksi yhdistelmää, jotka tuotetaan kaaviossa. Tässä konstruoidaan tpr ja fpr. Tot piirrä tarkkuus ja muista yhdessä, käytä "pre", "rec".

lähtö:

Vaihe 8) Paranna mallia

Voit yrittää lisätä malliin epälineaarisuutta vuorovaikutuksella

ikä ja tunnit viikossa
sukupuoli ja tunnit.per.viikko.

Sinun on käytettävä pistetestiä molempien mallien vertailuun

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

lähtö:

## [1] 0.6109181

Pisteet ovat hieman korkeammat kuin edellinen. Voit jatkaa tietojen käsittelyä ja yrittää voittaa pisteet.

Yhteenveto

Voimme tiivistää funktion, jolla harjoitetaan logistista regressiota alla olevaan taulukkoon:

Paketti	Tavoite	Toiminto	Perustelu
-	Luo juna-/testitietojoukko	create_train_set()	tiedot, koko, juna
glm	Harjoittele yleistetty lineaarinen malli	glm()	kaava, data, perhe*
glm	Tee yhteenveto mallista	yhteenveto()	asennettu malli
pohja	Tee ennustus	ennustaa()	sovitettu malli, tietojoukko, tyyppi = 'vastaus'
pohja	Luo hämmennysmatriisi	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()	ennuste(), 'tpr', 'fpr'
ROCR	Luo ROC: Vaihe 3 Piirrä kaavio	juoni ()	esitys()

Muut GLM mallityypit ovat:

– binomi: (linkki = "logit")

– gaussian: (linkki = "identiteetti")

– Gamma: (linkki = "käänteinen")

– käänteinen.gaussian: (linkki = "1/mu^2")

– poisson: (linkki = "loki")

– kvasi: (linkki = "identiteetti", varianssi = "vakio")

– kvasibinomi: (linkki = "logit")

– quasipoisson: (linkki = "loki")

GLM in R: Yleistetty lineaarinen malli esimerkin kanssa

Mikä on logistinen regressio?

Generalized Liner Model (GLM) luominen

Vaihe 1) Tarkista jatkuvat muuttujat

Vaihe 2) Tarkista tekijämuuttujat

Vaihe 3) Ominaisuussuunnittelu

Uudelleenlaadittu koulutus

uudelleenlaaditun Marital-status

Vaihe 4) Yhteenvetotilasto

Ei-lineaarisuus

Korrelaatio

Vaihe 5) Harjoittelu/testisarja

Vaihe 6) Rakenna malli

Vaihe 7) Arvioi mallin suorituskyky

Sekaannusmatriisi

Tarkkuus vs muistaminen

Precision vs Recall kompromissi

ROC-käyrä

Yhteenveto

Tiivistä tämä viesti seuraavasti:

Tilaa uutiskirje

Mikä on logistinen regressio?

Generalized Liner Model (GLM) luominen

Vaihe 1) Tarkista jatkuvat muuttujat

AIHEESEEN LIITTYVÄT ARTIKKELIT

Vaihe 2) Tarkista tekijämuuttujat

Vaihe 3) Ominaisuussuunnittelu

Uudelleenlaadittu koulutus

uudelleenlaaditun Marital-status

Vaihe 4) Yhteenvetotilasto

Ei-lineaarisuus

Korrelaatio

Vaihe 5) Harjoittelu/testisarja

Vaihe 6) Rakenna malli

Vaihe 7) Arvioi mallin suorituskyky

Sekaannusmatriisi

Tarkkuus vs muistaminen

Precision vs Recall kompromissi

ROC-käyrä

Yhteenveto

Tiivistä tämä viesti seuraavasti:

Tilaa uutiskirje