GLM dalam R: Model Linear Umum dengan Contoh

Apa itu regresi Logistik?

Regresi logistik digunakan untuk meramalkan kelas, iaitu, kebarangkalian. Regresi logistik dapat meramalkan hasil binari dengan tepat.

Bayangkan anda ingin meramalkan sama ada pinjaman ditolak / diterima berdasarkan banyak sifat. Regresi logistik adalah dalam bentuk 0/1. y = 0 jika pinjaman ditolak, y = 1 jika diterima.

Model regresi logistik berbeza dengan model regresi linear dalam dua cara.

• Pertama sekali, regresi logistik hanya menerima input dikotom (binari) sebagai pemboleh ubah bersandar (iaitu, vektor 0 dan 1).
• Kedua, hasilnya diukur dengan fungsi pautan probabilistik berikut yang disebut sigmoid kerana berbentuk S:

Output fungsi selalu antara 0 dan 1. Periksa Gambar di bawah

Fungsi sigmoid mengembalikan nilai dari 0 hingga 1. Untuk tugas klasifikasi, kita memerlukan output diskrit 0 atau 1.

Untuk menukar aliran berterusan menjadi nilai diskrit, kita dapat menetapkan keputusan terikat pada 0,5. Semua nilai di atas ambang ini dikelaskan sebagai 1

Dalam tutorial ini, anda akan belajar

• Apa itu regresi Logistik?
• Cara membuat Model Liner Umum (GLM)
• Langkah 1) Periksa pemboleh ubah berterusan
• Langkah 2) Periksa pemboleh ubah faktor
• Langkah 3) Kejuruteraan ciri
• Langkah 4) Statistik Ringkasan
• Langkah 5) Train / set ujian
• Langkah 6) Bina model
• Langkah 7) Menilai prestasi model

Cara membuat Model Liner Umum (GLM)

Mari gunakan set data dewasa untuk menggambarkan regresi Logistik. "Dewasa" adalah set data yang bagus untuk tugas pengelasan. Objektifnya adalah untuk meramalkan sama ada pendapatan tahunan dalam dolar seseorang akan melebihi 50.000. Set data mengandungi 46,033 pemerhatian dan sepuluh ciri:

• umur: umur individu. Berangka
• pendidikan: Tahap pendidikan individu. Faktor.
• perkahwinan.status: Status perkahwinan individu. Faktor iaitu Tidak pernah berkahwin, berkahwin-suami-isteri,…
• jantina: Jantina individu. Faktor, iaitu Lelaki atau Perempuan
• pendapatan: Pemboleh ubah sasaran. Pendapatan di atas atau di bawah 50K. Faktor iaitu> 50K, <= 50K

antara yang lain

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

Pengeluaran:

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… 

Kami akan meneruskan seperti berikut:

• Langkah 1: Periksa pemboleh ubah berterusan
• Langkah 2: Periksa pemboleh ubah faktor
• Langkah 3: Kejuruteraan ciri
• Langkah 4: Ringkasan statistik
• Langkah 5: Set latihan / ujian
• Langkah 6: Bina model
• Langkah 7: Menilai prestasi model
• langkah 8: Memperbaiki model

Tugas anda adalah untuk meramal individu mana yang akan memperoleh pendapatan lebih tinggi daripada 50K.

Dalam tutorial ini, setiap langkah akan diperincikan untuk melakukan analisis pada set data sebenar.

Langkah 1) Periksa pemboleh ubah berterusan

Pada langkah pertama, anda dapat melihat taburan pemboleh ubah berterusan.

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

Penjelasan Kod

• berterusan <- select_if (data_adult, is.numeric): Gunakan fungsi select_if () dari perpustakaan dplyr untuk memilih hanya lajur berangka
• ringkasan (berterusan): Mencetak statistik ringkasan

Pengeluaran:

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

Dari jadual di atas, anda dapat melihat bahawa data mempunyai skala dan jam yang sama sekali berbeza. Setiap minggu mempunyai garis besar (.ie melihat kuartil terakhir dan nilai maksimum).

Anda boleh menanganinya dengan mengikuti dua langkah:

• 1: Buat pembahagian jam.per.week
• 2: Menyeragamkan pemboleh ubah selanjar

1. Buat sebaran

Mari lihat dengan lebih dekat pembahagian jam.per.week

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

Pengeluaran:

Pemboleh ubah mempunyai banyak outliers dan pengedaran yang tidak ditentukan dengan baik. Anda sebahagiannya dapat mengatasi masalah ini dengan menghapus 0.01 peratus jam teratas setiap minggu.

Sintaks asas kuantil:

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.

Kami mengira persentil 2 peratus teratas

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

Penjelasan Kod

• quantile (data_adult $ hours.per.week, .99): Hitung nilai 99 peratus masa bekerja

Pengeluaran:

## 99%## 80 

98 peratus penduduk bekerja di bawah 80 jam seminggu.

Anda boleh menjatuhkan pemerhatian di atas ambang ini. Anda menggunakan penapis dari perpustakaan dplyr.

data_adult_drop <-data_adult %>%filter(hours.per.week
Pengeluaran:
## [1] 45537 10 
 

Menyeragamkan pemboleh ubah selanjar

Anda boleh menyeragamkan setiap lajur untuk meningkatkan prestasi kerana data anda tidak mempunyai skala yang sama. Anda boleh menggunakan fungsi mutate_if dari perpustakaan dplyr. Sintaks asasnya adalah:
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
Anda boleh menyeragamkan lajur angka seperti berikut:
data_adult_rescale <- data_adult_drop % > %mutate_if(is.numeric, funs(as.numeric(scale(.))))head(data_adult_rescale)
Penjelasan Kod

mutate_if (is.numeric, funs (skala)): Syaratnya hanya lajur berangka dan fungsinya adalah skala

Pengeluaran:
## 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
Langkah 2) Periksa pemboleh ubah faktor
Langkah ini mempunyai dua objektif:

Periksa tahap di setiap lajur kategori
Tentukan tahap baru

Kami akan membahagikan langkah ini kepada tiga bahagian:

Pilih lajur kategori
Simpan carta palang setiap lajur dalam senarai
Cetak grafik

Kita boleh memilih lajur faktor dengan kod di bawah:
# Select categorical columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Penjelasan Kod

data.frame (select_if (data_adult, is.factor)): Kami menyimpan lajur faktor dalam faktor dalam jenis bingkai data. Perpustakaan ggplot2 memerlukan objek bingkai data.

Pengeluaran:
## [1] 6 
Set data mengandungi 6 pemboleh ubah kategori
Langkah kedua lebih mahir. Anda ingin membuat carta palang untuk setiap lajur dalam faktor kerangka data. Lebih mudah untuk mengotomatisasi proses, terutama jika terdapat banyak lajur.
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)))
Penjelasan Kod

lapply (): Gunakan fungsi lapply () untuk meneruskan fungsi di semua lajur set data. Anda menyimpan output dalam senarai
fungsi (x): Fungsi akan diproses untuk setiap x. Berikut adalah lajur
ggplot (factor, aes (get (x))) + geom_bar () + theme (axis.text.x = element_text (angle = 90)): Buat carta bar bar untuk setiap elemen x. Perhatikan, untuk mengembalikan x sebagai lajur, anda perlu memasukkannya ke dalam get ()

Langkah terakhir agak mudah. Anda mahu mencetak 6 graf.
# Print the graphgraph
Pengeluaran:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Catatan: Gunakan butang seterusnya untuk menavigasi ke grafik seterusnya

Langkah 3) Kejuruteraan ciri
Pendidikan semula
Dari grafik di atas, anda dapat melihat bahawa pemboleh ubah pendidikan mempunyai 16 tahap. Ini cukup besar, dan beberapa tahap mempunyai jumlah pemerhatian yang agak rendah. Sekiranya anda ingin meningkatkan jumlah maklumat yang anda dapat dari pemboleh ubah ini, anda boleh menyusunnya semula ke tahap yang lebih tinggi. Yaitu, anda membuat kumpulan yang lebih besar dengan tahap pendidikan yang serupa. Sebagai contoh, tahap pendidikan yang rendah akan ditukar dalam keadaan putus sekolah. Tahap pendidikan yang lebih tinggi akan diubah menjadi master.
Inilah perinciannya:
 

 
 

Tahap lama
 

Tahap baru
 

 

 

 
 

Prasekolah
 

tercicir
 

 
 

10hb
 

Tercicir
 

 
 

Ke-11
 

Tercicir
 

 
 

12hb
 

Tercicir
 

 
 

1-4hb
 

Tercicir
 

 
 

5-6hb
 

Tercicir
 

 
 

7-8hb
 

Tercicir
 

 
 

9hb
 

Tercicir
 

 
 

HS-Grad
 

HighGrad
 

 
 

Beberapa kolej
 

Komuniti
 

 
 

Assoc-acdm
 

Komuniti
 

 
 

Assoc-voc
 

Komuniti
 

 
 

Sarjana Muda
 

Sarjana Muda
 

 
 

Tuan
 

Tuan
 

 
 

Prof-sekolah
 

Tuan
 

 
 

Kedoktoran
 

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")))))))
Penjelasan Kod

Kami menggunakan kata kerja mutate dari perpustakaan dplyr. Kami mengubah nilai pendidikan dengan pernyataan ifelse

Dalam jadual di bawah, anda membuat statistik ringkasan untuk melihat, rata-rata, berapa tahun pendidikan (nilai-z) yang diperlukan untuk mencapai Sarjana Muda, Sarjana atau PhD.
recast_data % > %group_by(education) % > %summarize(average_educ_year = mean(educational.num),count = n()) % > %arrange(average_educ_year)
Pengeluaran:
## # 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
Susun semula status perkahwinan
Anda juga boleh membuat tahap yang lebih rendah untuk status perkahwinan. Dalam kod berikut, anda mengubah tahap seperti berikut:
 

 
 

Tahap lama
 

Tahap baru
 

 

 

 
 

Tidak pernah berkahwin
 

Tidak berkahwin
 

 
 

Berkahwin-suami isteri-tidak hadir
 

Tidak berkahwin
 

 
 

Berkahwin-AF-pasangan
 

Berkahwin
 

 
 

Pasangan suami isteri-siv
 
 

 
 

Terpisah
 

Terpisah
 

 
 

Bercerai
 
 

 
 

Janda
 

Janda
 

 

 

 
# 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")))))
 Anda boleh memeriksa bilangan individu dalam setiap kumpulan. 
table(recast_data$marital.status)
Pengeluaran:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Langkah 4) Statistik Ringkasan
Sudah tiba masanya untuk memeriksa beberapa statistik mengenai pemboleh ubah sasaran kami. Dalam grafik di bawah, anda mengira peratusan individu yang berpendapatan lebih daripada 50k berdasarkan jantina mereka.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Pengeluaran:

Seterusnya, periksa sama ada asal usul individu mempengaruhi pendapatan mereka.
# Plot origin incomeggplot(recast_data, aes(x = race, fill = income)) +geom_bar(position = "fill") +theme_classic() +theme(axis.text.x = element_text(angle = 90))
Pengeluaran:

Bilangan jam bekerja mengikut jantina.
# 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()
Pengeluaran:

Petak kotak mengesahkan bahawa pembahagian masa bekerja sesuai dengan kumpulan yang berbeza. Dalam plot kotak, kedua-dua jantina tidak mempunyai pemerhatian yang homogen.
Anda boleh memeriksa ketumpatan waktu kerja mingguan mengikut jenis pendidikan. Pengagihan mempunyai banyak pilihan. Ia mungkin dapat dijelaskan oleh jenis kontrak di AS.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Penjelasan Kod

ggplot (recast_data, aes (x = hours.per.week)): Plot ketumpatan hanya memerlukan satu pemboleh ubah
geom_density (aes (color = education), alpha = 0.5): Objek geometri untuk mengawal ketumpatan

Pengeluaran:

Untuk mengesahkan pendapat anda, anda boleh melakukan ujian ANOVA sehala:
anova <- aov(hours.per.week~education, recast_data)summary(anova)
Pengeluaran:
## 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
Ujian ANOVA mengesahkan perbezaan purata antara kumpulan.
Tidak linear
Sebelum anda menjalankan model, anda dapat melihat apakah bilangan jam bekerja berkaitan dengan usia.
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()
Penjelasan Kod

ggplot (recast_data, aes (x = age, y = hours.per.week)): Tetapkan estetika grafik
geom_point (aes (warna = pendapatan), ukuran = 0.5): Bina plot titik
stat_smooth (): Tambahkan garis aliran dengan argumen berikut:

kaedah = 'lm': Petak nilai yang sesuai jika regresi linier
formula = y ~ poly (x, 2): Sesuai regresi polinomial
se = BENAR: Tambahkan ralat piawai
aes (warna = pendapatan): Pecahkan model mengikut pendapatan



Pengeluaran:

Ringkasnya, anda boleh menguji istilah interaksi dalam model untuk mendapatkan kesan tidak linear antara waktu kerja mingguan dan ciri lain. Penting untuk mengesan dalam keadaan mana masa kerja berbeza.
Korelasi
Pemeriksaan seterusnya adalah untuk menggambarkan hubungan antara pemboleh ubah. Anda menukar jenis tahap faktor menjadi angka sehingga anda dapat membuat peta haba yang mengandungi pekali korelasi yang dihitung dengan kaedah Spearman.
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")
Penjelasan Kod

data.frame (lapply (recast_data, as.integer)): Menukar data menjadi angka
ggcorr () plot peta panas dengan argumen berikut:

kaedah: Kaedah untuk mengira korelasi
nbreaks = 6: Bilangan rehat
hjust = 0.8: Kedudukan kawalan nama pemboleh ubah dalam plot
label = BENAR: Tambahkan label di tengah tingkap
label_size = 3: Label saiz
color = "grey50"): Warna label



Pengeluaran:

Langkah 5) Train / set ujian
Sebarang tugas pembelajaran mesin yang diawasi memerlukan pemisahan data antara satu set kereta api dan satu set ujian. Anda boleh menggunakan "fungsi" yang anda buat dalam tutorial pembelajaran yang diawasi yang lain untuk membuat set kereta / ujian.
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)
Pengeluaran:
## [1] 36429 9
 
dim(data_test)
Pengeluaran:
## [1] 9108 9 
Langkah 6) Bina model
Untuk melihat bagaimana algoritma berfungsi, anda menggunakan pakej glm (). The Teritlak Linear Model adalah koleksi model. Sintaks asasnya adalah:
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")
Anda sudah bersedia untuk menganggarkan model logistik untuk membahagikan tahap pendapatan antara satu set ciri.
formula <- income~.logit <- glm(formula, data = data_train, family = 'binomial')summary(logit)
Penjelasan Kod

formula <- pendapatan ~.: Buat model yang sesuai
logit <- glm (formula, data = data_train, family = 'binomial'): Pasangkan model logistik (keluarga = 'binomial') dengan data data_train.
ringkasan (logit): Mencetak ringkasan model

Pengeluaran:
#### 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
Ringkasan model kami mendedahkan maklumat menarik. Prestasi regresi logistik dinilai dengan metrik utama tertentu.

AIC (Kriteria Maklumat Akaike): Ini bersamaan dengan R2 dalam regresi logistik. Ini mengukur kesesuaian apabila penalti dikenakan pada jumlah parameter. Nilai AIC yang lebih kecil menunjukkan model lebih dekat dengan kebenaran.
Null deviance: Sesuai dengan model hanya dengan pintasan. Tahap kebebasan adalah n-1. Kita boleh mentafsirkannya sebagai nilai Chi-square (nilai dipasang berbeza dari ujian hipotesis nilai sebenar).
Residual Deviance: Model dengan semua pemboleh ubah. Ia juga ditafsirkan sebagai ujian hipotesis Chi-square.
Bilangan iterasi Pemarkahan Fisher: Bilangan lelaran sebelum melakukan penumpuan.

Output fungsi glm () disimpan dalam senarai. Kod di bawah menunjukkan semua item yang terdapat dalam pemboleh ubah logit yang kami bina untuk menilai regresi logistik.
# Senarai sangat panjang, hanya mencetak tiga elemen pertama
lapply(logit, class)[1:3]
Pengeluaran:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Setiap nilai dapat diekstrak dengan tanda $ diikuti dengan nama metrik. Contohnya, anda menyimpan model sebagai logit. Untuk mengekstrak kriteria AIC, anda menggunakan:
logit$aic
Pengeluaran:
## [1] 27086.65
Langkah 7) Menilai prestasi model
Matriks Kekeliruan
The kekeliruan matriks adalah pilihan yang lebih baik untuk menilai prestasi klasifikasi berbanding dengan metrik yang berbeza anda lihat sebelum ini. Idea umum adalah untuk mengira berapa kali Contoh sebenar dikelaskan adalah Salah.

Untuk mengira matriks kekeliruan, pertama-tama anda perlu mempunyai satu set ramalan sehingga dapat dibandingkan dengan sasaran sebenarnya.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Penjelasan Kod

ramalkan (logit, data_test, type = 'respons'): Hitung ramalan pada set ujian. Tetapkan jenis = 'tindak balas' untuk mengira kebarangkalian tindak balas.
jadual (data_test $ pendapatan, ramalkan> 0.5): Hitung matriks kekeliruan. ramalkan> 0.5 bermaksud mengembalikan 1 jika kebarangkalian yang diramalkan melebihi 0.5, jika tidak 0.

Pengeluaran:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Setiap baris dalam matriks kebingungan mewakili sasaran sebenar, sementara setiap lajur mewakili sasaran yang diramalkan. Baris pertama matriks ini menganggap pendapatan lebih rendah daripada 50k (kelas Salah): 6241 diklasifikasikan dengan betul sebagai individu dengan pendapatan lebih rendah daripada 50k ( Betul negatif ), sementara selebihnya salah dikelaskan sebagai melebihi 50k ( Palsu positif ). Baris kedua menganggap pendapatan melebihi 50k, kelas positif adalah 1229 ( Benar positif ), sementara Benar negatif adalah 1074.
Anda boleh mengira ketepatan model dengan menjumlahkan positif positif + benar benar daripada keseluruhan pemerhatian

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

jumlah (diag (table_mat)): Jumlah pepenjuru
jumlah (table_mat): Jumlah matriks.

Pengeluaran:
## [1] 0.8277339 
Model itu nampaknya menderita satu masalah, ia melebih-lebihkan jumlah negatif palsu. Ini dipanggil paradoks ujian ketepatan . Kami menyatakan bahawa ketepatan adalah nisbah ramalan yang betul dengan jumlah kes. Kita boleh mempunyai ketepatan yang agak tinggi tetapi model yang tidak berguna. Ia berlaku apabila ada kelas yang dominan. Sekiranya anda melihat kembali matriks kekeliruan, anda dapat melihat kebanyakan kes diklasifikasikan sebagai benar negatif. Bayangkan sekarang, model mengelaskan semua kelas sebagai negatif (iaitu lebih rendah daripada 50k). Anda akan mempunyai ketepatan 75 peratus (6718/6718 + 2257). Model anda berprestasi lebih baik tetapi sukar untuk membezakan yang positif dengan yang sebenarnya.
Dalam keadaan seperti itu, lebih baik mempunyai metrik yang lebih ringkas. Kita boleh melihat:

Ketepatan = TP / (TP + FP)
Ingat semula = TP / (TP + FN)

Precision vs Recall
Ketepatan melihat ketepatan ramalan positif. Ingat adalah nisbah keadaan positif yang dikesan dengan betul oleh pengkelas;
Anda boleh membina dua fungsi untuk mengira dua metrik ini

Bentukkan ketepatan

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

mat [1,1]: Kembalikan sel pertama lajur pertama kerangka data, iaitu positif sebenarnya
tikar [1,2]; Kembalikan sel pertama lajur kedua kerangka data, iaitu positif palsu

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

mat [1,1]: Kembalikan sel pertama lajur pertama kerangka data, iaitu positif sebenarnya
tikar [2,1]; Kembalikan sel kedua lajur pertama bingkai data, iaitu negatif palsu

Anda boleh menguji fungsi anda
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Pengeluaran:
## [1] 0.712877## [2] 0.5336518
Apabila model mengatakan ia adalah individu yang melebihi 50k, betul hanya 54 peratus kes, dan boleh menuntut individu yang melebihi 50k dalam 72 peratus kes.
Anda boleh membuat adalah min harmonik dari kedua metrik ini, yang bermaksud memberi lebih banyak berat kepada nilai yang lebih rendah.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Pengeluaran:
## [1] 0.6103799 
Ketepatan vs Recall tradeoff
Tidak mungkin mempunyai ketepatan tinggi dan penarikan balik yang tinggi.
Sekiranya kita meningkatkan ketepatan, individu yang betul akan dapat diramalkan dengan lebih baik, tetapi kita akan kehilangan banyak (penarikan balik yang lebih rendah). Dalam beberapa keadaan, kami lebih suka ketepatan yang lebih tinggi daripada mengingat. Terdapat hubungan cekung antara ketepatan dan penarikan balik.

Bayangkan, anda perlu meramalkan jika pesakit mempunyai penyakit. Anda mahu setepat mungkin.
Sekiranya anda perlu mengesan orang berpotensi melakukan penipuan di jalanan melalui pengecaman wajah, lebih baik menangkap banyak orang yang dilabel sebagai penipu walaupun ketelitiannya rendah. Polis akan dapat membebaskan individu yang tidak menipu itu.

Keluk ROC
The Ciri-ciri Penerima Operasi lengkung adalah satu lagi alat yang biasa digunakan dengan klasifikasi binari. Ini sangat serupa dengan kurva ketepatan / ingat, tetapi bukannya merancang ketepatan berbanding penarikan balik, lengkung ROC menunjukkan kadar positif yang sebenarnya (iaitu, penarikan) terhadap kadar positif palsu. Kadar positif palsu adalah nisbah contoh negatif yang salah diklasifikasikan sebagai positif. Ia sama dengan satu tolak kadar negatif yang sebenarnya. Kadar negatif sebenarnya juga disebut kekhususan . Oleh itu, keluk ROC memplot kepekaan (ingat) berbanding 1-kekhususan
Untuk merancang keluk ROC, kita perlu memasang perpustakaan yang disebut RORC. Kita dapati di perpustakaan conda. Anda boleh menaip kod:
conda install -cr r-rocr --yes
Kita boleh merancang ROC dengan fungsi ramalan () dan prestasi ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Penjelasan Kod

ramalan (ramalan, data_test $ income): Perpustakaan ROCR perlu membuat objek ramalan untuk mengubah data input
prestasi (ROCRpred, 'tpr', 'fpr'): Kembalikan dua kombinasi yang akan dihasilkan dalam grafik. Di sini, tpr dan fpr dibina. Tentukan plot ketepatan dan ingat semula, gunakan "tepat", "rec".

Pengeluaran:

Langkah 8) Perbaiki model
Anda boleh mencuba menambahkan non-linear pada model dengan interaksi antara

umur dan jam.per.week
jantina dan jam.per.week.

Anda perlu menggunakan ujian skor untuk membandingkan kedua-dua model
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
Pengeluaran:
## [1] 0.6109181 
Skornya sedikit lebih tinggi daripada yang sebelumnya. Anda boleh terus menggunakan data untuk mencuba skor.

Ringkasan
Kita dapat meringkaskan fungsi untuk melatih regresi logistik dalam jadual di bawah:
 

 
 

Pakej
 

Objektif
 

fungsi
 

hujah
 

 

 

 
 

-
 

Buat set data kereta api / ujian
 

buat_train_set ()
 

data, saiz, kereta api
 

 
 

glm
 

Latih Model Linear Umum
 

glm ()
 

formula, data, keluarga *
 

 
 

glm
 

Ringkaskan model
 

ringkasan ()
 

model yang dipasang
 

 
 

pangkalan
 

Buat ramalan
 

meramalkan()
 

model yang dipasang, set data, type = 'respons'
 

 
 

pangkalan
 

Buat matriks kekeliruan
 

jadual ()
 

y, ramalkan ()
 

 
 

pangkalan
 

Buat skor ketepatan
 

jumlah (diag (jadual ()) / jumlah (jadual ()
 

 
 

ROCR
 

Buat ROC: Langkah 1 Buat ramalan
 

ramalan ()
 

ramalkan (), y
 

 
 

ROCR
 

Buat ROC: Langkah 2 Buat prestasi
 

prestasi ()
 

ramalan (), 'tpr', 'fpr'
 

 
 

ROCR
 

Buat ROC: Langkah 3 Grafik plot
 

plot ()
 

prestasi ()
 

 

 

Model GLM yang lain adalah:
- binomial: (pautan = "logit")
- gaussian: (pautan = "identiti")
- Gamma: (pautan = "terbalik")
- inverse.gaussian: (pautan = "1 / mu 2")
- poisson: (pautan = "log")
- kuasi: (pautan = "identiti", varians = "pemalar")
- quasibinomial: (pautan = "logit")
- quasipoisson: (pautan = "log")