GLM R: apibendrintas tiesinis modelis su pavyzdžiu

Kas yra logistinė regresija?

Logistinė regresija naudojama nuspėti klasę, ty tikimybę. Logistinė regresija gali tiksliai numatyti dvejetainį rezultatą.

Įsivaizduokite, kad norite nuspėti, ar paskola yra atmesta / priimta remiantis daugeliu požymių. Logistinė regresija yra 0/1 formos. y = 0, jei paskola atmetama, y ​​= 1, jei bus priimta.

Logistinis regresijos modelis skiriasi nuo tiesinės regresijos modelio dviem būdais.

• Visų pirma, logistinė regresija priima tik dichotominį (dvejetainį) įvedimą kaip priklausomą kintamąjį (ty 0 ir 1 vektorių).
• Antra, rezultatas matuojamas šia tikimybinio ryšio funkcija, vadinama sigmoidu dėl jos S formos:

Funkcijos išvestis visada yra nuo 0 iki 1. Patikrinkite paveikslėlį žemiau

Sigmoidinė funkcija grąžina reikšmes nuo 0 iki 1. Klasifikavimo užduočiai atlikti reikia atskiro 0 arba 1 išėjimo.

Norėdami konvertuoti nenutrūkstamą srautą į atskirą vertę, galime nustatyti, kad sprendimas yra 0,5. Visos vertės, viršijančios šią ribą, klasifikuojamos kaip 1

Šioje pamokoje sužinosite

• Kas yra logistinė regresija?
• Kaip sukurti apibendrintą linijinį modelį (GLM)
• 1 žingsnis) Patikrinkite nuolatinius kintamuosius
• 2 žingsnis) Patikrinkite faktoriaus kintamuosius
• 3 žingsnis) Funkcijų inžinerija
• 4 žingsnis) Santraukos statistika
• 5 žingsnis) Traukinys / testų rinkinys
• 6 žingsnis) Sukurkite modelį
• 7 žingsnis) Įvertinkite modelio našumą

Kaip sukurti apibendrintą linijinį modelį (GLM)

Leiskite naudoti suaugusiųjų duomenis, nustatytus siekiant parodyti logistinės regresijos. „Suaugęs“ yra puikus klasifikavimo užduoties duomenų rinkinys. Tikslas yra numatyti, ar asmens metinės pajamos doleriais viršys 50 000. Duomenų rinkinyje yra 46 033 stebėjimai ir dešimt funkcijų:

• amžius: asmens amžius. Skaitmeninis
• išsilavinimas: Asmens išsilavinimo lygis. Veiksnys.
• santuokinė būsena: asmens šeiminė padėtis. Veiksnys, ty niekada nesusituokęs, vedęs pilietinis sutuoktinis,…
• lytis: asmens lytis. Veiksnys, ty vyras arba moteris
• pajamos: tikslinis kintamasis. Pajamos viršija arba nesiekia 50 tūkst. Veiksnys, ty> 50K, <= 50K

tarp kitų

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

Išvestis:

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… 

Mes elgsimės taip:

• 1 veiksmas: patikrinkite nuolatinius kintamuosius
• 2 žingsnis: Patikrinkite faktoriaus kintamuosius
• 3 žingsnis: funkcijų inžinerija
• 4 žingsnis: suvestinė statistika
• 5 žingsnis: traukinys / testų rinkinys
• 6 žingsnis: Sukurkite modelį
• 7 žingsnis: Įvertinkite modelio našumą
• 8 žingsnis: patobulinkite modelį

Jūsų užduotis yra numatyti, kurio asmens pajamos bus didesnės nei 50 tūkst.

Šioje pamokoje kiekvienas veiksmas bus išsamus, kad būtų galima atlikti realaus duomenų rinkinio analizę.

1 žingsnis) Patikrinkite nuolatinius kintamuosius

Pirmajame etape galite pamatyti ištisinių kintamųjų pasiskirstymą.

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

Kodo paaiškinimas

• nepertraukiamas <- select_if (duomenų_suaugęs, yra.skaitinis): naudokite funkciją select_if () iš dplyr bibliotekos, kad pasirinktumėte tik skaitinius stulpelius
• santrauka (nuolatinė): atspausdinkite suvestinės statistiką

Išvestis:

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

Iš pirmiau pateiktos lentelės galite pamatyti, kad duomenys turi visiškai skirtingas skales ir valandas. Per.weeks turi didelius pašalinius rodiklius (.ie pažvelgti į paskutinę kvartilę ir didžiausią vertę).

Su tuo galite susidoroti atlikdami du veiksmus:

• 1: Nubraižykite valandų pasiskirstymą per savaitę
• 2: Standartizuokite nuolatinius kintamuosius

1. Nubraižykite pasiskirstymą

Pažvelkime atidžiau į valandų pasiskirstymą per savaitę

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

Išvestis:

Kintamasis turi daug pašalinių reikšmių ir nėra tiksliai apibrėžtas paskirstymas. Iš dalies galite išspręsti šią problemą ištrindami 0,01 procento didžiausių valandų per savaitę skaičių.

Pagrindinė kvantilio sintaksė:

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.

Apskaičiuojame viršutinę 2 procentų procentilę

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

Kodo paaiškinimas

• kvantilis (data_adult $ hours.per.week, .99): Apskaičiuokite 99 procentų darbo laiko vertę

Išvestis:

## 99%## 80 

98 procentai gyventojų dirba mažiau nei 80 valandų per savaitę.

Stebėjimus galite mesti virš šios ribos. Naudojate „dplyr“ bibliotekos filtrą.

data_adult_drop <-data_adult %>%filter(hours.per.week
Išvestis:


## [1] 45537 10 
 

Standartizuokite nuolatinius kintamuosius

Norėdami pagerinti našumą, galite standartizuoti kiekvieną stulpelį, nes jūsų duomenys nėra vienodo masto. Funkciją mutate_if galite naudoti iš dplyr bibliotekos. Pagrindinė sintaksė yra:
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
Skaitmeninius stulpelius galite standartizuoti taip:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Kodo paaiškinimas

mutate_if (is.numeric, funs (scale)): Sąlyga yra tik skaitinis stulpelis, o funkcija - skalė

Išvestis:
## 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 žingsnis) Patikrinkite faktoriaus kintamuosius
Šis žingsnis turi du tikslus:

Patikrinkite lygį kiekviename kategoriniame stulpelyje
Apibrėžkite naujus lygius

Šį žingsnį padalinsime į tris dalis:

Pasirinkite kategorinius stulpelius
Kiekvieno stulpelio juostinę diagramą išsaugokite sąraše
Atspausdinkite grafikus

Mes galime pasirinkti veiksnių stulpelius su žemiau esančiu kodu:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Kodo paaiškinimas

data.frame (select_if (data_adult, is.factor)): Veiksnių stulpelius faktoriuje saugome duomenų rėmelių tipuose. Bibliotekai „ggplot2“ reikalingas duomenų rėmo objektas.

Išvestis:
## [1] 6 
Duomenų rinkinyje yra 6 kategoriniai kintamieji
Antrasis žingsnis yra labiau kvalifikuotas. Kiekvienam duomenų rėmelio koeficiento stulpeliui norite brėžti juostinę diagramą. Patogiau procesą automatizuoti, ypač esant daugybei stulpelių.
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)))
Kodo paaiškinimas

lapply (): naudokite funkciją lapply (), jei norite perduoti funkciją visuose duomenų rinkinio stulpeliuose. Išvestį saugote sąraše
funkcija (x): funkcija bus apdorota kiekvienam x. Čia x yra stulpeliai
ggplot (faktorius, aes (get (x))) + geom_bar () + tema (ašis.tekstas.x = elemento_tekstas (kampas = 90)): Sukurkite juostos simbolių diagramą kiekvienam x elementui. Atminkite, kad norėdami grąžinti x kaip stulpelį, turite jį įtraukti į „get“ ()

Paskutinis žingsnis yra gana lengvas. Norite atsispausdinti 6 grafikus.
# Print the graphgraph
Išvestis:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Pastaba: Norėdami pereiti prie kito grafiko, naudokite kitą mygtuką

3 žingsnis) Funkcijų inžinerija
Išdėstymas nauja redakcija
Iš aukščiau pateikto grafiko galite pamatyti, kad kintamasis išsilavinimas turi 16 lygių. Tai yra esminis dalykas, o kai kurių lygių stebėjimų skaičius yra palyginti nedidelis. Jei norite pagerinti informacijos, kurią galite gauti iš šio kintamojo, kiekį, galite ją perduoti į aukštesnį lygį. Būtent, jūs kuriate didesnes grupes su panašiu išsilavinimo lygiu. Pavyzdžiui, žemas išsilavinimo lygis bus pakeistas nebaigusiųjų. Aukštasis išsilavinimas bus pakeistas į magistro laipsnį.
Čia yra išsami informacija:
 

 
 

Senas lygis
 

Naujas lygis
 

 

 

 
 

Ikimokyklinis
 

iškristi
 

 
 

10-oji
 

Iškristi
 

 
 

11-oji
 

Iškristi
 

 
 

12-oji
 

Iškristi
 

 
 

1–4 d
 

Iškristi
 

 
 

5–6
 

Iškristi
 

 
 

7–8
 

Iškristi
 

 
 

9-oji
 

Iškristi
 

 
 

HS-Grad
 

„HighGrad“
 

 
 

Kai kurie kolegijos
 

Bendruomenė
 

 
 

Assoc-acdm
 

Bendruomenė
 

 
 

Asocijuotasis vokalas
 

Bendruomenė
 

 
 

Bakalaurai
 

Bakalaurai
 

 
 

Meistrai
 

Meistrai
 

 
 

Prof-mokykla
 

Meistrai
 

 
 

Daktaro laipsnis
 

Daktaro laipsnis
 

 

 

 
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")))))))
Kodo paaiškinimas

Mes naudojame veiksmažodį mutate from dplyr library. Švietimo vertybes keičiame teiginiu ifelse

Žemiau esančioje lentelėje sukuriate suvestinę statistiką, kad pamatytumėte, kiek vidutiniškai metų (z vertė) reikia norint pasiekti bakalaurą, magistro ar daktaro laipsnį.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Išvestis:
## # 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
Nauja redakcija Šeiminė padėtis
Taip pat galima sukurti žemesnę šeiminės padėties lygį. Šiame kode jūs keičiate lygį taip:
 

 
 

Senas lygis
 

Naujas lygis
 

 

 

 
 

Niekad nesituokęs
 

Nėra susituokę
 

 
 

Vedęs-sutuoktinis nedalyvauja
 

Nėra susituokę
 

 
 

Vedęs-AF-sutuoktinis
 

Vedęs
 

 
 

Vedęs-civ-sutuoktinis
 
 

 
 

Atskirtas
 

Atskirtas
 

 
 

Išsiskyręs
 
 

 
 

Našlės
 

Našlė
 

 

 

 
# 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")))))
 Galite patikrinti kiekvienos grupės asmenų skaičių. 
table(recast_data$marital.status)
Išvestis:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
4 žingsnis) Santraukos statistika
Atėjo laikas patikrinti statistiką apie mūsų tikslinius kintamuosius. Žemiau pateiktoje diagramoje suskaičiuojate procentą asmenų, uždirbančių daugiau nei 50 tūkst., Atsižvelgiant į jų lytį.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Išvestis:

Tada patikrinkite, ar asmens kilmė turi įtakos jo uždarbiui.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Išvestis:

Darbo valandų skaičius pagal lytį.
# 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()
Išvestis:

Dėžutės schema patvirtina, kad darbo laiko paskirstymas tinka skirtingoms grupėms. Dėžutės siužete abi lytys neturi vienarūšių stebėjimų.
Savaitės darbo laiko tankį galite patikrinti pagal išsilavinimo tipą. Paskirstymai turi daug skirtingų pasirinkimų. Tikriausiai tai galima paaiškinti sutarties rūšimi JAV.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Kodo paaiškinimas

ggplot (recast_data, aes (x = hours.per.week)): tankio diagramai reikia tik vieno kintamojo
geom_densness (aes (spalva = išsilavinimas), alfa = 0,5): geometrinis objektas, skirtas valdyti tankį

Išvestis:

Norėdami patvirtinti savo mintis, galite atlikti vienpusį ANOVA testą:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Išvestis:
## 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 testas patvirtina vidutinį skirtumą tarp grupių.
Netiesiškumas
Prieš paleidžiant modelį, galite sužinoti, ar dirbtų valandų skaičius yra susijęs su amžiumi.
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()
Kodo paaiškinimas

ggplot (recast_data, aes (x = amžius, y = valandos per savaitę)): nustatykite grafiko estetiką
geom_point (aes (spalva = pajamos), dydis = 0,5): sukonstruokite taškų diagramą
stat_smooth (): pridėkite tendencijos eilutę su šiais argumentais:

method = 'lm': Nubraižykite pritaikytą vertę, jei tiesinė regresija
formulė = y ~ poly (x, 2): pritaikykite daugianario regresiją
se = TRUE: pridėkite standartinę klaidą
aes (spalva = pajamos): sulaužykite modelį pagal pajamas



Išvestis:

Trumpai tariant, galite išbandyti sąveikos terminus modelyje, kad gautumėte nelinijiškumo tarp savaitės darbo laiko ir kitų funkcijų efektą. Svarbu nustatyti, kuriomis sąlygomis skiriasi darbo laikas.
Koreliacija
Kitas patikrinimas yra koreliacijos tarp kintamųjų vizualizavimas. Veiksnio lygio tipą paversite skaitmeniniu, kad galėtumėte suplanuoti šilumos žemėlapį, kuriame pateikiamas koreliacijos koeficientas, apskaičiuotas naudojant „Spearman“ metodą.
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")
Kodo paaiškinimas

data.frame (lapply (recast_data, as.integer)): konvertuoti duomenis į skaitmeninius
„ggcorr“ () pateikite šilumos žemėlapį su šiais argumentais:

metodas: koreliacijos apskaičiavimo metodas
n pertraukos = 6: lūžio skaičius
hjust = 0,8: kintamojo pavadinimo valdymo padėtis diagramoje
label = TRUE: pridėkite etiketes langų centre
label_size = 3: dydžio etiketės
spalva = "pilka50"): etiketės spalva



Išvestis:

5 žingsnis) Traukinys / testų rinkinys
Norint atlikti bet kokią prižiūrimą mašininio mokymosi užduotį, duomenis reikia padalyti iš traukinių rinkinio į bandymų rinkinį. Norėdami sukurti traukinių / testų rinkinį, galite naudoti „funkciją“, kurią sukūrėte kitose prižiūrimose mokymo pamokose.
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)
Išvestis:
## [1] 36429 9
 
dim(data_test)
Išvestis:
## [1] 9108 9 
6 žingsnis) Sukurkite modelį
Norėdami pamatyti algoritmo našumą, naudokite paketą glm (). Apibendrintas linijinis modelis yra modelių kolekcija. Pagrindinė sintaksė yra:
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")
Esate pasirengę įvertinti logistinį modelį, kad pajamų lygis būtų padalytas tarp funkcijų rinkinio.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Kodo paaiškinimas

formulė <- pajamos ~.: Sukurkite modelį, kad jis atitiktų
logit <- glm (formula, data = data_train, family = 'binomial'): pritaikykite logistinį modelį (family = 'binomial') su data_train duomenimis.
santrauka (logit): atsispausdinkite modelio santrauką

Išvestis:
#### 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
Mūsų modelio santrauka atskleidžia įdomią informaciją. Logistinės regresijos našumas vertinamas pagal konkrečius pagrindinius rodiklius.

AIC („Akaike Information Criteria“): tai yra logistinės regresijos R2 ekvivalentas . Jis matuoja tinkamumą, kai bauda taikoma už parametrų skaičių. Mažesnės AIC vertės rodo, kad modelis yra arčiau tiesos.
Nulinis nuokrypis: tinka modeliui tik su perėmimu. Laisvės laipsnis yra n-1. Mes galime tai interpretuoti kaip Chi kvadrato vertę (pritaikyta reikšmė skiriasi nuo faktinės vertės hipotezės testavimo).
Liekamasis nuokrypis: modeliuokite su visais kintamaisiais. Jis taip pat aiškinamas kaip Chi kvadrato hipotezės testavimas.
„Fisher“ taškų kartojimų skaičius: kartojimų skaičius prieš suartėjant.

Funkcijos glm () išvestis saugoma sąraše. Žemiau pateiktas kodas rodo visus elementus, esančius logit kintamajame, kurį sukonstravome vertindami logistinę regresiją.
# Sąrašas yra labai ilgas, atspausdinkite tik pirmuosius tris elementus
lapply(logit, class)[1:3]
Išvestis:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Kiekvieną vertę galima išskirti su $ ženklu ir metrikos pavadinimu. Pavyzdžiui, jūs išsaugojote modelį kaip logit. Norėdami išgauti AIC kriterijus, naudokite:
logit$aic
Išvestis:
## [1] 27086.65
7 žingsnis) Įvertinkite modelio našumą
Sumišimo matrica
Painiavos matrica yra geresnis pasirinkimas įvertinti klasifikavimo rezultatus, palyginti su skirtingų metrikų matei anksčiau. Bendra idėja yra suskaičiuoti, kiek kartų tikrieji atvejai klasifikuojami kaip klaidingi.

Norėdami apskaičiuoti painiavos matricą, pirmiausia turite turėti numatymų rinkinį, kad juos būtų galima palyginti su tikraisiais taikiniais.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Kodo paaiškinimas

numatyti (logit, data_test, type = 'response'): apskaičiuokite bandymo rinkinio prognozę. Norėdami apskaičiuoti atsako tikimybę, nustatykite type = 'response'.
lentelė (duomenų_testas $ pajamos, numatyti> 0,5): apskaičiuokite painiavos matricą. numatyti> 0,5 reiškia, kad jis grąžina 1, jei numatomos tikimybės yra didesnės nei 0,5, dar 0.

Išvestis:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Kiekviena painiavos matricos eilutė rodo tikrąjį taikinį, o kiekvienas stulpelis - numatomą tikslą. Pirmoje šios matricos eilutėje pajamos yra mažesnės nei 50 tūkst. (Klaidinga klasė): 6241 buvo teisingai priskirta asmenims, kurių pajamos mažesnės nei 50 tūkst. ( Tikras neigiamas ), o likusioji klaidingai priskirta didesnėms nei 50 tūkst. ( Klaidingai teigiama ). Antroje eilėje pajamos viršija 50 tūkst., Teigiama klasė buvo 1229 ( tiesa teigiama ), o tikra neigiama - 1074.
Galite apskaičiuoti modelio tikslumą susumuodami tikrąjį teigiamą + tikrąjį neigiamą viso stebėjimo metu

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Kodo paaiškinimas

suma (diag (table_mat)): įstrižainės suma
suma (lentelės_matas): Matricos suma.

Išvestis:
## [1] 0.8277339 
Panašu, kad modelį kamuoja viena problema, jis pervertina melagingų neiginių skaičių. Tai vadinama tikslumo bandymo paradoksu . Mes pareiškėme, kad tikslumas yra teisingų prognozių ir viso atvejų skaičiaus santykis. Mes galime turėti gana aukštą tikslumą, bet nenaudingą modelį. Tai atsitinka, kai yra dominuojanti klasė. Jei pažvelgsite į painiavos matricą, pamatysite, kad dauguma atvejų yra klasifikuojami kaip tikri neigiami. Įsivaizduokite, kad dabar visos klasės buvo klasifikuojamos kaip neigiamos (ty mažesnės nei 50 tūkst.). Turėtumėte 75 proc. Tikslumą (6718/6718 + 2257). Jūsų modelis veikia geriau, tačiau stengiasi atskirti tikrąjį teigiamą ir tikrąjį neigiamą.
Tokioje situacijoje geriau turėti glaustesnę metriką. Mes galime pažvelgti į:

Tikslumas = TP / (TP + FP)
Prisiminti = TP / (TP + FN)

Tikslumas ir atšaukimas
Tikslumas - teigiamos prognozės tikslumas. Prisiminti - tai teigiamų klasifikatoriaus aptiktų atvejų santykis;
Norėdami suskaičiuoti šias dvi metrikas, galite sukonstruoti dvi funkcijas

Konstruoti tikslumą

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

mat [1,1]: grąžina duomenų langelio pirmojo stulpelio pirmąjį langelį, ty tikrąjį teigiamą
kilimėlis [1,2]; Grąžinkite antrą duomenų rėmelio stulpelio pirmą langelį, ty klaidingai teigiamą

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

mat [1,1]: grąžina duomenų langelio pirmojo stulpelio pirmąjį langelį, ty tikrąjį teigiamą
kilimėlis [2,1]; Grąžinkite antrą duomenų rėmelio pirmojo stulpelio langelį, ty klaidingai neigiamą

Galite išbandyti savo funkcijas
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Išvestis:
## [1] 0.712877## [2] 0.5336518
Kai modelis sako, kad tai asmuo, viršijantis 50 tūkst., Jis teisingas tik 54 proc. Atvejų ir 72 proc.
Galite sukurti Yra harmoninis vidurkis šių dviejų metrikos, tai reiškia, kad suteikia daugiau svorio apatinių vertybes.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Išvestis:
## [1] 0.6103799 
„Precision vs Recall“ kompromisas
Neįmanoma turėti didelio tikslumo ir didelio atšaukimo.
Jei padidinsime tikslumą, teisingesnis individas bus geriau nuspėjamas, bet mes praleistume daug jų (mažesnis atšaukimas). Kai kuriose situacijose mums labiau patinka tikslumas nei atšaukimas. Tarp tikslumo ir prisiminimo yra įgaubtas ryšys.

Įsivaizduokite, turite nuspėti, ar pacientas serga liga. Norite būti kuo tiksliau.
Jei reikia atpažinti galimus apgaulingus žmones gatvėje atpažįstant veidą, geriau būtų sugauti daug žmonių, pažymėtų kaip apgaulingi, nors tikslumas yra žemas. Policija galės paleisti nesąžiningą asmenį.

ROC kreivė
ROC kreivė kreivė yra kita bendra priemonė naudojama su dvejetainiu klasifikaciją. Ji yra labai panaši į tikslumo / atšaukimo kreivę, tačiau vietoj to, kad būtų nubrėžtas tikslumas, palyginti su atšaukimu, ROC kreivė rodo tikrąjį teigiamą rodiklį (ty atšaukimą), palyginti su klaidingai teigiama norma. Klaidingai teigiamas rodiklis yra neigiamų atvejų, kurie neteisingai klasifikuojami kaip teigiami, santykis. Jis lygus vienam atėmus tikrąjį neigiamą rodiklį. Tikrasis neigiamas rodiklis dar vadinamas specifiškumu . Taigi ROC kreivė pavaizduoja jautrumą (atšaukimą) ir 1 specifiškumą
Norėdami nubrėžti ROC kreivę, turime įdiegti biblioteką, vadinamą RORC. Mes galime rasti daugiabučių namų bibliotekoje. Galite įvesti kodą:
conda install -cr r-rocr --taip
Mes galime suskaičiuoti ROC su numatymo () ir atlikimo () funkcijomis.
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Kodo paaiškinimas

numatymas (numatyti, duomenų_testas $ pajamos): ROCR biblioteka turi sukurti numatymo objektą, kad transformuotų įvesties duomenis
atlikimas (ROCRpred, 'tpr', 'fpr'): grąžinkite du derinius, kuriuos norite sukurti diagramoje. Čia konstruojami tpr ir fpr. Išsiaiškinkite tikslumą ir kartu prisiminkite, naudokite „prec“, „rec“.

Išvestis:

8 žingsnis) Patobulinkite modelį
Galite pabandyti pridėti modeliui netiesiškumą su sąveika

amžius ir valandos.savaitę
lytis ir valandos.savaitę.

Norėdami palyginti abu modelius, turite naudoti balų testą
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
Išvestis:
## [1] 0.6109181 
Balas yra šiek tiek didesnis nei ankstesnis. Galite toliau dirbti su duomenimis ir pabandyti įveikti rezultatą.

Santrauka
Žemiau esančioje lentelėje galime apibendrinti logistinės regresijos treniravimo funkciją:
 

 
 

Pakuotė
 

Tikslas
 

funkcija
 

argumentas
 

 

 

 
 

-
 

Sukurkite traukinio / bandymo duomenų rinkinį
 

create_train_set ()
 

duomenys, dydis, traukinys
 

 
 

glm
 

Mokykite apibendrintą linijinį modelį
 

glm ()
 

formulė, duomenys, šeima *
 

 
 

glm
 

Apibendrinkite modelį
 

santrauka ()
 

pritaikytas modelis
 

 
 

bazė
 

Padarykite numatymą
 

numatyti()
 

pritaikytas modelis, duomenų rinkinys, type = 'response'
 

 
 

bazė
 

Sukurkite painiavos matricą
 

lentelė ()
 

y, nuspėti ()
 

 
 

bazė
 

Sukurkite tikslumo balą
 

suma (diag (lentelė ()) / suma (lentelė ()
 

 
 

ROCR
 

Sukurkite ROC: 1 žingsnis Sukurkite numatymą
 

numatymas ()
 

numatyti (), y
 

 
 

ROCR
 

Sukurkite ROC: 2 žingsnis Sukurkite našumą
 

spektaklis()
 

numatymas (), „tpr“, „fpr“
 

 
 

ROCR
 

Sukurkite ROC: 3 žingsnis Nubraižykite diagramą
 

sklypas ()
 

spektaklis()
 

 

 

Kiti GLM modeliai yra:
- binomalas: (link = "logit")
- gaussianas: (nuoroda = "tapatybė")
- Gama: (nuoroda = "atvirkštinė")
- inverse.gaussian: (nuoroda = "1 / mu 2")
- poisson: (nuoroda = "log")
- beveik: (nuoroda = "tapatybė", dispersija = "pastovi")
- kvazibinomas: (link = "logit")
- quasipoisson: (link = "log")
                    


                    

                      

                        
                          
Share on Facebook
                            

                          
                        
                      
                      

                        
                          
Share on Twitter