GLM R: Vispārējs lineārs modelis ar piemēru

Kas ir loģistiskā regresija?

Loģistisko regresiju izmanto, lai prognozētu klasi, ti, varbūtību. Loģistiskā regresija var precīzi paredzēt bināro iznākumu.

Iedomājieties, ka vēlaties paredzēt, vai aizdevums tiek noraidīts / pieņemts, pamatojoties uz daudziem atribūtiem. Loģistiskā regresija ir formā 0/1. y = 0, ja aizdevums tiek noraidīts, y = 1, ja tiek pieņemts.

Loģistiskās regresijas modelis no lineārās regresijas modeļa atšķiras divos veidos.

• Pirmkārt, loģistiskā regresija kā atkarīgu mainīgo (ti, 0 un 1 vektoru) pieņem tikai divējāda (binārā) ievadi.
• Otrkārt, rezultātu mēra ar šādu varbūtības saites funkciju, ko sauc par sigmoīdu tās S formas dēļ:

Funkcijas izeja vienmēr ir no 0 līdz 1. Pārbaudiet attēlu zemāk

Funkcija sigmoid atgriež vērtības no 0 līdz 1. Klasifikācijas uzdevumam mums ir nepieciešama diskrēta 0 vai 1 izeja.

Lai nepārtrauktu plūsmu pārvērstu par diskrētu vērtību, mēs varam noteikt lēmumu, kas ir saistīts ar 0,5. Visas vērtības, kas pārsniedz šo slieksni, tiek klasificētas kā 1

Šajā apmācībā jūs uzzināsiet

• Kas ir loģistiskā regresija?
• Kā izveidot vispārinātu līnijpārvadātāju modeli (GLM)
• 1. darbība. Pārbaudiet nepārtrauktos mainīgos
• 2. solis) Pārbaudiet faktora mainīgos
• 3. solis) Funkciju inženierija
• 4. solis) Kopsavilkuma statistika
• 5. solis) Vilciens / testa komplekts
• 6. solis) Izveidojiet modeli
• 7. solis) Novērtējiet modeļa veiktspēju

Kā izveidot vispārinātu līnijpārvadātāju modeli (GLM)

Izmantosim pieaugušo datu kopu, lai ilustrētu loģistikas regresiju. "Pieaugušais" ir lieliska datu kopa klasifikācijas uzdevumam. Mērķis ir paredzēt, vai indivīda gada ienākumi dolāros pārsniegs 50 000. Datu kopa satur 46 033 novērojumus un desmit pazīmes:

• vecums: indivīda vecums. Ciparu skaitlis
• izglītība: Indivīda izglītības līmenis. Faktors.
• marital.status: Indivīda ģimenes stāvoklis. Faktors, ti, nekad nav precējies, precējies, civ-laulātais,…
• dzimums: indivīda dzimums. Faktors, ti, vīrietis vai sieviete
• ienākumi: mērķa mainīgais. Ienākumi virs vai zem 50 000. Faktors, ti,> 50K, <= 50K

cita starpā

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

Izeja:

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… 

Mēs rīkosimies šādi:

• 1. darbība: pārbaudiet nepārtrauktos mainīgos
• 2. darbība. Pārbaudiet faktora mainīgos
• 3. darbība: iezīmju inženierija
• 4. solis: Kopsavilkuma statistika
• 5. solis: vilciens / testa komplekts
• 6. darbība: izveidojiet modeli
• 7. solis: Novērtējiet modeļa veiktspēju
• 8. solis: Uzlabojiet modeli

Jūsu uzdevums ir paredzēt, kura indivīda ienākumi būs lielāki par 50 000.

Šajā apmācībā katrs solis būs detalizēts, lai veiktu reālas datu kopas analīzi.

1. darbība. Pārbaudiet nepārtrauktos mainīgos

Pirmajā solī varat redzēt nepārtraukto mainīgo sadalījumu.

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

Kods Paskaidrojums

• nepārtraukts <- select_if (datu_pieaugušais, ir.numeric): Izmantojiet funkciju select_if () no dplyr bibliotēkas, lai atlasītu tikai skaitliskās kolonnas
• kopsavilkums (nepārtraukts): izdrukājiet kopsavilkuma statistiku

Izeja:

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

No iepriekš minētās tabulas jūs varat redzēt, ka datiem ir pilnīgi atšķirīgas skalas un stundas.per.weeks ir lieli izņēmumi (.ie apskatiet pēdējo kvartili un maksimālo vērtību).

Jūs varat tikt galā ar šādām divām darbībām:

• 1: uzzīmējiet stundu sadalījumu nedēļā
• 2: Standartizējiet nepārtrauktos mainīgos

1. Uzzīmējiet sadalījumu

Apskatīsim tuvāk stundu sadalījumu nedēļā

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

Izeja:

Mainīgajam ir daudz ārkārtas gadījumu un nav precīzi definēts sadalījums. Jūs varat daļēji risināt šo problēmu, izdzēšot 0,01 procentus no stundām nedēļā.

Kvantu pamatsintakse:

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.

Mēs aprēķinām augšējo 2 procentu procentili

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

Kods Paskaidrojums

• kvantile (datu_pieaugušie $ stundas nedēļā / nedēļā, 0,99): aprēķiniet 99 procentu darba laika vērtību

Izeja:

## 99%## 80 

98 procenti iedzīvotāju strādā mazāk nekā 80 stundas nedēļā.

Novērojumus varat nomest virs šī sliekšņa. Jūs izmantojat filtru no dplyr bibliotēkas.

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


## [1] 45537 10 
 

Standartizējiet nepārtrauktos mainīgos

Varat standartizēt katru kolonnu, lai uzlabotu veiktspēju, jo jūsu datiem nav vienāda mēroga. Funkciju mutate_if var izmantot no dplyr bibliotēkas. Pamata sintakse ir:
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
Skaitliskās kolonnas varat standartizēt šādi:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Kods Paskaidrojums

mutate_if (is.numeric, funs (scale)): nosacījums ir tikai skaitliska kolonna un funkcija ir mērogs

Izeja:
## 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. solis) Pārbaudiet faktora mainīgos
Šim solim ir divi mērķi:

Katrā kategoriskajā kolonnā pārbaudiet līmeni
Definējiet jaunus līmeņus

Mēs sadalīsim šo soli trīs daļās:

Atlasiet kategoriskās kolonnas
Glabājiet katras kolonnas joslu diagrammu sarakstā
Izdrukājiet diagrammas

Mēs varam atlasīt koeficientu kolonnas ar kodu zemāk:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Kods Paskaidrojums

data.frame (select_if (data_adult, is.factor)): Mēs faktoru kolonnas faktorā saglabājam datu rāmja tipā. Bibliotēkai ggplot2 nepieciešams datu rāmja objekts.

Izeja:
## [1] 6 
Datu kopa satur 6 kategoriskus mainīgos
Otrais solis ir prasmīgāks. Jūs vēlaties uzzīmēt joslu diagrammu katrai datu rāmja faktora kolonnai. Procesu ir ērtāk automatizēt, it īpaši, ja ir daudz kolonnu.
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)))
Kods Paskaidrojums

lapply (): izmantojiet funkciju lapply (), lai nodotu funkciju visās datu kopas kolonnās. Jūs saglabājat izvadi sarakstā
function (x): Funkcija tiks apstrādāta katram x. Šeit x ir kolonnas
ggplot (faktors, aes (get (x))) + geom_bar () + motīvs (ass.text.x = element_text (leņķis = 90)): izveidojiet joslu char diagrammu katram x elementam. Piezīme. Lai atgrieztu x kā kolonnu, tas jāiekļauj get ()

Pēdējais solis ir samērā vienkāršs. Jūs vēlaties izdrukāt 6 grafikus.
# Print the graphgraph
Izeja:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Piezīme. Izmantojiet nākamo pogu, lai pārietu uz nākamo diagrammu

3. solis) Funkciju inženierija
Pārstrādāta izglītība
No iepriekš redzamās diagrammas var redzēt, ka mainīgajai izglītībai ir 16 līmeņi. Tas ir būtiski, un dažos līmeņos ir salīdzinoši maz novērojumu. Ja vēlaties uzlabot no šī mainīgā iegūtās informācijas apjomu, varat to pārstrādāt augstākā līmenī. Proti, jūs izveidojat lielākas grupas ar līdzīgu izglītības līmeni. Piemēram, zems izglītības līmenis tiks pārveidots pametušo vidū. Augstāks izglītības līmenis tiks mainīts uz maģistra grādu.
Šeit ir informācija:
 

 
 

Vecais līmenis
 

Jauns līmenis
 

 

 

 
 

Pirmsskola
 

pamet
 

 
 

10
 

Atteikšanās
 

 
 

11
 

Atteikšanās
 

 
 

12
 

Atteikšanās
 

 
 

1.-4
 

Atteikšanās
 

 
 

5.-6
 

Atteikšanās
 

 
 

7.-8
 

Atteikšanās
 

 
 

9
 

Atteikšanās
 

 
 

HS-Grad
 

HighGrad
 

 
 

Daži-koledža
 

Kopiena
 

 
 

Assoc-acdm
 

Kopiena
 

 
 

Asociētais vokāls
 

Kopiena
 

 
 

Vecpuiši
 

Vecpuiši
 

 
 

Meistari
 

Meistari
 

 
 

Prof-skola
 

Meistari
 

 
 

Doktora grāds
 

Doktora grāds
 

 

 

 
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")))))))
Kods Paskaidrojums

Mēs izmantojam darbības vārdu mutate from dplyr library. Mēs mainām izglītības vērtības ar apgalvojumu ifelse

Zemāk esošajā tabulā jūs izveidojat kopsavilkuma statistiku, lai vidēji redzētu, cik gadu izglītības (z-vērtība) ir nepieciešams, lai sasniegtu bakalaura, maģistra vai doktora grādu.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Izeja:
## # 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
Pārstrādāt ģimenes stāvokli
Ir arī iespējams izveidot zemāku ģimenes stāvokļa līmeni. Šajā kodā jūs maināt līmeni šādi:
 

 
 

Vecais līmenis
 

Jauns līmenis
 

 

 

 
 

Nekad nav bijis precējies
 

Nav precējies
 

 
 

Precējies-laulātais prombūtnē
 

Nav precējies
 

 
 

Precējies - AF laulātais
 

Precējies
 

 
 

Precējies-civ-laulātais
 
 

 
 

Atdalīts
 

Atdalīts
 

 
 

Šķīries
 
 

 
 

Atraitnes
 

Atraitne
 

 

 

 
# 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")))))
 Jūs varat pārbaudīt personu skaitu katrā grupā. 
table(recast_data$marital.status)
Izeja:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
4. solis) Kopsavilkuma statistika
Ir pienācis laiks pārbaudīt statistiku par mūsu mērķa mainīgajiem. Zemāk redzamajā diagrammā jūs saskaita to cilvēku procentuālo daļu, kuri nopelna vairāk nekā 50 000, ņemot vērā viņu dzimumu.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Izeja:

Pēc tam pārbaudiet, vai indivīda izcelsme ietekmē viņu pelnīšanu.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Izeja:

Darba stundu skaits pēc dzimuma.
# 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()
Izeja:

Kastes diagramma apstiprina, ka darba laika sadalījums atbilst dažādām grupām. Kastes sižetā abiem dzimumiem nav viendabīgu novērojumu.
Nedēļas darba laika blīvumu var pārbaudīt pēc izglītības veida. Sadalījumiem ir daudz atšķirīgu izvēļu. To droši vien var izskaidrot ar līguma veidu ASV.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Kods Paskaidrojums

ggplot (recast_data, aes (x = hours.per.week)): Blīvuma diagrammai ir nepieciešams tikai viens mainīgais
geom_densness (aes (krāsa = izglītība), alfa = 0.5): ģeometriskais objekts blīvuma kontrolei

Izeja:

Lai apstiprinātu savas domas, varat veikt vienvirziena ANOVA testu:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Izeja:
## 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 tests apstiprina vidējo atšķirību starp grupām.
Nelinearitāte
Pirms palaižat modeli, jūs varat redzēt, vai nostrādāto stundu skaits ir saistīts ar vecumu.
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()
Kods Paskaidrojums

ggplot (pārstrādāti_dati, aes (x = vecums, y = stundas.nedēļas nedēļā)): iestatiet diagrammas estētiku
geom_point (aes (krāsa = ienākumi), izmērs = 0,5): izveidojiet punktu diagrammu
stat_smooth (): pievienojiet tendences līniju ar šādiem argumentiem:

method = 'lm': uzzīmējiet uzstādīto vērtību, ja lineārā regresija
formula = y ~ poli (x, 2): atbilst polinoma regresijai
se = TRUE: pievienojiet standarta kļūdu
aes (krāsa = ienākumi): sadaliet modeli pēc ienākumiem



Izeja:

Īsāk sakot, modelī varat pārbaudīt mijiedarbības terminus, lai uzzinātu nelinearitātes efektu starp nedēļas darba laiku un citām funkcijām. Ir svarīgi noteikt, kādos apstākļos darba laiks atšķiras.
Korelācija
Nākamā pārbaude ir vizualizēt korelāciju starp mainīgajiem. Jūs pārvēršat faktora līmeņa tipu ciparu formātā, lai varētu uzzīmēt siltuma karti ar korelācijas koeficientu, kas aprēķināts ar Spīrmena metodi.
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")
Kods Paskaidrojums

data.frame (lapply (pārstrādāti_dati, as.integer)): konvertējiet datus ciparu formātā
ggcorr () uzrāda karstuma karti ar šādiem argumentiem:

metode: metode korelācijas aprēķināšanai
n pārtraukumi = 6: pārtraukuma skaits
hjust = 0.8: mainīgā nosaukuma vadības pozīcija diagrammā
label = TRUE: pievienojiet etiķetes logu centrā
label_size = 3: Lieluma etiķetes
color = "grey50"): etiķetes krāsa



Izeja:

5. solis) Vilciens / testa komplekts
Jebkuram uzraudzītam mašīnmācīšanās uzdevumam ir jāsadala dati starp vilcienu komplektu un testa komplektu. Lai izveidotu vilcienu / testu kopu, varat izmantot "funkciju", kuru izveidojāt citās uzraudzītajās mācību pamācībās.
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)
Izeja:
## [1] 36429 9
 
dim(data_test)
Izeja:
## [1] 9108 9 
6. solis) Izveidojiet modeli
Lai redzētu, kā darbojas algoritms, izmantojiet paketi glm (). Vispārējo Lineārais modelis ir kolekcija modeļiem. Pamata sintakse ir:
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")
Jūs esat gatavs novērtēt loģistikas modeli, lai sadalītu ienākumu līmeni starp funkciju kopumu.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Kods Paskaidrojums

formula <- ienākumi ~.: Izveidojiet modeli, lai tas būtu piemērots
logit <- glm (formula, data = data_train, family = 'binomial'): Ievietojiet loģistikas modeli (family = 'binomial') ar data_train datiem.
kopsavilkums (logit): izdrukājiet modeļa kopsavilkumu

Izeja:
#### 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ūsu modeļa kopsavilkums atklāj interesantu informāciju. Loģistiskās regresijas veiktspēju novērtē, izmantojot konkrētus galvenos rādītājus.

AIC (Akaike informācijas kritēriji): tas ir R2 ekvivalents loģistiskajā regresijā. Tas mēra piemērotību, ja parametru skaitam tiek piemērots sods. Mazākas AIC vērtības norāda, ka modelis ir tuvāk patiesībai.
Null novirze: Piemērots modelim tikai ar krustojumu. Brīvības pakāpe ir n-1. Mēs to varam interpretēt kā Chi kvadrāta vērtību (piemērota vērtība atšķiras no faktiskās vērtības hipotēzes pārbaudes).
Atlikusī novirze: modelējiet ar visiem mainīgajiem. To interpretē arī kā Hī kvadrāta hipotēzes pārbaudi.
Fišera vērtēšanas atkārtojumu skaits: pirms apvienošanās atkārtojumu skaits.

Funkcijas glm () izeja tiek saglabāta sarakstā. Zemāk redzamais kods parāda visus vienumus, kas pieejami logit mainīgajā, kuru mēs izveidojām, lai novērtētu loģistikas regresiju.
# Saraksts ir ļoti garš, izdrukājiet tikai pirmos trīs elementus
lapply(logit, class)[1:3]
Izeja:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Katru vērtību var iegūt ar $ zīmi, kam seko metrikas nosaukums. Piemēram, modeli esat saglabājis kā logit. Lai iegūtu AIC kritērijus, izmantojiet:
logit$aic
Izeja:
## [1] 27086.65
7. solis) Novērtējiet modeļa veiktspēju
Apjukuma matrica
Apjukums matrica ir labāka izvēle, lai novērtētu klasifikācijas sniegumu salīdzinājumā ar dažādu metriku redzēja pirms tam. Vispārējā ideja ir saskaitīt reālo gadījumu klasifikācijas reižu skaitu kā nepatiesu.

Lai aprēķinātu neskaidrības matricu, vispirms ir nepieciešams prognožu kopums, lai tos varētu salīdzināt ar faktiskajiem mērķiem.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Kods Paskaidrojums

pareģot (logit, data_test, type = 'response'): aprēķiniet testa kopas prognozi. Iestatiet type = 'response', lai aprēķinātu atbildes varbūtību.
tabula (datu_tests $ ienākumi, paredzēt> 0,5): aprēķiniet neskaidrības matricu. prognozēt> 0,5 nozīmē, ka tas atgriež 1, ja paredzamās varbūtības ir lielākas par 0,5, citādi 0.

Izeja:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Katra sajaukšanas matricas rinda apzīmē faktisko mērķi, bet katra kolonna - paredzamo mērķi. Šīs matricas pirmajā rindā ienākumi ir mazāki par 50 000 (Viltus klase): 6241 tika pareizi klasificēti kā indivīdi, kuru ienākumi ir mazāki par 50 000 ( Patiesībā negatīvs ), bet pārējie kļūdaini tika klasificēti kā virs 50 000 ( Viltus pozitīvi ). Otrajā rindā ienākumi pārsniedz 50 000, pozitīvā klase bija 1229 ( patiess pozitīvs ), bet patiesais negatīvais bija 1074.
Jūs varat aprēķināt modeļa precizitāti , summējot patieso pozitīvo + patieso negatīvo visā novērojumā

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

summa (diag (table_mat)): diagonāles summa
summa (tabulas_mat): matricas summa.

Izeja:
## [1] 0.8277339 
Šķiet, ka modelis cieš no vienas problēmas, tas pārvērtē nepatiesu negatīvu skaitu. To sauc par precizitātes testa paradoksu . Mēs paziņojām, ka precizitāte ir pareizo pareģojumu attiecība pret kopējo gadījumu skaitu. Mums var būt salīdzinoši augsta precizitāte, bet nederīgs modelis. Tas notiek, ja ir dominējošā klase. Atskatoties uz neskaidrības matricu, var redzēt, ka vairums gadījumu tiek klasificēti kā patiesi negatīvi. Iedomājieties tagad, modelis klasificēja visas klases kā negatīvas (ti, zemākas par 50 000). Jūsu precizitāte būtu 75 procenti (6718/6718 + 2257). Jūsu modelis darbojas labāk, bet cenšas atšķirt patieso pozitīvo no patiesā negatīvā.
Šādā situācijā vēlams, lai būtu precīzāka metrika. Mēs varam apskatīt:

Precizitāte = TP / (TP + FP)
Atsaukšana = TP / (TP + FN)

Precizitāte pret atsaukšanu
Precizitāte aplūko pozitīvās prognozes precizitāti. Atsaukšana ir to pozitīvo gadījumu attiecība, kurus klasifikators ir pareizi atklājis;
Lai aprēķinātu šos divus rādītājus, varat izveidot divas funkcijas

Konstruējiet precizitāti

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

mat [1,1]: atgriež datu rāmja pirmās kolonnas pirmo šūnu, ti, patieso pozitīvo
paklājs [1,2]; Atgriež datu rāmja otrās kolonnas pirmo šūnu, ti, kļūdaini pozitīvu

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

mat [1,1]: atgriež datu rāmja pirmās kolonnas pirmo šūnu, ti, patieso pozitīvo
paklājs [2,1]; Atgriež datu rāmja pirmās kolonnas otro šūnu, ti, viltus negatīvu

Jūs varat pārbaudīt savas funkcijas
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Izeja:
## [1] 0.712877## [2] 0.5336518
Kad modelis saka, ka tā ir indivīds virs 50 000, tas ir pareizs tikai 54 procentos gadījumu un 72 procentos gadījumu var pieprasīt personas, kuru garums pārsniedz 50 tūkstošus.
Jūs varat izveidot Ir harmonisks vidējais šo divu metriku, kas nozīmē, tas dod lielāku svaru uz zemākām vērtībām.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Izeja:
## [1] 0.6103799 
Precizitāte pret atsaukšanu
Nav iespējams iegūt gan augstu precizitāti, gan lielu atsaukšanu.
Ja mēs palielināsim precizitāti, pareizais indivīds tiks labāk prognozēts, taču mēs daudzus no tiem palaistu garām (zemāka atsaukšana). Dažās situācijās mēs dodam priekšroku augstākai precizitātei nekā atsaukšana. Starp precizitāti un atsaukšanu ir ieliekta saikne.

Iedomājieties, jums ir jāparedz, vai pacientam ir kāda slimība. Jūs vēlaties būt pēc iespējas precīzāks.
Ja jums ir jāatklāj potenciālie krāpnieki uz ielas, izmantojot sejas atpazīšanu, labāk būtu noķert daudzus cilvēkus, kas apzīmēti kā krāpnieki, lai arī precizitāte ir zema. Policija varēs atbrīvot personu, kas nav krāpnieciska.

ROC līkne
Uztvērējs Darbības Raksturīgs līkne ir vēl viens kopīgs instruments, ko izmanto ar bināro klasifikācijai. Tas ir ļoti līdzīgs precizitātes / atsaukšanas līknei, taču tā vietā, lai uzzīmētu precizitāti pret atsaukšanu, ROC līkne parāda patieso pozitīvo rādītāju (ti, atsaukšanu) pret viltus pozitīvo rādītāju. Viltus pozitīvs rādītājs ir to negatīvo gadījumu attiecība, kuri ir nepareizi klasificēti kā pozitīvi. Tas ir vienāds ar vienu mīnus patieso negatīvo likmi. Patieso negatīvo līmeni sauc arī par specifiskumu . Tādējādi ROC līkne uzrāda jutīgumu (atsaukšanu) pret 1 specifiskumu
Lai uzzīmētu ROC līkni, mums jāinstalē bibliotēka ar nosaukumu RORC. Mēs varam atrast conda bibliotēkā. Jūs varat ierakstīt kodu:
conda install -cr r-rocr - jā
Mēs varam uzzīmēt ROC ar prognozēšanas () un veiktspējas () funkcijām.
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Kods Paskaidrojums

prognoze (prognozēt, datu_tests $ ienākumi): ROCR bibliotēkai ir jāizveido pareģošanas objekts, lai pārveidotu ievadītos datus
veiktspēja (ROCRpred, 'tpr', 'fpr'): atgrieziet abas kombinācijas, kas jāveido diagrammā. Šeit tiek konstruēti tpr un fpr. Kopā uzzīmējiet precizitāti un atsauciet kopā, izmantojiet "prec", "rec".

Izeja:

8. solis. Uzlabojiet modeli
Varat mēģināt modelim pievienot nelinearitāti ar mijiedarbību starp

vecums un stundas.nedēļas laikā
dzimums un stundas nedēļā.

Lai salīdzinātu abus modeļus, jums jāizmanto rezultātu pārbaude
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
Izeja:
## [1] 0.6109181 
Rezultāts ir nedaudz augstāks nekā iepriekšējais. Jūs varat turpināt strādāt ar datiem, mēģinot pārspēt rezultātu.

Kopsavilkums
Zemāk esošajā tabulā mēs varam apkopot loģistiskās regresijas apmācības funkciju:
 

 
 

Iepakojums
 

Mērķis
 

funkciju
 

arguments
 

 

 

 
 

-
 

Izveidojiet vilciena / testa datu kopu
 

create_train_set ()
 

dati, lielums, vilciens
 

 
 

glm
 

Apmāciet vispārinātu lineāro modeli
 

glm ()
 

formula, dati, saime *
 

 
 

glm
 

Apkopojiet modeli
 

kopsavilkums ()
 

aprīkots modelis
 

 
 

bāze
 

Veikt pareģošanu
 

paredzēt ()
 

piemērots modelis, datu kopa, type = 'response'
 

 
 

bāze
 

Izveidojiet neskaidrības matricu
 

tabula()
 

y, paredzēt ()
 

 
 

bāze
 

Izveidojiet precizitātes rādītāju
 

summa (diag (tabula ()) / summa (tabula ()
 

 
 

ROCR
 

Izveidot ROC: 1. solis Izveidojiet prognozi
 

prognoze ()
 

paredzēt (), y
 

 
 

ROCR
 

Izveidojiet ROC: 2. solis Izveidojiet veiktspēju
 

sniegums ()
 

prognoze (), 'tpr', 'fpr'
 

 
 

ROCR
 

Izveidojiet ROC: 3. darbība. Diagrammas diagramma
 

sižets ()
 

sniegums ()
 

 

 

Pārējie GLM modeļu veidi ir:
- binomāls: (link = "logit")
- gaussian: (saite = "identitāte")
- Gamma: (saite = "apgriezts")
- inverse.gaussian: (saite = "1 / mu 2")
- puisons: (link = "log")
- kvazi: (saite = "identitāte", dispersija = "konstante")
- kvazibinomiāls: (link = "logit")
- quasipoisson: (link = "log")