R'de GLM: Örnekle Genelleştirilmiş Doğrusal Model
Evelyn Clarke
Lojistik regresyon nedir?
Lojistik regresyon bir sınıfı, yani bir olasılığı tahmin etmek için kullanılır. Lojistik regresyon ikili bir sonucu doğru bir şekilde tahmin edebilir.
Birçok özelliğe dayanarak bir kredinin reddedilip kabul edilmeyeceğini tahmin etmek istediğinizi düşünün. Lojistik regresyon 0/1 formundadır. Bir kredi reddedilirse y = 0, kabul edilirse y = 1.
Lojistik regresyon modeli doğrusal regresyon modelinden iki açıdan farklılık gösterir.
- Her şeyden önce, lojistik regresyon bağımlı değişken (yani 0 ve 1 vektörü) olarak yalnızca ikili (ikili) girdiyi kabul eder.
- İkinci olarak, sonuç şu olasılıksal bağlantı fonksiyonu ile ölçülür: sigmoid S şeklindeki nedeniyle.:
Fonksiyonun çıkışı her zaman 0 ile 1 arasındadır. Aşağıdaki Resmi Kontrol Edin
Sigmoid işlevi 0'dan 1'e kadar değerler döndürür. Sınıflandırma görevi için 0 veya 1 şeklinde ayrık bir çıktıya ihtiyacımız var.
Sürekli bir akışı ayrık değere dönüştürmek için 0.5 sınırını belirleyebiliriz. Bu eşiğin üzerindeki tüm değerler 1 olarak sınıflandırılır
Genelleştirilmiş Astar Modeli (GLM) nasıl oluşturulur?
Kullanalım yetişkin Lojistik regresyonu gösteren veri seti. "Yetişkin", sınıflandırma görevi için harika bir veri kümesidir. Amaç, bir bireyin dolar cinsinden yıllık gelirinin 50.000 doları aşıp aşmayacağını tahmin etmektir. Veri seti 46,033 gözlem ve on özellik içeriyor:
- yaş: bireyin yaşı. Sayısal
- eğitim: Bireyin eğitim düzeyi. Faktör.
- medeni.durum: Maribireyin tal durumu. Faktör yani Hiç evlenmemiş, Evli-vatandaş-eş,…
- cinsiyet: Bireyin cinsiyeti. Faktör, yani Erkek veya Kadın
- Gelir: Target değişken. Gelir 50'in üstünde veya altında. Faktör yani >50K, <=50K
diğerleri arasında
library(dplyr)
data_adult <-read.csv("https://raw.githubusercontent.com/guru99-edu/R-Programming/master/adult.csv")
glimpse(data_adult)
Çıktı:
Observations: 48,842 Variables: 10 $ x <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,... $ age <int> 25, 38, 28, 44, 18, 34, 29, 63, 24, 55, 65, 36, 26... $ workclass <fctr> Private, Private, Local-gov, Private, ?, Private,... $ education <fctr> 11th, HS-grad, Assoc-acdm, Some-college, Some-col... $ educational.num <int> 7, 9, 12, 10, 10, 6, 9, 15, 10, 4, 9, 13, 9, 9, 9,... $ marital.status <fctr> Never-married, Married-civ-spouse, Married-civ-sp... $ race <fctr> Black, White, White, Black, White, White, Black, ... $ gender <fctr> Male, Male, Male, Male, Female, Male, Male, Male,... $ hours.per.week <int> 40, 50, 40, 40, 30, 30, 40, 32, 40, 10, 40, 40, 39... $ income <fctr> <=50K, <=50K, >50K, >50K, <=50K, <=50K, <=50K, >5...
Aşağıdaki gibi ilerleyeceğiz:
- Adım 1: Sürekli değişkenleri kontrol edin
- Adım 2: Faktör değişkenlerini kontrol edin
- 3. Adım: Özellik mühendisliği
- Adım 4: Özet istatistik
- Adım 5: Eğitim/test seti
- 6. Adım: Modeli oluşturun
- Adım 7: Modelin performansını değerlendirin
- Adım 8: Modeli geliştirin
Göreviniz hangi bireyin 50'den yüksek gelire sahip olacağını tahmin etmektir.
Bu eğitimde, gerçek bir veri kümesi üzerinde analiz gerçekleştirmek için her adım ayrıntılı olarak anlatılacaktır.
Adım 1) Sürekli değişkenleri kontrol edin
İlk adımda sürekli değişkenlerin dağılımını görebilirsiniz.
continuous <-select_if(data_adult, is.numeric) summary(continuous)
Kod Açıklama
- sürekli <- select_if(data_adult, is.numeric): Yalnızca sayısal sütunları seçmek için dplyr kitaplığından select_if() işlevini kullanın
- özet(sürekli): Özet istatistiğini yazdır
Çıktı:
## 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
Yukarıdaki tablodan, verilerin tamamen farklı ölçeklere sahip olduğunu ve hafta başına saat sayısının büyük aykırı değerlere sahip olduğunu görebilirsiniz (örn. son çeyreğe ve maksimum değere bakın).
Bunu iki adımda halledebilirsiniz:
- 1: Haftalık saat dağılımının grafiğini çizin
- 2: Sürekli değişkenleri standartlaştırın
- Dağıtımın grafiğini çizin
Hafta başına saat dağılımına daha yakından bakalım
# Histogram with kernel density curve
library(ggplot2)
ggplot(continuous, aes(x = hours.per.week)) +
geom_density(alpha = .2, fill = "#FF6666")
Çıktı:
Değişken çok sayıda aykırı değere sahiptir ve iyi tanımlanmış bir dağılıma sahip değildir. Haftalık saatlerin en üst yüzde 0.01'ini silerek bu sorunu kısmen çözebilirsiniz.
Niceliğin temel sözdizimi:
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.
En üstteki yüzde 2'lik dilimin hesabını yapıyoruz
top_one_percent <- quantile(data_adult$hours.per.week, .99) top_one_percent
Kod Açıklama
- quantile(data_adult$hours.per.week, .99): Çalışma süresinin yüzde 99'unun değerini hesaplayın
Çıktı:
## 99% ## 80
Nüfusun yüzde 98'i haftada 80 saatin altında çalışıyor.
Gözlemleri bu eşiğin üzerine bırakabilirsiniz. Filtreyi şuradan kullanabilirsiniz: dplyr kütüphane.
data_adult_drop <-data_adult %>% filter(hours.per.week<top_one_percent) dim(data_adult_drop)
Çıktı:
## [1] 45537 10
- Sürekli değişkenleri standartlaştırın
Verileriniz aynı ölçeğe sahip olmadığından performansı artırmak için her sütunu standartlaştırabilirsiniz. Dplyr kütüphanesindeki mutate_if fonksiyonunu kullanabilirsiniz. Temel sözdizimi şöyledir:
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
Sayısal sütunları aşağıdaki gibi standartlaştırabilirsiniz:
data_adult_rescale <- data_adult_drop % > % mutate_if(is.numeric, funs(as.numeric(scale(.)))) head(data_adult_rescale)
Kod Açıklama
- mutate_if(is.numeric, funs(scale)): Koşul yalnızca sayısal sütundur ve işlev ölçektir
Çıktı:
## 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
Adım 2) Faktör değişkenlerini kontrol edin
Bu adımın iki amacı vardır:
- Her kategorik sütundaki seviyeyi kontrol edin
- Yeni seviyeleri tanımlayın
Bu adımı üç bölüme ayıracağız:
- Kategorik sütunları seçin
- Her sütunun çubuk grafiğini bir listede saklayın
- Grafikleri yazdır
Faktör sütunlarını aşağıdaki kodla seçebiliriz:
# Select categorical column factor <- data.frame(select_if(data_adult_rescale, is.factor)) ncol(factor)
Kod Açıklama
- data.frame(select_if(data_adult, is.factor)): Faktör sütunlarını bir veri çerçevesi tipinde faktörde saklıyoruz. ggplot2 kütüphanesi bir veri çerçevesi nesnesi gerektirir.
Çıktı:
## [1] 6
Veri seti 6 kategorik değişken içeriyor
İkinci adım daha yeteneklidir. Veri çerçevesi faktöründeki her sütun için bir çubuk grafik çizmek istiyorsunuz. Özellikle çok sayıda sütunun olduğu durumlarda süreci otomatikleştirmek daha uygundur.
library(ggplot2)
# Create graph for each column
graph <- lapply(names(factor),
function(x)
ggplot(factor, aes(get(x))) +
geom_bar() +
theme(axis.text.x = element_text(angle = 90)))
Kod Açıklama
- lapply(): Veri kümesinin tüm sütunlarına bir işlev iletmek için lapply() işlevini kullanın. Çıktıyı bir listede saklarsınız
- fonksiyon(x): Fonksiyon her x için işlenecektir. Burada x sütunlardır
- ggplot(factor, aes(get(x))) + geom_bar()+ theme(axis.text.x = element_text(angle = 90))): Her x öğesi için bir çubuk karakter grafiği oluşturun. X'i bir sütun olarak döndürmek için onu get() içine eklemeniz gerektiğini unutmayın.
Son adım nispeten kolaydır. 6 grafiği yazdırmak istiyorsunuz.
# Print the graph graph
Çıktı:
## [[1]]
## ## [[2]]
## ## [[3]]
## ## [[4]]
## ## [[5]]
## ## [[6]]
Not: Sonraki grafiğe gitmek için sonraki düğmesini kullanın
Adım 3) Özellik mühendisliği
Eğitimi yeniden şekillendirin
Yukarıdaki grafikten eğitim değişkeninin 16 seviyeye sahip olduğunu görebilirsiniz. Bu oldukça önemlidir ve bazı düzeylerde gözlem sayısı nispeten düşüktür. Bu değişkenden alabileceğiniz bilgi miktarını artırmak istiyorsanız onu daha yüksek bir seviyeye yeniden düzenleyebilirsiniz. Yani benzer eğitim seviyesinde daha büyük gruplar oluşturuyorsunuz. Örneğin düşük eğitim seviyesi okulu bırakmaya dönüşecek. Daha yüksek eğitim seviyeleri yüksek lisansa dönüştürülecek.
İşte ayrıntı:
| Eski seviye | Yeni seviye |
|---|---|
| okul öncesi | bırakmak |
| 10th | Bırakmak |
| 11th | Bırakmak |
| 12th | Bırakmak |
| 1-4 | Bırakmak |
| 5th-6th | Bırakmak |
| 7th-8th | Bırakmak |
| 9th | Bırakmak |
| HS-Grad | Yüksek Grad |
| Bazı üniversite | Topluluk |
| Assoc-acdm | Topluluk |
| Doç-voc | Topluluk |
| Lisans | Lisans |
| Masters | Masters |
| Prof-okul | Masters |
| Doktora | Doktora |
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")))))))
Kod Açıklama
- Dplyr kütüphanesindeki mutate fiilini kullanıyoruz. ifelse cümlesi ile eğitimin değerlerini değiştiriyoruz
Aşağıdaki tabloda, Lisans, Yüksek Lisans veya Doktora derecesine ulaşmak için ortalama kaç yıllık eğitim (z değeri) gerektiğini görmek için bir özet istatistik oluşturacaksınız.
recast_data % > % group_by(education) % > % summarize(average_educ_year = mean(educational.num), count = n()) % > % arrange(average_educ_year)
Çıktı:
## # A tibble: 6 x 3 ## education average_educ_year count ## <fctr> <dbl> <int> ## 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
Değişiklik Maritoplam durum
Medeni durum için daha düşük seviyeler oluşturmak da mümkündür. Aşağıdaki kodda seviyeyi şu şekilde değiştirirsiniz:
| Eski seviye | Yeni seviye |
|---|---|
| Hiç evlenmemiş | Bekar |
| Evli-eş-yok | Bekar |
| Evli-AF-eş | Evli |
| evli-vatandaş-eş | |
| Ayrık | Ayrık |
| Boşanmış | |
| dullar | Dul |
# Change level marry recast_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")))))
Her gruptaki birey sayısını kontrol edebilirsiniz.
table(recast_data$marital.status)
Çıktı:
## ## Married Not_married Separated Widow ## 21165 15359 7727 1286
Adım 4) Özet İstatistik
Hedef değişkenlerimizle ilgili bazı istatistikleri kontrol etmenin zamanı geldi. Aşağıdaki grafikte cinsiyetlerine göre 50'den fazla kazanan bireylerin yüzdesini sayıyorsunuz.
# Plot gender income
ggplot(recast_data, aes(x = gender, fill = income)) +
geom_bar(position = "fill") +
theme_classic()
Çıktı:
Daha sonra bireyin kökeninin kazancını etkileyip etkilemediğini kontrol edin.
# Plot origin income
ggplot(recast_data, aes(x = race, fill = income)) +
geom_bar(position = "fill") +
theme_classic() +
theme(axis.text.x = element_text(angle = 90))
Çıktı:
Cinsiyete göre çalışma saatleri.
# box plot gender working time
ggplot(recast_data, aes(x = gender, y = hours.per.week)) +
geom_boxplot() +
stat_summary(fun.y = mean,
geom = "point",
size = 3,
color = "steelblue") +
theme_classic()
Çıktı:
Kutu grafiği, çalışma süresinin dağılımının farklı gruplara uyduğunu doğrular. Kutu grafiğinde, her iki cinsiyetin de homojen gözlemleri yoktur.
Haftalık çalışma süresinin yoğunluğunu eğitim türüne göre kontrol edebilirsiniz. Dağıtımların birçok farklı seçimi var. Muhtemelen ABD'deki sözleşmenin türüyle açıklanabilir.
# Plot distribution working time by education
ggplot(recast_data, aes(x = hours.per.week)) +
geom_density(aes(color = education), alpha = 0.5) +
theme_classic()
Kod Açıklama
- ggplot(recast_data, aes( x=hour.per.week))): Yoğunluk grafiği yalnızca bir değişken gerektirir
- geom_density(aes(renk = eğitim), alpha =0.5): Yoğunluğu kontrol eden geometrik nesne
Çıktı:
Düşüncelerinizi doğrulamak için tek yönlü bir işlem gerçekleştirebilirsiniz. ANOVA testi:
anova <- aov(hours.per.week~education, recast_data) summary(anova)
Çıktı:
## 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 testi gruplar arasındaki ortalama farkını doğrular.
Sigara doğrusallık
Modeli çalıştırmadan önce çalışılan saat sayısının yaşla ilişkili olup olmadığını görebilirsiniz.
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()
Kod Açıklama
- ggplot(recast_data, aes(x = yaş, y = saat.per.hafta))): Grafiğin estetiğini ayarlayın
- geom_point(aes(renk=gelir), boyut =0.5): Nokta grafiğini oluşturun
- stat_smooth(): Aşağıdaki argümanlarla trend çizgisini ekleyin:
- method='lm': Eğer uygunsa, uygun değeri çizin doğrusal regresyon
- formül = y~poli(x,2): Bir polinom regresyonunu uydurun
- se = DOĞRU: Standart hatayı ekleyin
- aes(renk= gelir): Modeli gelire göre ayırın
Çıktı:
Özetle, haftalık çalışma süresi ile diğer özellikler arasındaki doğrusal olmama etkisini tespit etmek için modeldeki etkileşim terimlerini test edebilirsiniz. Çalışma süresinin hangi koşullar altında farklılık gösterdiğinin tespiti önemlidir.
Ilişki
Bir sonraki kontrol değişkenler arasındaki korelasyonun görselleştirilmesidir. Spearman yöntemiyle hesaplanan korelasyon katsayısını içeren bir ısı haritası çizebilmek için faktör düzeyi türünü sayısala dönüştürürsünüz.
library(GGally)
# Convert data to numeric
corr <- 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")
Kod Açıklama
- data.frame(lapply(recast_data,as.integer)): Verileri sayısala dönüştür
- ggcorr() ısı haritasını aşağıdaki argümanlarla çizer:
- yöntem: Korelasyonu hesaplama yöntemi
- nbreaks = 6: Mola sayısı
- hjust = 0.8: Grafikteki değişken adının kontrol konumu
- etiket = TRUE: Pencerelerin ortasına etiketler ekle
- label_size = 3: Boyut etiketleri
- color = “gri50”): Etiketin rengi
Çıktı:
Adım 5) Eğitim/test seti
Denetlenen herhangi biri makine öğrenme görev, verileri bir tren seti ile bir test seti arasında bölmeyi gerektirir. Bir eğitim/test seti oluşturmak için diğer denetimli öğrenim eğitimlerinde oluşturduğunuz "işlevi" kullanabilirsiniz.
set.seed(1234)
create_train_test <- function(data, size = 0.8, train = TRUE) {
n_row = nrow(data)
total_row = size * n_row
train_sample <- 1: total_row
if (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)
Çıktı:
## [1] 36429 9
dim(data_test)
Çıktı:
## [1] 9108 9
Adım 6) Modeli oluşturun
Algoritmanın nasıl performans gösterdiğini görmek için glm() paketini kullanırsınız. Genelleştirilmiş Doğrusal Model modellerden oluşan bir koleksiyondur. Temel sözdizimi şöyledir:
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")
Gelir düzeyini bir dizi özellik arasında bölmek için lojistik modeli tahmin etmeye hazırsınız.
formula <- income~. logit <- glm(formula, data = data_train, family = 'binomial') summary(logit)
Kod Açıklama
- formül <- gelir ~.: Uygun modeli oluşturun
- logit <- glm(formula, data = data_train, family = 'binom'): Data_train verileriyle bir lojistik modeli (aile = 'binom') yerleştirin.
- Summary(logit): Modelin özetini yazdırır
Çıktı:
## ## 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
Modelimizin özeti ilginç bilgileri ortaya koyuyor. Lojistik regresyonun performansı belirli temel ölçümlerle değerlendirilir.
- AIC (Akaike Bilgi Kriterleri): Bu, şuna eşdeğerdir: R2 lojistik regresyonda. Parametre sayısına bir ceza uygulandığında uyumu ölçer. Daha küçük AIC değerler modelin gerçeğe daha yakın olduğunu göstermektedir.
- Boş sapma: Modele yalnızca kesişme noktasıyla uyar. Serbestlik derecesi n-1'dir. Bunu bir Ki-kare değeri (gerçek değer hipotez testinden farklı olan uygun değer) olarak yorumlayabiliriz.
- Artık Sapma: Tüm değişkenleri içeren model. Aynı zamanda Ki-kare hipotez testi olarak da yorumlanır.
- Fisher Puanlaması yinelemelerinin sayısı: Yakınsamadan önceki yinelemelerin sayısı.
glm() fonksiyonunun çıktısı bir listede saklanır. Aşağıdaki kod, lojistik regresyonu değerlendirmek için oluşturduğumuz logit değişkeninde bulunan tüm öğeleri gösterir.
# Liste çok uzun, yalnızca ilk üç öğeyi yazdır
lapply(logit, class)[1:3]
Çıktı:
## $coefficients ## [1] "numeric" ## ## $residuals ## [1] "numeric" ## ## $fitted.values ## [1] "numeric"
Her değer, $ işareti ve ardından metriklerin adı kullanılarak çıkarılabilir. Örneğin modeli logit olarak sakladınız. AIC kriterlerini çıkarmak için şunları kullanırsınız:
logit$aic
Çıktı:
## [1] 27086.65
Adım 7) Modelin performansını değerlendirin
Karışıklık Matrisi
The karışıklık matrisi sınıflandırma performansını değerlendirmek için daha önce gördüğünüz farklı metriklerle karşılaştırıldığında daha iyi bir seçimdir. Genel fikir, True örneklerinin kaç kez Yanlış olarak sınıflandırıldığını saymaktır.
Karışıklık matrisini hesaplamak için öncelikle gerçek hedeflerle karşılaştırılabilecek bir dizi tahmine sahip olmanız gerekir.
predict <- predict(logit, data_test, type = 'response') # confusion matrix table_mat <- table(data_test$income, predict > 0.5) table_mat
Kod Açıklama
- tahmin(logit,data_test, type = 'response'): Test kümesindeki tahmini hesaplayın. Yanıt olasılığını hesaplamak için type = 'response' değerini ayarlayın.
- table(data_test$income, tahmin > 0.5): Karışıklık matrisini hesaplayın. tahmin > 0.5, tahmin edilen olasılıklar 1'in üzerindeyse 0.5, aksi halde 0 döndürdüğü anlamına gelir.
Çıktı:
## ## FALSE TRUE ## <=50K 6310 495 ## >50K 1074 1229
Karışıklık matrisindeki her satır gerçek bir hedefi temsil ederken, her sütun tahmin edilen bir hedefi temsil eder. Bu matrisin ilk satırı, 50'den düşük geliri (Yanlış sınıfı) dikkate alır: 6241 kişi, 50'den düşük gelire sahip bireyler olarak doğru şekilde sınıflandırılmıştır (Gerçek negatif), geri kalan ise yanlışlıkla 50 binin üzerinde olarak sınıflandırıldı (Yanlış pozitif). İkinci satırda 50 binin üzerindeki gelir dikkate alınır, pozitif sınıf 1229'dur (gerçek pozitif) iken Gerçek negatif 1074 idi.
Modeli hesaplayabilirsiniz doğruluk toplam gözlem üzerinden gerçek pozitif + gerçek negatifin toplanmasıyla
accuracy_Test <- sum(diag(table_mat)) / sum(table_mat) accuracy_Test
Kod Açıklama
- toplam(diag(table_mat))): Köşegenin toplamı
- sum(table_mat): Matrisin toplamı.
Çıktı:
## [1] 0.8277339
Modelin bir sorunu var gibi görünüyor; yanlış negatiflerin sayısını fazla tahmin ediyor. Buna denir doğruluk testi paradoksu. Doğruluğun, doğru tahminlerin toplam vaka sayısına oranı olduğunu belirtmiştik. Göreceli olarak yüksek doğruluğa sahip olabiliriz ancak işe yaramaz bir model. Baskın bir sınıf olduğunda bu olur. Karışıklık matrisine tekrar bakarsanız, vakaların çoğunun gerçek negatif olarak sınıflandırıldığını görebilirsiniz. Şimdi, modelin tüm sınıfları negatif (yani 50'den düşük) olarak sınıflandırdığını hayal edin. Yüzde 75'lik bir doğruluğa sahip olursunuz (6718/6718+2257). Modeliniz daha iyi performans gösteriyor ancak gerçek olumlu ile gerçek olumsuzu ayırt etmekte zorlanıyor.
Böyle bir durumda daha kısa bir ölçütün kullanılması tercih edilir. Şuna bakabiliriz:
- Hassasiyet=TP/(TP+FP)
- Geri Çağırma=TP/(TP+FN)
Hassasiyet ve Geri Çağırma
Hassas Olumlu tahminin doğruluğuna bakar. Geri çağırmak sınıflandırıcı tarafından doğru şekilde tespit edilen pozitif örneklerin oranıdır;
Bu iki ölçümü hesaplamak için iki fonksiyon oluşturabilirsiniz
- Hassasiyet oluşturun
precision <- function(matrix) {
# True positive
tp <- matrix[2, 2]
# false positive
fp <- matrix[1, 2]
return (tp / (tp + fp))
}
Kod Açıklama
- mat[1,1]: Veri çerçevesinin ilk sütununun ilk hücresini, yani gerçek pozitifi döndürür
- mat[1,2]; Veri çerçevesinin ikinci sütununun ilk hücresini, yani yanlış pozitifi döndür
recall <- function(matrix) {
# true positive
tp <- matrix[2, 2]# false positive
fn <- matrix[2, 1]
return (tp / (tp + fn))
}
Kod Açıklama
- mat[1,1]: Veri çerçevesinin ilk sütununun ilk hücresini, yani gerçek pozitifi döndürür
- mat[2,1]; Veri çerçevesinin ilk sütununun ikinci hücresini, yani yanlış negatifi döndür
Fonksiyonlarınızı test edebilirsiniz
prec <- precision(table_mat) prec rec <- recall(table_mat) rec
Çıktı:
## [1] 0.712877 ## [2] 0.5336518
Model, 50 binin üzerinde bir birey olduğunu söylediğinde, vakaların yalnızca yüzde 54'ünde doğrudur ve vakaların yüzde 50'sinde 72 binin üzerinde bireyler olduğunu iddia edebilir.
Sen yaratabilirsin 
kesinlik ve hatırlamaya dayalı puan. bu iki ölçümün harmonik ortalamasıdır, yani daha düşük değerlere daha fazla ağırlık verir.
f1 <- 2 * ((prec * rec) / (prec + rec)) f1
Çıktı:
## [1] 0.6103799
Hassasiyet ve Geri Çağırma ödünleşimi
Hem yüksek hassasiyete hem de yüksek geri çağırmaya sahip olmak imkansızdır.
Kesinliği arttırırsak, doğru birey daha iyi tahmin edilecek, ancak çoğunu kaçıracağız (düşük hatırlama). Bazı durumlarda geri çağırmadan daha yüksek kesinliği tercih ederiz. Kesinlik ve hatırlama arasında içbükey bir ilişki vardır.
- Düşünün, bir hastanın hastalığı olup olmadığını tahmin etmeniz gerekiyor. Mümkün olduğu kadar kesin olmak istiyorsunuz.
- Yüz tanıma yoluyla sokaktaki potansiyel dolandırıcı kişileri tespit etmeniz gerekiyorsa, hassasiyet düşük olsa da dolandırıcı olarak etiketlenen birçok kişiyi yakalamak daha iyi olacaktır. Polis dolandırıcı olmayan kişiyi serbest bırakabilecek.
ROC eğrisi
The Alıcı Operakarakteristik Eğri, ikili sınıflandırmada kullanılan başka bir yaygın araçtır. Kesinlik/geri çağırma eğrisine çok benzemektedir ancak ROC eğrisi, kesinlik ve geri çağırmanın grafiğini çizmek yerine, yanlış pozitif oranına karşı gerçek pozitif oranı (yani geri çağırma) gösterir. Yanlış pozitif oranı, yanlışlıkla pozitif olarak sınıflandırılan negatif örneklerin oranıdır. Bir eksi gerçek negatif orana eşittir. Gerçek negatif oran da denir özgüllük. Dolayısıyla ROC eğrisi grafikleri duyarlılık (hatırlama) ve 1 özgüllüğe karşı
ROC eğrisini çizmek için RORC adında bir kütüphane kurmamız gerekiyor. Conda'da bulabiliriz kütüphane. Kodu yazabilirsiniz:
conda kurulumu -cr r-rocr –evet
ROC'yi tahmin() ve performans() fonksiyonlarıyla çizebiliriz.
library(ROCR) ROCRpred <- prediction(predict, data_test$income) ROCRperf <- performance(ROCRpred, 'tpr', 'fpr') plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Kod Açıklama
- tahmin(tahmin, data_test$income): ROCR kitaplığının giriş verilerini dönüştürmek için bir tahmin nesnesi oluşturması gerekir
- performans(ROCRpred, 'tpr','fpr'): Grafikte üretilecek iki kombinasyonu döndürün. Burada tpr ve fpr oluşturulur. Hassasiyeti çizmek ve geri çağırmayı bir arada yapmak için "prec", "rec" kullanın.
Çıktı:
) 8 Adım Modeli geliştirin
Arasındaki etkileşimle modele doğrusal olmama özelliği eklemeyi deneyebilirsiniz.
- yaş ve haftalık saat
- cinsiyet ve haftalık saat.
Her iki modeli karşılaştırmak için puan testini kullanmanız gerekir
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
Çıktı:
## [1] 0.6109181
Puan öncekine göre biraz daha yüksek. Skoru geçmeye çalışmak için veriler üzerinde çalışmaya devam edebilirsiniz.
ÖZET
Lojistik regresyonu eğitme fonksiyonunu aşağıdaki tabloda özetleyebiliriz:
| paket | Nesnel | işlev | Tartışma |
|---|---|---|---|
| - | Eğitim/test veri kümesi oluşturun | create_train_set() | veri, boyut, tren |
| gösteriş | Genelleştirilmiş Doğrusal Model Eğitin | glm() | formül, veriler, aile* |
| gösteriş | Modeli özetleyin | özet() | takılı model |
| baz | Tahmin etmek | ) (Tahmin | uygun model, veri kümesi, tür = 'yanıt' |
| baz | Bir karışıklık matrisi oluşturun | masa() | tahmin et() |
| baz | Doğruluk puanı oluştur | toplam(diag(tablo())/toplam(tablo()) | |
| ROCR | ROC Oluşturun: 1. Adım Tahmin oluşturun | tahmin() | tahmin(), y |
| ROCR | ROC Oluşturun: Adım 2 Performans oluşturun | verim() | tahmin(), 'tpr', 'fpr' |
| ROCR | ROC Oluşturun: Adım 3 Grafiği çizin | komplo() | verim() |
Öteki GLM model türleri şunlardır:
– binom: (bağlantı = “logit”)
– Gaussian: (bağlantı = “kimlik”)
– Gama: (bağlantı = “ters”)
– ters.gaussian: (bağlantı = “1/mu^2”)
– poisson: (bağlantı = “günlük”)
– yarı: (bağlantı = “özdeşlik”, varyans = “sabit”)
– yarı binom: (bağlantı = “logit”)
– quasipoisson: (bağlantı = “günlük”)
