GLM R-s: üldistatud lineaarne mudel koos näitega

Mis on logistiline regressioon?

Logistilist regressiooni kasutatakse klassi ehk tõenäosuse ennustamiseks. Logistiline regressioon võimaldab binaarset tulemust täpselt ennustada.

Kujutage ette, et soovite paljude omaduste põhjal ennustada, kas laen keeldutakse / aktsepteeritakse. Logistiline regressioon on kujul 0/1. y = 0, kui laen lükatakse tagasi, y = 1, kui see aktsepteeritakse.

Logistiline regressioonimudel erineb lineaarsest regressioonimudelist kahel viisil.

• Esiteks aktsepteerib logistiline regressioon sõltuva muutujana ainult dihhotoomset (binaarset) sisendit (st vektorit 0 ja 1).
• Teiseks mõõdetakse tulemust järgmise tõenäosusliku seose funktsiooniga, mida nimetatakse S-kujuliseks sigmoidiks :

Funktsiooni väljund on alati vahemikus 0 kuni 1. Kontrollige allolevat pilti

Sigmoidfunktsioon tagastab väärtused 0 kuni 1. Klassifitseerimisülesande jaoks vajame diskreetset väljundit 0 või 1.

Pideva voo teisendamiseks diskreetseks väärtuseks saame määrata otsuse väärtuseks 0,5. Kõik selle künnise ületavad väärtused klassifitseeritakse kui 1

Selles õpetuses saate teada

• Mis on logistiline regressioon?
• Kuidas luua üldistatud joonte mudel (GLM)
• 1. samm. Kontrollige pidevaid muutujaid
• 2. samm. Kontrollige tegurimuutujaid
• 3. samm. Funktsioonide väljatöötamine
• 4. samm. Kokkuvõtlik statistika
• 5. samm. Rong / testikomplekt
• 6. samm. Ehitage mudel
• 7. samm. Hinnake mudeli toimivust

Kuidas luua üldistatud joonte mudel (GLM)

Kasutame logistilise regressiooni illustreerimiseks täiskasvanute andmekogumit. "Täiskasvanu" on klassifitseerimisülesande jaoks suurepärane andmekogum. Eesmärk on ennustada, kas inimese aastane sissetulek dollarites ületab 50 000. Andmekogum sisaldab 46 033 vaatlust ja kümmet funktsiooni:

• vanus: üksikisiku vanus. Numbriline
• haridus: üksikisiku haridustase. Faktor.
• perekonnaseis: seisund: üksikisiku perekonnaseis. Tegur, st kunagi abielus, abielus abikaasa,…
• sugu: indiviidi sugu. Faktor, st mees või naine
• sissetulek: Sihtmuutuja. Sissetulek üle 50 000. Tegur, st> 50K, <= 50K

teiste seas

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

Väljund:

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… 

Jätkame järgmiselt:

• 1. samm: kontrollige pidevaid muutujaid
• 2. samm: kontrollige tegurimuutujaid
• 3. samm: funktsioonide väljatöötamine
• 4. samm: kokkuvõtlik statistika
• 5. samm: rong / katsekomplekt
• 6. samm: ehitage mudel üles
• 7. samm: hinnake mudeli toimivust
• 8. samm: täiustage mudelit

Teie ülesanne on ennustada, millise inimese sissetulek on suurem kui 50 000.

Selles õpetuses on iga toiming üksikasjalik, et analüüsida tegelikku andmekogumit.

1. samm. Kontrollige pidevaid muutujaid

Esimeses etapis näete pidevate muutujate jaotust.

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

Koodi selgitus

• pidev <- select_if (data_adult, is.numeric): Kasutage dplyri teegi funktsiooni select_if (), et valida ainult numbrilised veerud
• kokkuvõte (pidev): kokkuvõtliku statistika printimine

Väljund:

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

Ülaltoodud tabelist näete, et andmetel on täiesti erinevad skaalad ja tundid.per.weeksil on suured kõrvalarvud (.ie vaadake viimast kvartiili ja maksimaalset väärtust).

Sellega saate tegeleda järgmiselt:

• 1: joonestage tundide jaotus nädalas
• 2: Standardige muutujad

1. Joonesta jaotus

Vaatame lähemalt tundide jaotust nädalas

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

Väljund:

Muutujal on palju kõrvalekaldeid ja määratlemata jaotus. Selle probleemiga saate osaliselt toime tulla, kustutades nädalas töötavate tundide aja 0,01 protsenti.

Kvantiili põhisüntaks:

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.

Arvutame 2 protsendi ülemise protsentiili

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

Koodi selgitus

• kvantiil (data_adult $ hours.per.week, .99): arvutage 99 protsendi tööaja väärtus

Väljund:

## 99%## 80 

98 protsenti elanikkonnast töötab vähem kui 80 tundi nädalas.

Vaatlused saate selle künnise ületada. Kasutate dplyri teegi filtrit.

data_adult_drop <-data_adult %>%filter(hours.per.week
Väljund:


## [1] 45537 10 
 

Standardige pidevad muutujad

Toimivuse parandamiseks saate iga veeru standardiseerida, kuna teie andmetel pole sama skaalat. Dplyri teegist saate kasutada funktsiooni mutate_if. Põhisüntaks 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
Numbriveerud saate standardiseerida järgmiselt:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Koodi selgitus

mutate_if (on.numbriline, funs (skaala)): tingimus on ainult numbriline veerg ja funktsioon on skaala

Väljund:
## 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
2. samm. Kontrollige tegurimuutujaid
Sellel etapil on kaks eesmärki:

Kontrollige taset igas kategoorilises veerus
Määratlege uued tasemed

Jagame selle sammu kolmeks osaks:

Valige kategoorilised veerud
Salvestage iga veeru tulpdiagramm loendisse
Graafige graafikud

Teguriveerud saame valida alloleva koodiga:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Koodi selgitus

data.frame (select_if (data_adult, is.factor)): salvestame teguriveerud tegurina andmeraamistüüpi. Teek ggplot2 nõuab andmeraami objekti.

Väljund:
## [1] 6 
Andmekogum sisaldab 6 kategoorilist muutujat
Teine samm on osavam. Tahate joonistada andmeraamisteguri iga veeru tulpdiagrammi. Protsessi on mugavam automatiseerida, eriti olukorras, kus on palju veerge.
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)))
Koodi selgitus

lapply (): funktsiooni lapply () abil saate funktsiooni edastada kõigis andmekogumi veergudes. Salvestate väljundi loendisse
function (x): funktsiooni töödeldakse iga x korral. Siin on x veerud
ggplot (tegur, aes (get (x))) + geom_bar () + teema (axis.text.x = element_text (angle = 90)): looge iga x elemendi jaoks tulpdiagramm. Pange tähele, et x-na veeruna tagastamiseks peate selle lisama saidile get ()

Viimane samm on suhteliselt lihtne. Soovite printida 6 graafikut.
# Print the graphgraph
Väljund:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Märkus. Järgmisele graafikule liikumiseks kasutage järgmist nuppu

3. samm. Funktsioonide väljatöötamine
Hariduse uuesti sõnastamine
Ülaltoodud graafikult näete, et muutuja haridusel on 16 taset. See on märkimisväärne ja mõnel tasemel on suhteliselt vähe vaatlusi. Kui soovite parandada selle muutujaga saadava teabe hulka, saate selle uuesti sõnastada kõrgemale tasemele. Nimelt loote suuremaid sarnase haridustasemega rühmi. Näiteks muudetakse madal haridustase katkestatuks. Kõrgem haridustase muudetakse meistriks.
Siin on üksikasjad:
 

 
 

Vana tase
 

Uus tase
 

 

 

 
 

Eelkool
 

välja kukkuma
 

 
 

10.
 

Välja kukkuma
 

 
 

11.
 

Välja kukkuma
 

 
 

12
 

Välja kukkuma
 

 
 

1.-4
 

Välja kukkuma
 

 
 

5.-6
 

Välja kukkuma
 

 
 

7.-8
 

Välja kukkuma
 

 
 

9.
 

Välja kukkuma
 

 
 

HS-Grad
 

HighGrad
 

 
 

Mingi Ülikool
 

Kogukond
 

 
 

Assoc-acdm
 

Kogukond
 

 
 

Assoc-voc
 

Kogukond
 

 
 

Poissmehed
 

Poissmehed
 

 
 

Meistrid
 

Meistrid
 

 
 

Prof-kool
 

Meistrid
 

 
 

Doktorikraad
 

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")))))))
Koodi selgitus

Kasutame verbi mutate from dplyr library. Muudame hariduse väärtusi väitega ifelse

Allpool olevas tabelis koostate kokkuvõtliku statistika, et näha keskmiselt, mitu aastat haridust (z-väärtus) kulub bakalaureuse-, magistri- või doktorikraadini jõudmiseks.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Väljund:
## # 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
Uuesti sõnastatud perekonnaseis
Samuti on võimalik perekonnaseisu jaoks luua madalamaid tasemeid. Järgmises koodis muudate taset järgmiselt:
 

 
 

Vana tase
 

Uus tase
 

 

 

 
 

Ei abiellunud kunagi
 

Ei ole abielus
 

 
 

Abielus-abikaasa puudub
 

Ei ole abielus
 

 
 

Abielus-AF-abikaasa
 

Abielus
 

 
 

Abielus-civ-abikaasa
 
 

 
 

Eraldatud
 

Eraldatud
 

 
 

Lahutatud
 
 

 
 

Lesed
 

Lesk
 

 

 

 
# 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")))))
 Saate kontrollida isikute arvu igas rühmas. 
table(recast_data$marital.status)
Väljund:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
4. samm. Kokkuvõtlik statistika
On aeg kontrollida meie sihtmuutujate statistikat. Alloleval graafikul loete nende sugu protsent, kes teenivad rohkem kui 50 tuh.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Väljund:

Järgmisena kontrollige, kas isiku päritolu mõjutab tema teenimist.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Väljund:

Töötundide arv soo järgi.
# box plot gender working timeggplot(recast_data, aes(x = gender, y = hours.per.week)) +geom_boxplot() +stat_summary(fun.y = mean,geom = "point",size = 3,color = "steelblue") +theme_classic()
Väljund:

Karbi graafik kinnitab, et tööaja jaotus sobib erinevatele rühmadele. Karbijoonel pole mõlemal sugupoolel homogeenseid vaatlusi.
Nädalase tööaja tihedust saate kontrollida hariduse tüübi järgi. Jaotustel on palju erinevaid valikuid. Tõenäoliselt saab seda seletada lepingu tüübiga USA-s.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Koodi selgitus

ggplot (uuesti sõnastatud_andmed, aes (x = tundi.nädalas), tihedusdiagramm nõuab ainult ühte muutujat
geom_densness (aes (värv = haridus), alfa = 0,5): geomeetriline objekt tiheduse juhtimiseks

Väljund:

Oma mõtete kinnitamiseks võite teha ühesuunalise ANOVA testi:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Väljund:
## 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 kinnitab rühmade keskmise erinevust.
Mittelineaarsus
Enne mudeli käivitamist saate vaadata, kas töötatud tundide arv on seotud vanusega.
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()
Koodi selgitus

ggplot (uuesti sõnastatud_andmed, aes (x = vanus, y = tunnid.nädalas)): määrake graafiku esteetika
geom_point (aes (värv = sissetulek), suurus = 0,5): konstrueerige punktdiagramm
stat_smooth (): lisage trendirida järgmiste argumentidega:

method = 'lm': joonestage sobiv väärtus lineaarse regressiooni korral
valem = y ~ poly (x, 2): sobitage polünoomne regressioon
se = TRUE: lisage standardviga
aes (värv = sissetulek): murra mudel sissetuleku järgi



Väljund:

Lühidalt öeldes võite mudelis testida interaktsioonitermineid, et korjata nädala tööaja ja muude funktsioonide vahelist mittelineaarsuse efekti. Oluline on tuvastada, millistes tingimustes tööaeg erineb.
Seos
Järgmine kontroll on visualiseerida muutujate seos. Teisendate teguritaseme tüübi numbriliseks, et saaksite koostada Spearmani meetodil arvutatud korrelatsioonikordaja sisaldava soojuskaardi.
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")
Koodi selgitus

data.frame (lapply (uuesti sõnastatud_andmed, as.integer)): teisendage andmed numbriliseks
ggcorr () joonistab soojuskaardi järgmiste argumentidega:

meetod: korrelatsiooni arvutamise meetod
purunemised = 6: katkestuste arv
hjust = 0,8: muutuja nime kontrollpunkt graafikul
silt = TÕENE: lisage sildid akende keskele
label_size = 3: Suuruse sildid
color = "grey50"): sildi värv



Väljund:

5. samm. Rong / testikomplekt
Mis tahes juhendatud masinõppeülesande korral tuleb andmed jagada rongikomplekti ja testikomplekti vahel. Rongi / testikomplekti loomiseks võite kasutada teistes juhendatud õppeõpetustes loodud funktsiooni.
set.seed(1234)create_train_test <- function(data, size = 0.8, train = TRUE) {n_row = nrow(data)total_row = size * n_rowtrain_sample <- 1: total_rowif (train == TRUE) {return (data[train_sample, ])} else {return (data[-train_sample, ])}}data_train <- create_train_test(recast_data, 0.8, train = TRUE)data_test <- create_train_test(recast_data, 0.8, train = FALSE)dim(data_train)
Väljund:
## [1] 36429 9
 
dim(data_test)
Väljund:
## [1] 9108 9 
6. samm. Ehitage mudel
Algoritmi toimimise nägemiseks kasutage paketti glm (). Üldise lineaarse mudeli on kogumik mudelid. Põhisüntaks 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")
Olete valmis hindama logistilist mudelit, et jaotada sissetuleku tase funktsioonide vahel.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Koodi selgitus

valem <- sissetulek ~.: Loo mudel sobivaks
logit <- glm (valem, data = data_train, family = 'binomial'): sobitage logistiline mudel (family = 'binomial') andmetega data_train.
kokkuvõte (logit): printige mudeli kokkuvõte

Väljund:
#### 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
Meie mudeli kokkuvõte näitab huvitavat teavet. Logistilise regressiooni toimivust hinnatakse konkreetsete võtmemõõdikutega.

AIC (Akaike infokriteeriumid): logistilise regressiooni korral vastab see R2- le. See mõõdab sobivust, kui parameetrite arvule rakendatakse karistust. Väiksemad AIC väärtused näitavad, et mudel on tõele lähemal.
Nullhälve: sobib mudelile ainult ristmikuga. Vabadusaste on n-1. Saame seda tõlgendada kui Chi-ruutväärtust (sobitatud väärtus erineb tegeliku väärtuse hüpoteesi testimisest).
Jääkhälve: mudel koos kõigi muutujatega. Seda tõlgendatakse ka kui Chi-ruudu hüpoteesi testimist.
Fisheri skoorimiste korduste arv: korduste arv enne koondumist.

Funktsiooni glm () väljund salvestatakse loendisse. Allolev kood näitab kõiki logitilise muutuja olemasolevaid elemente, mille me logistilise regressiooni hindamiseks konstrueerisime.
# Nimekiri on väga pikk, printige ainult kolm esimest elementi
lapply(logit, class)[1:3]
Väljund:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Iga väärtuse saab eraldada märkega $, millele järgneb mõõdikute nimi. Näiteks salvestasite mudeli logitina. AIC-kriteeriumide väljavõtmiseks kasutate järgmist.
logit$aic
Väljund:
## [1] 27086.65
7. samm. Hinnake mudeli toimivust
Segaduse maatriks
Segadust maatriks on parem valik, et hinnata klassifitseerimise tulemuste võrreldes erinevaid mõõdikuid nägid enne. Üldine idee on lugeda, mitu korda tõelised eksemplarid on valed klassifitseeritud.

Segadusmaatriksi arvutamiseks peab kõigepealt olema komplekt ennustusi, et neid saaks tegelike sihtmärkidega võrrelda.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Koodi selgitus

ennustama (logit, data_test, type = 'response'): arvutage testikomplekti prognoos. Vastuse tõenäosuse arvutamiseks määrake tüüp = 'response'.
tabel (data_test $ sissetulek, ennustamine> 0,5): arvutage segiajamise maatriks. ennustada> 0,5 tähendab, et see tagastab 1, kui ennustatud tõenäosus on suurem kui 0,5, muidu 0.

Väljund:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Segiajamise maatriksi iga rida tähistab tegelikku sihtmärki, samas kui iga veerg tähistab ennustatud sihtmärki. Selle maatriksi esimeses reas peetakse sissetulekut alla 50k (valeklass): 6241 liigitati õigesti isikuteks, kelle sissetulek oli väiksem kui 50k ( tõeline negatiivne ), ülejäänud aga valesti liigitati üle 50k ( valepositiivne ). Teises reas arvestatakse sissetulekuga üle 50 000, positiivse klassi moodustasid 1229 ( tõeliselt positiivsed ), samas kui tõelised negatiivsed olid 1074.
Mudeli täpsuse saate arvutada , summeerides tõelise positiivse + tõelise negatiivse kogu vaatlusel

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

summa (diag (tabeli_mat)): diagonaali summa
summa (tabeli_mat): maatriksi summa.

Väljund:
## [1] 0.8277339 
Näib, et mudel kannab ühte probleemi, see hindab valenegatiivide arvu üle. Seda nimetatakse täpsustesti paradoksiks . Nentisime, et täpsus on õigete ennustuste ja juhtumite koguarvu suhe. Meil võib olla suhteliselt kõrge täpsus, kuid kasutu mudel. See juhtub siis, kui on domineeriv klass. Segadusmaatriksile tagasi vaadates näete, et enamik juhtumeid on klassifitseeritud tõeliselt negatiivseteks. Kujutage nüüd ette, et mudel klassifitseeris kõik klassid negatiivseteks (st alla 50 k). Teie täpsus oleks 75 protsenti (6718/6718 + 2257). Teie mudel töötab paremini, kuid püüab tõelise positiivse ja tõelise negatiivse vahel eristada.
Sellises olukorras on eelistatav kasutada täpsemat mõõdikut. Saame vaadata:

Täpsus = TP / (TP + FP)
Tagasikutsumine = TP / (TP + FN)

Täpsus vs tagasikutsumine
Täpsus vaatab positiivse ennustuse täpsust. Tagasikutsumine on klassifikaatori õigesti tuvastatud positiivsete juhtumite suhe;
Nende kahe mõõdiku arvutamiseks võite koostada kaks funktsiooni

Konstrueerige täpsus

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

mat [1,1]: tagastab andmeraami esimese veeru esimese lahtri, st tõelise positiivse
matt [1,2]; Tagastab andmeraami teise veeru esimese lahtri ehk valepositiivse

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

mat [1,1]: tagastab andmeraami esimese veeru esimese lahtri, st tõelise positiivse
matt [2,1]; Tagastab andmeraami esimese veeru teise lahtri ehk valenegatiivi

Saate oma funktsioone testida
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Väljund:
## [1] 0.712877## [2] 0.5336518
Kui mudel ütleb, et tegemist on üle 50 k kaaluva isikuga, on see õige vaid 54 protsendil juhtudest ja 72 protsendil juhtudest võib see nõuda üle 50 k üksikisikuid.
Punkti saate luua On harmoonilise keskmisena need kaks mõõdikut, mis tähendab, see annab rohkem kaalu madalamad väärtused.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Väljund:
## [1] 0.6103799 
Täpsus vs tagasikutsumise kompromiss
On võimatu saada nii suurt täpsust kui ka suurt tagasikutsumist.
Kui suurendame täpsust, ennustatakse õiget inimest paremini, kuid me jätaksime paljud neist ilma (madalam tagasikutsumine). Mõnes olukorras eelistame suuremat täpsust kui tagasikutsumist. Täpsuse ja tagasikutsumise vahel on nõgus seos.

Kujutage ette, peate ennustama, kas patsiendil on mõni haigus. Sa tahad olla võimalikult täpne.
Kui peate näotuvastuse abil tänaval avastama potentsiaalsed petturid, oleks parem tabada paljud pettuseks märgistatud inimesed, kuigi täpsus on madal. Politseil on võimalik pettuseta isik vabastada.

ROC kõver
Saaja töökarakteristikut kõver on teine levinum vahend koos kaksikliigitus. See on väga sarnane täpsuse / tagasikutsumise kõveraga, kuid täpsuse ja tagasikutsumise joonistamise asemel näitab ROC-kõver tõelist positiivset määra (st tagasikutsumist) valepositiivse määra suhtes. Valepositiivne määr on valesti positiivseks liigitatud negatiivsete juhtumite suhe. See on võrdne ühe miinus tegeliku negatiivse määraga. Tõelist negatiivset määra nimetatakse ka spetsiifilisuseks . Seega joonistab ROC kõver tundlikkuse (tagasikutsumise) versus 1 spetsiifilisuse
ROC-kõvera joonistamiseks peame installima teegi nimega RORC. Leiame konda raamatukogust. Võite sisestada koodi:
conda install -cr r-rocr - jah
ROC saab koostada prognoosimise () ja jõudluse () funktsioonidega.
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Koodi selgitus

ennustus (ennustada, data_test $ sissetulek): ROCR-i teek peab sisendandmete teisendamiseks looma ennustusobjekti
jõudlus (ROCRpred, 'tpr', 'fpr'): tagastage graafikus esitatavad kaks kombinatsiooni. Siin konstrueeritakse tpr ja fpr. Tot joonista täpsus kokku ja tuletage koos meelde, kasutage "prec", "rec".

Väljund:

8. samm. Parandage mudelit
Võite proovida lisada mudelile mittelineaarsust koosmõjuga

vanus ja tunnid.nädalas
sugu ja kellaajad nädalas.

Mõlema mudeli võrdlemiseks peate kasutama punktisumma testi
formula_2 <- income~age: hours.per.week + gender: hours.per.week + .logit_2 <- glm(formula_2, data = data_train, family = 'binomial')predict_2 <- predict(logit_2, data_test, type = 'response')table_mat_2 <- table(data_test$income, predict_2 > 0.5)precision_2 <- precision(table_mat_2)recall_2 <- recall(table_mat_2)f1_2 <- 2 * ((precision_2 * recall_2) / (precision_2 + recall_2))f1_2
Väljund:
## [1] 0.6109181 
Hind on eelmisest veidi kõrgem. Võite jätkata andmetega töötamist ja proovida skoori ületada.

Kokkuvõte
Logistilise regressiooni treenimise funktsiooni võime kokku võtta allolevas tabelis:
 

 
 

Pakett
 

Eesmärk
 

funktsioon
 

argument
 

 

 

 
 

-
 

Looge rongi / testi andmekogum
 

create_train_set ()
 

andmed, suurus, rong
 

 
 

glm
 

Treenige üldistatud lineaarset mudelit
 

glm ()
 

valem, andmed, perekond *
 

 
 

glm
 

Võtke mudel kokku
 

kokkuvõte ()
 

varustatud mudel
 

 
 

alus
 

Tehke ennustusi
 

ennustama ()
 

sobitatud mudel, andmekogum, type = 'response'
 

 
 

alus
 

Looge segiajamise maatriks
 

tabel ()
 

y, ennusta ()
 

 
 

alus
 

Looge täpsuse skoor
 

summa (diag (tabel ()) / summa (tabel ()
 

 
 

ROCR
 

ROC-i loomine: 1. samm ennustuse loomine
 

ennustus ()
 

ennustama (), y
 

 
 

ROCR
 

ROC-i loomine: 2. samm - toimivuse loomine
 

jõudlus ()
 

ennustus (), 'tpr', 'fpr'
 

 
 

ROCR
 

ROC-i loomine: 3. samm Graafiku joonistamine
 

süžee()
 

jõudlus ()
 

 

 

Muud GLM- tüüpi mudelid on:
- binoom: (link = "logit")
- gaussian: (link = "identiteet")
- gamma: (link = "tagurpidi")
- inverse.gaussian: (link = "1 / mu 2")
- poisson: (link = "log")
- kvaasi: (link = "identiteet", dispersioon = "konstant")
- kvasibinoom: (link = "logit")
- quasipoisson: (link = "log")