GLM i R: Generaliseret lineær model med eksempel

Hvad er logistisk regression?

Logistisk regression bruges til at forudsige en klasse, dvs. en sandsynlighed. Logistisk regression kan forudsige et binært resultat nøjagtigt.

Forestil dig, at du vil forudsige, om et lån nægtes / accepteres baseret på mange attributter. Den logistiske regression er af formen 0/1. y = 0, hvis et lån afvises, y = 1, hvis det accepteres.

En logistisk regressionsmodel adskiller sig fra lineær regressionsmodel på to måder.

• Først og fremmest accepterer den logistiske regression kun dikotom (binær) input som en afhængig variabel (dvs. en vektor på 0 og 1).
• For det andet måles resultatet ved hjælp af følgende sandsynlighedsfunktion kaldet sigmoid på grund af sin S-formede .:

Funktionens output er altid mellem 0 og 1. Kontroller billedet nedenfor

Sigmoid-funktionen returnerer værdier fra 0 til 1. For klassificeringsopgaven har vi brug for et diskret output på 0 eller 1.

For at konvertere en kontinuerlig strøm til en diskret værdi kan vi indstille en beslutning bundet til 0,5. Alle værdier over denne tærskel er klassificeret som 1

I denne vejledning lærer du

• Hvad er logistisk regression?
• Sådan oprettes Generalized Liner Model (GLM)
• Trin 1) Kontroller kontinuerlige variabler
• Trin 2) Kontroller faktorvariabler
• Trin 3) Funktionsteknik
• Trin 4) Statistik
• Trin 5) Tog / testsæt
• Trin 6) Byg modellen
• Trin 7) Vurdér modelens ydeevne

Sådan oprettes Generalized Liner Model (GLM)

Lad os bruge datasættet for voksne til at illustrere logistisk regression. "Voksen" er et fantastisk datasæt til klassificeringsopgaven. Målet er at forudsige, om den enkeltes årlige indkomst i dollar vil overstige 50.000. Datasættet indeholder 46.033 observationer og ti funktioner:

• alder: individets alder. Numerisk
• uddannelse: individets uddannelsesniveau. Faktor.
• marital.status: Individets civilstand. Faktor dvs. aldrig gift, gift-civ-ægtefælle, ...
• køn: individets køn. Faktor, dvs. mand eller kvinde
• indkomst: Målvariabel. Indkomst over eller under 50K. Faktor dvs.> 50K, <= 50K

blandt andre

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

Produktion:

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… 

Vi fortsætter som følger:

• Trin 1: Kontroller kontinuerlige variabler
• Trin 2: Kontroller faktorvariabler
• Trin 3: Funktionsteknik
• Trin 4: Oversigtsstatistik
• Trin 5: Træn / testsæt
• Trin 6: Byg modellen
• Trin 7: Vurdér modelens ydeevne
• trin 8: Forbedre modellen

Din opgave er at forudsige, hvilken person der vil have en omsætning højere end 50K.

I denne vejledning vil hvert trin blive detaljeret for at udføre en analyse på et ægte datasæt.

Trin 1) Kontroller kontinuerlige variabler

I det første trin kan du se fordelingen af ​​de kontinuerlige variabler.

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

Kode Forklaring

• kontinuerlig <- select_if (data_adult, is.numeric): Brug funktionen select_if () fra dplyr-biblioteket til kun at vælge de numeriske kolonner
• resume (kontinuerlig): Udskriv oversigtsstatistikken

Produktion:

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

Fra ovenstående tabel kan du se, at dataene har helt forskellige skalaer og hours.per.weeks har store outliers (.de ser på den sidste kvartil og maksimale værdi).

Du kan håndtere det ved at følge to trin:

• 1: Planlæg fordeling af timer. Pr. Uge
• 2: Standardiser de kontinuerlige variabler

1. Plot distributionen

Lad os se nærmere på fordelingen af ​​hours.per.week

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

Produktion:

Variablen har mange outliers og ikke veldefineret distribution. Du kan delvis tackle dette problem ved at slette de øverste 0,01 procent af timerne om ugen.

Grundlæggende syntaks for kvantil:

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.

Vi beregner den øverste 2-percentil

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

Kode Forklaring

• kvantil (data_adult $ hours.per.week, .99): Beregn værdien af ​​99 procent af arbejdstiden

Produktion:

## 99%## 80 

98 procent af befolkningen arbejder under 80 timer om ugen.

Du kan slippe observationerne over denne tærskel. Du bruger filteret fra dplyr-biblioteket.

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


## [1] 45537 10 
 

Standardiser de kontinuerlige variabler

Du kan standardisere hver kolonne for at forbedre ydeevnen, fordi dine data ikke har samme skala. Du kan bruge funktionen mutate_if fra dplyr-biblioteket. Den grundlæggende syntaks er:
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
Du kan standardisere de numeriske kolonner som følger:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Kode Forklaring

mutate_if (is.numeric, funs (scale)): Betingelsen er kun numerisk kolonne, og funktionen er skala

Produktion:
## 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
Trin 2) Kontroller faktorvariabler
Dette trin har to mål:

Kontroller niveauet i hver kategoriske kolonne
Definer nye niveauer

Vi deler dette trin i tre dele:

Vælg de kategoriske kolonner
Gem stregdiagrammet for hver kolonne på en liste
Udskriv graferne

Vi kan vælge faktorkolonnerne med nedenstående kode:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Kode Forklaring

data.frame (select_if (data_adult, is.factor)): Vi gemmer faktorkolonnerne i faktor i en datarammetype. Biblioteket ggplot2 kræver et datarammeobjekt.

Produktion:
## [1] 6 
Datasættet indeholder 6 kategoriske variabler
Det andet trin er mere dygtig. Du vil plotte et søjlediagram for hver kolonne i datarammefaktoren. Det er mere praktisk at automatisere processen, især hvis der er mange kolonner.
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)))
Kode Forklaring

lapply (): Brug funktionen lapply () til at videregive en funktion i alle kolonnerne i datasættet. Du gemmer output på en liste
funktion (x): Funktionen behandles for hver x. Her er x kolonnerne
ggplot (faktor, aes (get (x))) + geom_bar () + tema (axis.text.x = element_text (vinkel = 90)): Opret et søjlediagram for hvert x-element. Bemærk, for at returnere x som en kolonne skal du medtage den inde i get ()

Det sidste trin er relativt let. Du vil udskrive de 6 grafer.
# Print the graphgraph
Produktion:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Bemærk: Brug den næste knap til at navigere til den næste graf

Trin 3) Funktionsteknik
Omarbejdet uddannelse
Fra grafen ovenfor kan du se, at den variable uddannelse har 16 niveauer. Dette er væsentligt, og nogle niveauer har et relativt lavt antal observationer. Hvis du vil forbedre mængden af ​​information, du kan få fra denne variabel, kan du omlægge den til et højere niveau. Du opretter nemlig større grupper med lignende uddannelsesniveau. For eksempel vil lavt uddannelsesniveau blive konverteret til frafald. Højere uddannelsesniveauer vil blive ændret til at mestre.
Her er detaljerne:
 

 
 

Gammelt niveau
 

Nyt niveau
 

 

 

 
 

Førskole
 

droppe ud
 

 
 

10.
 

Droppe ud
 

 
 

11.
 

Droppe ud
 

 
 

12.
 

Droppe ud
 

 
 

1.-4
 

Droppe ud
 

 
 

5.-6
 

Droppe ud
 

 
 

7.-8
 

Droppe ud
 

 
 

9.
 

Droppe ud
 

 
 

HS-Grad
 

HighGrad
 

 
 

Et eller andet universitet
 

Fællesskab
 

 
 

Assoc-acdm
 

Fællesskab
 

 
 

Assoc-voc
 

Fællesskab
 

 
 

Bachelorer
 

Bachelorer
 

 
 

Mestre
 

Mestre
 

 
 

Prof-skole
 

Mestre
 

 
 

Doktorgrad
 

Ph.d.
 

 

 

 
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")))))))
Kode Forklaring

Vi bruger verbet mutere fra dplyr-biblioteket. Vi ændrer uddannelsesværdierne med udsagnet ifelse

I nedenstående tabel opretter du en oversigtsstatistik for i gennemsnit at se, hvor mange års uddannelse (z-værdi) det tager at nå Bachelor, Master eller PhD.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Produktion:
## # 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
Omarbejdning Ægteskabelig status
Det er også muligt at skabe lavere niveauer for civilstand. I følgende kode ændrer du niveauet som følger:
 

 
 

Gammelt niveau
 

Nyt niveau
 

 

 

 
 

Aldrig gift
 

Ikke gift
 

 
 

Gift-ægtefælle-fraværende
 

Ikke gift
 

 
 

Gift-AF-ægtefælle
 

Gift
 

 
 

Gift-civ-ægtefælle
 
 

 
 

Adskilt
 

Adskilt
 

 
 

Skilt
 
 

 
 

Enker
 

Enke
 

 

 

 
# 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")))))
 Du kan kontrollere antallet af personer inden for hver gruppe. 
table(recast_data$marital.status)
Produktion:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Trin 4) Statistik
Det er tid til at tjekke nogle statistikker om vores målvariabler. I nedenstående graf tæller du procentdelen af ​​enkeltpersoner, der tjener mere end 50.000, givet deres køn.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Produktion:

Dernæst skal du kontrollere, om individets oprindelse påvirker deres indtjening.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Produktion:

Antallet af arbejdstimer fordelt på køn.
# 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()
Produktion:

Boksen viser, at fordelingen af ​​arbejdstid passer til forskellige grupper. I boksplottet har begge køn ikke homogene observationer.
Du kan kontrollere tætheden af ​​den ugentlige arbejdstid efter uddannelsestype. Distributionerne har mange forskellige valg. Det kan sandsynligvis forklares med typen af ​​kontrakt i USA.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Kode Forklaring

ggplot (recast_data, aes (x = hours.per.week)): En densitetsplot kræver kun en variabel
geom_density (aes (farve = uddannelse), alfa = 0,5): Det geometriske objekt til at kontrollere tætheden

Produktion:

For at bekræfte dine tanker kan du udføre en envejs ANOVA-test:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Produktion:
## 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-testen bekræfter forskellen i gennemsnit mellem grupper.
Ikke-linearitet
Før du kører modellen, kan du se, om antallet af arbejdede timer er relateret til alder.
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()
Kode Forklaring

ggplot (recast_data, aes (x = alder, y = hours.per.week)): Indstil æstetikken i grafen
geom_point (aes (farve = indkomst), størrelse = 0,5): Konstruer prikplottet
stat_smooth (): Tilføj trendlinjen med følgende argumenter:

metode = 'lm': Plot den monterede værdi, hvis den lineære regression er
formel = y ~ poly (x, 2): Tilpas en polynomial regression
se = SAND: Tilføj standardfejlen
aes (farve = indkomst): Opdel modellen efter indkomst



Produktion:

I en nøddeskal kan du teste interaktionsudtryk i modellen for at opfange den ikke-lineære effekt mellem den ugentlige arbejdstid og andre funktioner. Det er vigtigt at opdage, under hvilken tilstand arbejdstiden afviger.
Korrelation
Den næste kontrol er at visualisere sammenhængen mellem variablerne. Du konverterer faktorniveautypen til numerisk, så du kan plotte et varmekort indeholdende korrelationskoefficienten beregnet med Spearman-metoden.
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")
Kode Forklaring

data.frame (lapply (recast_data, as.integer)): Konverter data til numerisk
ggcorr () plotte varmekortet med følgende argumenter:

metode: Metode til beregning af korrelationen
nbrud = 6: Antal brud
hjust = 0,8: Kontrolposition for variabelnavnet i plottet
label = TRUE: Tilføj labels i midten af ​​vinduerne
label_size = 3: Størrelsesetiketter
color = "grey50"): Farven på etiketten



Produktion:

Trin 5) Tog / testsæt
Enhver overvåget maskinlæringsopgave kræver, at data opdeles mellem et togsæt og et testsæt. Du kan bruge den "funktion", du oprettede i de andre overvågede læringsvejledninger til at oprette et tog / testsæt.
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)
Produktion:
## [1] 36429 9
 
dim(data_test)
Produktion:
## [1] 9108 9 
Trin 6) Byg modellen
For at se, hvordan algoritmen fungerer, bruger du pakken glm (). Den generaliserede lineære model er en samling modeller. Den grundlæggende syntaks er:
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")
Du er klar til at estimere den logistiske model for at opdele indkomstniveauet mellem et sæt funktioner.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Kode Forklaring

formel <- indkomst ~.: Opret modellen, så den passer
logit <- glm (formel, data = data_train, family = 'binomial'): Tilpas en logistisk model (family = 'binomial') med data_train-dataene.
resume (logit): Udskriv resuméet af modellen

Produktion:
#### 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
Resumeet af vores model afslører interessante oplysninger. Udførelsen af ​​en logistisk regression evalueres med specifikke nøglemålinger.

AIC (Akaike Information Criteria): Dette svarer til R2 i logistisk regression. Det måler pasformen, når der pålægges en straf på antallet af parametre. Mindre AIC- værdier indikerer, at modellen er tættere på sandheden.
Null afvigelse: Passer kun til modellen med aflytningen. Graden af ​​frihed er n-1. Vi kan fortolke det som en Chi-kvadratværdi (tilpasset værdi forskellig fra den aktuelle værdihypotesetestning).
Restafvigelse: Model med alle variabler. Det fortolkes også som en Chi-kvadratisk hypotesetest.
Antal Fisher-scorings-iterationer: Antal iterationer inden konvergerende.

Udgangen af ​​funktionen glm () er gemt på en liste. Koden nedenfor viser alle de tilgængelige poster i logit-variablen, som vi konstruerede for at evaluere den logistiske regression.
# Listen er meget lang, kun udskriv de første tre elementer
lapply(logit, class)[1:3]
Produktion:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Hver værdi kan ekstraheres med $ -tegnet, og følg navnet på metrics. For eksempel lagrede du modellen som logit. For at udtrække AIC-kriterierne bruger du:
logit$aic
Produktion:
## [1] 27086.65
Trin 7) Vurdér modelens ydeevne
Forvirringsmatrix
Den forvirring matrix er et bedre valg for at evaluere klassificeringen ydeevne i forhold til de forskellige målinger, du så før. Den generelle idé er at tælle antallet af gange, hvor sande forekomster klassificeres som falske.

For at beregne forvirringsmatrixen skal du først have et sæt forudsigelser, så de kan sammenlignes med de faktiske mål.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Kode Forklaring

forudsig (logit, data_test, type = 'respons'): Beregn forudsigelsen på testsættet. Indstil type = 'respons' for at beregne svarets sandsynlighed.
tabel (data_test $ indkomst, forudsig> 0,5): Beregn forvirringsmatrixen. forudsig> 0,5 betyder, at den returnerer 1, hvis de forudsagte sandsynligheder er over 0,5, ellers 0.

Produktion:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Hver række i en forvirringsmatrix repræsenterer et faktisk mål, mens hver kolonne repræsenterer et forudsagt mål. Den første række i denne matrix betragter indkomsten lavere end 50k (den falske klasse): 6241 blev korrekt klassificeret som individer med en indkomst under 50k ( sandt negativ ), mens den resterende blev forkert klassificeret som over 50k ( falsk positiv ). Den anden række betragter indkomsten over 50k, den positive klasse var 1229 ( sandt positiv ), mens den sande negativ var 1074.
Du kan beregne modelnøjagtigheden ved at summere den sande positive + sande negative over den samlede observation

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

sum (diag (tabel_mat)): Summen af ​​diagonalen
sum (table_mat): Summen af ​​matrixen.

Produktion:
## [1] 0.8277339 
Modellen ser ud til at lide af et problem, det overvurderer antallet af falske negativer. Dette kaldes nøjagtighedstestparadoxet . Vi sagde, at nøjagtigheden er forholdet mellem korrekte forudsigelser og det samlede antal sager. Vi kan have relativt høj nøjagtighed, men en ubrugelig model. Det sker, når der er en dominerende klasse. Hvis du ser tilbage på forvirringsmatrixen, kan du se, at de fleste tilfælde er klassificeret som ægte negative. Forestil dig nu, at modellen klassificerede alle klasser som negative (dvs. lavere end 50k). Du ville have en nøjagtighed på 75 procent (6718/6718 + 2257). Din model klarer sig bedre, men kæmper for at skelne mellem det sande positive og det sande negative.
I en sådan situation foretrækkes det at have en mere kortfattet metrik. Vi kan se på:

Præcision = TP / (TP + FP)
Recall = TP / (TP + FN)

Præcision vs tilbagekaldelse
Præcision ser på nøjagtigheden af ​​den positive forudsigelse. Recall er forholdet mellem positive forekomster, der registreres korrekt af klassifikatoren;
Du kan konstruere to funktioner til at beregne disse to metrics

Konstruer præcision

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

mat [1,1]: Returner den første celle i den første kolonne i datarammen, dvs. den sande positive
måtte [1,2]; Returner den første celle i den anden kolonne i datarammen, dvs. den falske positive

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

mat [1,1]: Returner den første celle i den første kolonne i datarammen, dvs. den sande positive
måtte [2,1]; Returner den anden celle i den første kolonne i datarammen, dvs. falsk negativ

Du kan teste dine funktioner
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Produktion:
## [1] 0.712877## [2] 0.5336518
Når modellen siger, at det er et individ over 50k, er det korrekt i kun 54 procent af sagen og kan kræve individer over 50k i 72 procent af sagen.
Du kan oprette er et harmonisk gennemsnit af disse to målinger, hvilket betyder at det giver de lavere værdier større vægt.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Produktion:
## [1] 0.6103799 
Præcision vs tilbagekald afvejning
Det er umuligt at have både høj præcision og høj tilbagekaldelse.
Hvis vi øger præcisionen, forudsiges det rigtige individ bedre, men vi ville savne mange af dem (lavere tilbagekaldelse). I nogle situationer foretrækker vi højere præcision end tilbagekaldelse. Der er et konkavt forhold mellem præcision og tilbagekaldelse.

Forestil dig, du skal forudsige, om en patient har en sygdom. Du vil være så præcis som muligt.
Hvis du har brug for at opdage potentielle bedrageriske mennesker på gaden gennem ansigtsgenkendelse, ville det være bedre at fange mange mennesker, der er mærket som svigagtige, selvom præcisionen er lav. Politiet vil være i stand til at frigive den ikke-bedrageriske person.

ROC-kurven
Den Receiver Operating Karakteristisk kurve er en anden almindelig værktøj, der anvendes med binær klassificering. Det svarer meget til præcision / tilbagekaldelseskurven, men i stedet for at tegne præcision versus tilbagekaldelse viser ROC-kurven den sande positive hastighed (dvs. tilbagekaldelse) mod den falske positive hastighed. Den falsk positive sats er forholdet mellem negative forekomster, der forkert klassificeres som positive. Det er lig med en minus den sande negative sats. Den sande negative sats kaldes også specificitet . Derfor viser ROC-kurven følsomhed (tilbagekaldelse) versus 1-specificitet
For at plotte ROC-kurven skal vi installere et bibliotek kaldet RORC. Vi kan finde i conda-biblioteket. Du kan skrive koden:
conda install -cr r-rocr - ja
Vi kan plotte ROC med funktionerne prediction () og performance ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Kode Forklaring

forudsigelse (forudsig, data_test $ indkomst): ROCR-biblioteket har brug for at oprette et forudsigelsesobjekt for at transformere inputdataene
performance (ROCRpred, 'tpr', 'fpr'): Returner de to kombinationer, der skal produceres i grafen. Her konstrueres tpr og fpr. Tot plot præcision og husk sammen, brug "prec", "rec".

Produktion:

Trin 8) Forbedre modellen
Du kan prøve at tilføje ikke-linearitet til modellen med interaktionen mellem

alder og timer. pr. uge
køn og timer. pr. uge.

Du skal bruge scoretesten til at sammenligne begge modeller
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
Produktion:
## [1] 0.6109181 
Scoren er lidt højere end den forrige. Du kan fortsætte med at arbejde på dataene og prøve at slå score.

Resumé
Vi kan opsummere funktionen til at træne en logistisk regression i nedenstående tabel:
 

 
 

Pakke
 

Objektiv
 

fungere
 

argument
 

 

 

 
 

-
 

Opret tog / test datasæt
 

create_train_set ()
 

data, størrelse, tog
 

 
 

glm
 

Træn en generaliseret lineær model
 

glm ()
 

formel, data, familie *
 

 
 

glm
 

Opsummer modellen
 

Resumé()
 

monteret model
 

 
 

grundlag
 

Forudsig
 

forudsige()
 

monteret model, datasæt, type = 'respons'
 

 
 

grundlag
 

Opret en forvirringsmatrix
 

bord()
 

y, forudsig ()
 

 
 

grundlag
 

Opret nøjagtighedsscore
 

sum (diag (tabel ()) / sum (tabel ()
 

 
 

ROCR
 

Opret ROC: Trin 1 Opret forudsigelse
 

forudsigelse ()
 

forudsige (), y
 

 
 

ROCR
 

Opret ROC: Trin 2 Opret ydeevne
 

ydeevne()
 

forudsigelse (), 'tpr', 'fpr'
 

 
 

ROCR
 

Opret ROC: Trin 3 plotdiagram
 

grund()
 

ydeevne()
 

 

 

De andre GLM- modeller er:
- binomial: (link = "logit")
- gaussisk: (link = "identitet")
- Gamma: (link = "invers")
- inverse.gaussian: (link = "1 / mu 2")
- poisson: (link = "log")
- kvasi: (link = "identitet", varians = "konstant")
- kvasibinomial: (link = "logit")
- quasipoisson: (link = "log")