आर में जीएलएम: उदाहरण के साथ सामान्यीकृत रैखिक मॉडल
एवलिन क्लार्क
लॉजिस्टिक रिग्रेशन क्या है?
लॉजिस्टिक रिग्रेशन का उपयोग किसी वर्ग, यानी संभावना का पूर्वानुमान लगाने के लिए किया जाता है। लॉजिस्टिक रिग्रेशन बाइनरी परिणाम का सटीक पूर्वानुमान लगा सकता है।
कल्पना करें कि आप कई विशेषताओं के आधार पर यह अनुमान लगाना चाहते हैं कि कोई ऋण अस्वीकृत होगा या स्वीकृत। लॉजिस्टिक रिग्रेशन 0/1 के रूप का होता है। यदि ऋण अस्वीकृत होता है तो y = 0, यदि स्वीकृत होता है तो y = 1।
लॉजिस्टिक रिग्रेशन मॉडल रैखिक रिग्रेशन मॉडल से दो तरह से भिन्न होता है।
- सबसे पहले, लॉजिस्टिक रिग्रेशन केवल द्विभाजी (बाइनरी) इनपुट को आश्रित चर (अर्थात 0 और 1 का वेक्टर) के रूप में स्वीकार करता है।
- दूसरा, परिणाम को निम्नलिखित संभाव्य लिंक फ़ंक्शन द्वारा मापा जाता है जिसे कहा जाता है अवग्रह इसके एस आकार के कारण:
फ़ंक्शन का आउटपुट हमेशा 0 और 1 के बीच होता है। नीचे दी गई छवि देखें
सिग्मॉइड फ़ंक्शन 0 से 1 तक मान लौटाता है। वर्गीकरण कार्य के लिए, हमें 0 या 1 के असतत आउटपुट की आवश्यकता होती है।
निरंतर प्रवाह को असतत मान में बदलने के लिए, हम 0.5 पर निर्णय सीमा निर्धारित कर सकते हैं। इस सीमा से ऊपर के सभी मान 1 के रूप में वर्गीकृत किए जाते हैं
सामान्यीकृत लाइनर मॉडल (GLM) कैसे बनाएं?
आइए का उपयोग करें वयस्क लॉजिस्टिक रिग्रेशन को दर्शाने के लिए डेटा सेट। वर्गीकरण कार्य के लिए "वयस्क" एक बेहतरीन डेटासेट है। इसका उद्देश्य यह अनुमान लगाना है कि किसी व्यक्ति की डॉलर में वार्षिक आय 50.000 से अधिक होगी या नहीं। डेटासेट में 46,033 अवलोकन और दस विशेषताएं शामिल हैं:
- आयु: व्यक्ति की आयु। संख्यात्मक
- शिक्षा: व्यक्ति का शैक्षिक स्तर. कारक.
- वैवाहिक स्थिति: Mariव्यक्ति की वैवाहिक स्थिति। कारक अर्थात कभी शादी न हुई, विवाहित-नागरिक-जीवनसाथी, ...
- लिंग: व्यक्ति का लिंग। कारक, अर्थात पुरुष या महिला
- आय: Target परिवर्तनशील। 50K से ऊपर या नीचे की आय। कारक अर्थात >50K, <=50K
दूसरों के बीच
library(dplyr)
data_adult <-read.csv("https://raw.githubusercontent.com/guru99-edu/R-Programming/master/adult.csv")
glimpse(data_adult)
आउटपुट:
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...
हम निम्नानुसार आगे बढ़ेंगे:
- चरण 1: सतत चर की जाँच करें
- चरण 2: कारक चर की जाँच करें
- चरण 3: फ़ीचर इंजीनियरिंग
- चरण 4: सारांश सांख्यिकी
- चरण 5: प्रशिक्षण/परीक्षण सेट
- चरण 6: मॉडल बनाएं
- चरण 7: मॉडल के प्रदर्शन का आकलन करें
- चरण 8: मॉडल में सुधार करें
आपका कार्य यह अनुमान लगाना है कि किस व्यक्ति की आय 50 हजार से अधिक होगी।
इस ट्यूटोरियल में, वास्तविक डेटासेट पर विश्लेषण करने के लिए प्रत्येक चरण का विस्तृत विवरण दिया जाएगा।
चरण 1) सतत चर की जाँच करें
पहले चरण में, आप सतत चरों का वितरण देख सकते हैं।
continuous <-select_if(data_adult, is.numeric) summary(continuous)
Code व्याख्या
- निरंतर <- select_if(data_adult, is.numeric): केवल संख्यात्मक कॉलम का चयन करने के लिए dplyr लाइब्रेरी से select_if() फ़ंक्शन का उपयोग करें
- सारांश(निरंतर): सारांश आँकड़े प्रिंट करें
आउटपुट:
## 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
उपरोक्त तालिका से आप देख सकते हैं कि आंकड़ों के पैमाने बिल्कुल अलग हैं और प्रति सप्ताह घंटों में बड़े आउटलाइर्स हैं (अर्थात अंतिम चतुर्थक और अधिकतम मूल्य को देखें)।
आप दो चरणों का पालन करके इससे निपट सकते हैं:
- 1: प्रति सप्ताह घंटों का वितरण प्लॉट करें
- 2: सतत चरों को मानकीकृत करें
- वितरण का आरेख बनाएं
आइये प्रति सप्ताह घंटों के वितरण पर करीब से नज़र डालें
# Histogram with kernel density curve
library(ggplot2)
ggplot(continuous, aes(x = hours.per.week)) +
geom_density(alpha = .2, fill = "#FF6666")
आउटपुट:
इस चर में बहुत सारे आउटलाइर्स हैं और वितरण अच्छी तरह से परिभाषित नहीं है। आप प्रति सप्ताह शीर्ष 0.01 प्रतिशत घंटों को हटाकर इस समस्या से आंशिक रूप से निपट सकते हैं।
क्वांटाइल का मूल वाक्यविन्यास:
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.
हम शीर्ष 2 प्रतिशत का पर्सेंटाइल गणना करते हैं
top_one_percent <- quantile(data_adult$hours.per.week, .99) top_one_percent
Code व्याख्या
- quantile(data_adult$hours.per.week, .99): कार्य समय के 99 प्रतिशत का मान परिकलित करें
आउटपुट:
## 99% ## 80
98 प्रतिशत जनसंख्या प्रति सप्ताह 80 घंटे से कम काम करती है।
आप इस सीमा से ऊपर के अवलोकनों को छोड़ सकते हैं। आप फ़िल्टर का उपयोग करते हैं दुत्कार पुस्तकालय।
data_adult_drop <-data_adult %>% filter(hours.per.week<top_one_percent) dim(data_adult_drop)
आउटपुट:
## [1] 45537 10
- सतत चरों को मानकीकृत करें
आप प्रदर्शन को बेहतर बनाने के लिए प्रत्येक कॉलम को मानकीकृत कर सकते हैं क्योंकि आपके डेटा का स्केल समान नहीं है। आप dplyr लाइब्रेरी से mutate_if फ़ंक्शन का उपयोग कर सकते हैं। मूल सिंटैक्स है:
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
आप संख्यात्मक स्तंभों को निम्नानुसार मानकीकृत कर सकते हैं:
data_adult_rescale <- data_adult_drop % > % mutate_if(is.numeric, funs(as.numeric(scale(.)))) head(data_adult_rescale)
Code व्याख्या
- mutate_if(is.numeric, funs(scale)): शर्त केवल संख्यात्मक कॉलम है और फ़ंक्शन स्केल है
आउटपुट:
## 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) कारक चर की जाँच करें
इस कदम के दो उद्देश्य हैं:
- प्रत्येक श्रेणीबद्ध कॉलम में स्तर की जाँच करें
- नये स्तर निर्धारित करें
हम इस चरण को तीन भागों में विभाजित करेंगे:
- श्रेणीबद्ध कॉलम चुनें
- प्रत्येक कॉलम का बार चार्ट सूची में संग्रहीत करें
- ग्राफ़ प्रिंट करें
हम नीचे दिए गए कोड से कारक कॉलम का चयन कर सकते हैं:
# Select categorical column factor <- data.frame(select_if(data_adult_rescale, is.factor)) ncol(factor)
Code व्याख्या
- data.frame(select_if(data_adult, is.factor)): हम फ़ैक्टर कॉलम को फ़ैक्टर में डेटा फ़्रेम प्रकार में संग्रहीत करते हैं। लाइब्रेरी ggplot2 को डेटा फ़्रेम ऑब्जेक्ट की आवश्यकता होती है।
आउटपुट:
## [1] 6
डेटासेट में 6 श्रेणीबद्ध चर शामिल हैं
दूसरा चरण ज़्यादा कुशल है। आप डेटा फ़्रेम फ़ैक्टर में प्रत्येक कॉलम के लिए एक बार चार्ट बनाना चाहते हैं। प्रक्रिया को स्वचालित करना ज़्यादा सुविधाजनक है, ख़ास तौर पर ऐसी स्थिति में जब बहुत सारे कॉलम हों।
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)))
Code व्याख्या
- lapply(): डेटासेट के सभी कॉलम में फ़ंक्शन पास करने के लिए lapply() फ़ंक्शन का उपयोग करें। आप आउटपुट को सूची में संग्रहीत करते हैं
- फ़ंक्शन(x): फ़ंक्शन को प्रत्येक x के लिए संसाधित किया जाएगा। यहाँ x कॉलम है
- ggplot(factor, aes(get(x))) + geom_bar()+ theme(axis.text.x = element_text(angle = 90)): प्रत्येक x तत्व के लिए एक बार चार चार्ट बनाएँ। ध्यान दें, x को कॉलम के रूप में लौटाने के लिए, आपको इसे get() के अंदर शामिल करना होगा।
अंतिम चरण अपेक्षाकृत आसान है। आप 6 ग्राफ़ प्रिंट करना चाहते हैं।
# Print the graph graph
आउटपुट:
## [[1]]
## ## [[2]]
## ## [[3]]
## ## [[4]]
## ## [[5]]
## ## [[6]]
नोट: अगले ग्राफ़ पर जाने के लिए अगला बटन का उपयोग करें
चरण 3) फ़ीचर इंजीनियरिंग
शिक्षा का पुनर्निर्माण
ऊपर दिए गए ग्राफ से आप देख सकते हैं कि चर शिक्षा के 16 स्तर हैं। यह काफी महत्वपूर्ण है, और कुछ स्तरों में अवलोकनों की संख्या अपेक्षाकृत कम है। यदि आप इस चर से प्राप्त होने वाली जानकारी की मात्रा में सुधार करना चाहते हैं, तो आप इसे उच्च स्तर में बदल सकते हैं। अर्थात्, आप समान स्तर की शिक्षा वाले बड़े समूह बनाते हैं। उदाहरण के लिए, शिक्षा का निम्न स्तर ड्रॉपआउट में परिवर्तित हो जाएगा। शिक्षा का उच्च स्तर मास्टर में बदल जाएगा।
इसका विवरण इस प्रकार है:
| पुराना स्तर | नया स्तर |
|---|---|
| पूर्वस्कूली | ड्रॉप आउट |
| 10th | ड्रॉप आउट |
| 11th | ड्रॉप आउट |
| 12th | ड्रॉप आउट |
| 1-4 | ड्रॉप आउट |
| 5th-6th | ड्रॉप आउट |
| 7th-8th | ड्रॉप आउट |
| 9th | ड्रॉप आउट |
| एचएस-ग्रेड | हाईग्रैड |
| कुछ कॉलेज | समुदाय |
| एसोसिएट-एसीडीएम | समुदाय |
| एसोसिएट-वोक | समुदाय |
| स्नातक | स्नातक |
| मास्टर्स | मास्टर्स |
| प्रोफ़ेसर स्कूल | मास्टर्स |
| डॉक्टरेट | पीएचडी |
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")))))))
Code व्याख्या
- हम dplyr लाइब्रेरी से क्रिया mutate का उपयोग करते हैं। हम ifelse कथन के साथ education के मान बदलते हैं
नीचे दी गई तालिका में, आप एक सारांश सांख्यिकी बनाते हैं, जिससे आप देख सकते हैं कि बैचलर, मास्टर या पीएचडी तक पहुंचने के लिए औसतन कितने वर्षों की शिक्षा (z-value) की आवश्यकता होती है।
recast_data % > % group_by(education) % > % summarize(average_educ_year = mean(educational.num), count = n()) % > % arrange(average_educ_year)
आउटपुट:
## # 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
मरम्मत Mariताल-स्थिति
वैवाहिक स्थिति के लिए निम्न स्तर बनाना भी संभव है। निम्नलिखित कोड में आप निम्न प्रकार से स्तर बदल सकते हैं:
| पुराना स्तर | नया स्तर |
|---|---|
| शादी कभी नहीं की | शादीशुदा नहीं |
| विवाहित-जीवनसाथी-अनुपस्थित | शादीशुदा नहीं |
| विवाहित-AF-जीवनसाथी | विवाहित |
| विवाहित-नागरिक-पति/पत्नी | |
| से अलग | से अलग |
| तलाकशुदा | |
| विधवाओं | विधवा |
# 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")))))
आप प्रत्येक समूह में व्यक्तियों की संख्या की जांच कर सकते हैं।
table(recast_data$marital.status)
आउटपुट:
## ## Married Not_married Separated Widow ## 21165 15359 7727 1286
चरण 4) सारांश सांख्यिकी
अब समय आ गया है कि हम अपने लक्ष्य चरों के बारे में कुछ आँकड़े देखें। नीचे दिए गए ग्राफ़ में, आप लिंग के आधार पर 50k से अधिक कमाने वाले व्यक्तियों का प्रतिशत गिन सकते हैं।
# Plot gender income
ggplot(recast_data, aes(x = gender, fill = income)) +
geom_bar(position = "fill") +
theme_classic()
आउटपुट:
इसके बाद, जाँच करें कि क्या व्यक्ति की उत्पत्ति उसकी कमाई को प्रभावित करती है।
# 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))
आउटपुट:
लिंग के अनुसार काम के घंटों की संख्या.
# 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()
आउटपुट:
बॉक्स प्लॉट इस बात की पुष्टि करता है कि कार्य समय का वितरण अलग-अलग समूहों पर फिट बैठता है। बॉक्स प्लॉट में, दोनों लिंगों में समरूप अवलोकन नहीं हैं।
आप शिक्षा के प्रकार के आधार पर साप्ताहिक कार्य समय के घनत्व की जाँच कर सकते हैं। वितरण में कई विशिष्ट विविधताएँ हैं। संभवतः इसका कारण शिक्षा के प्रकार से स्पष्ट किया जा सकता है।tracअमेरिका में टी।
# Plot distribution working time by education
ggplot(recast_data, aes(x = hours.per.week)) +
geom_density(aes(color = education), alpha = 0.5) +
theme_classic()
Code व्याख्या
- ggplot(recast_data, aes( x= hours.per.week)): घनत्व प्लॉट के लिए केवल एक चर की आवश्यकता होती है
- geom_density(aes(color = education), alpha =0.5): घनत्व को नियंत्रित करने के लिए ज्यामितीय ऑब्जेक्ट
आउटपुट:
अपने विचारों की पुष्टि करने के लिए आप एकतरफा प्रदर्शन कर सकते हैं एनोवा परीक्षण:
anova <- aov(hours.per.week~education, recast_data) summary(anova)
आउटपुट:
## 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
एनोवा परीक्षण समूहों के बीच औसत में अंतर की पुष्टि करता है।
गैर linearity
मॉडल चलाने से पहले आप देख सकते हैं कि काम किए गए घंटों की संख्या उम्र से संबंधित है या नहीं।
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()
Code व्याख्या
- ggplot(recast_data, aes(x = age, y = hours.per.week)): ग्राफ का सौंदर्यबोध सेट करें
- geom_point(aes(color= income), size =0.5): डॉट प्लॉट का निर्माण करें
- stat_smooth(): निम्नलिखित तर्कों के साथ ट्रेंड लाइन जोड़ें:
- विधि = 'एलएम': यदि फिट किया गया मान प्लॉट करें रेखीय प्रतिगमन
- सूत्र = y~poly(x,2): एक बहुपद प्रतिगमन फिट करें
- se = TRUE: मानक त्रुटि जोड़ें
- aes(रंग=आय): आय के आधार पर मॉडल को तोड़ें
आउटपुट:
संक्षेप में, आप साप्ताहिक कार्य समय और अन्य विशेषताओं के बीच गैर-रैखिकता प्रभाव को जानने के लिए मॉडल में अंतःक्रिया शर्तों का परीक्षण कर सकते हैं। यह पता लगाना महत्वपूर्ण है कि किस स्थिति में कार्य समय भिन्न होता है।
सह - संबंध
अगली जाँच चरों के बीच सहसंबंध को देखना है। आप कारक स्तर के प्रकार को संख्यात्मक में परिवर्तित करते हैं ताकि आप स्पीयरमैन विधि से गणना किए गए सहसंबंध के गुणांक वाले हीट मैप को प्लॉट कर सकें।
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")
Code व्याख्या
- data.frame(lapply(recast_data,as.integer)): डेटा को संख्यात्मक में बदलें
- ggcorr() निम्नलिखित तर्कों के साथ हीट मैप प्लॉट करता है:
- विधि: सहसंबंध की गणना करने की विधि
- nbreaks = 6: ब्रेक की संख्या
- hjust = 0.8: प्लॉट में चर नाम की नियंत्रण स्थिति
- लेबल = सत्य: विंडोज़ के केंद्र में लेबल जोड़ें
- label_size = 3: आकार लेबल
- रंग = “ग्रे50”): लेबल का रंग
आउटपुट:
चरण 5) प्रशिक्षण/परीक्षण सेट
किसी भी पर्यवेक्षित यंत्र अधिगम कार्य को ट्रेन सेट और टेस्ट सेट के बीच डेटा को विभाजित करने की आवश्यकता होती है। आप ट्रेन/टेस्ट सेट बनाने के लिए अन्य सुपरवाइज्ड लर्निंग ट्यूटोरियल में बनाए गए "फ़ंक्शन" का उपयोग कर सकते हैं।
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)
आउटपुट:
## [1] 36429 9
dim(data_test)
आउटपुट:
## [1] 9108 9
चरण 6) मॉडल बनाएं
यह देखने के लिए कि एल्गोरिथ्म कैसे काम करता है, आप glm() पैकेज का उपयोग करते हैं। सामान्यीकृत रेखीय मॉडल मॉडलों का एक संग्रह है। मूल वाक्यविन्यास है:
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")
आप सुविधाओं के एक सेट के बीच आय स्तर को विभाजित करने के लिए लॉजिस्टिक मॉडल का अनुमान लगाने के लिए तैयार हैं।
formula <- income~. logit <- glm(formula, data = data_train, family = 'binomial') summary(logit)
Code व्याख्या
- सूत्र <- आय ~ .: फिट करने के लिए मॉडल बनाएं
- logit <- glm(सूत्र, डेटा = डेटा_ट्रेन, परिवार = 'द्विपद'): डेटा_ट्रेन डेटा के साथ एक लॉजिस्टिक मॉडल (परिवार = 'द्विपद') फिट करें।
- सारांश(logit): मॉडल का सारांश प्रिंट करें
आउटपुट:
## ## 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
हमारे मॉडल का सारांश दिलचस्प जानकारी प्रकट करता है। लॉजिस्टिक रिग्रेशन के प्रदर्शन का मूल्यांकन विशिष्ट प्रमुख मेट्रिक्स के साथ किया जाता है।
- एआईसी (अकाइके सूचना मानदंड): यह इसके समतुल्य है R2 लॉजिस्टिक रिग्रेशन में। यह तब फिट को मापता है जब पैरामीटर की संख्या पर पेनल्टी लागू की जाती है। छोटे एआईसी मान दर्शाते हैं कि मॉडल सत्य के अधिक निकट है।
- शून्य विचलन: मॉडल को केवल अवरोधन के साथ फिट करता है। स्वतंत्रता की डिग्री n-1 है। हम इसे ची-स्क्वायर मान (वास्तविक मूल्य परिकल्पना परीक्षण से अलग फिट किया गया मान) के रूप में व्याख्या कर सकते हैं।
- अवशिष्ट विचलन: सभी चरों वाला मॉडल। इसे ची-स्क्वायर परिकल्पना परीक्षण के रूप में भी समझा जाता है।
- फिशर स्कोरिंग पुनरावृत्तियों की संख्या: अभिसरण से पहले पुनरावृत्तियों की संख्या।
glm() फ़ंक्शन का आउटपुट एक सूची में संग्रहीत किया जाता है। नीचे दिया गया कोड logit वैरिएबल में उपलब्ध सभी आइटम दिखाता है जिसे हमने लॉजिस्टिक रिग्रेशन का मूल्यांकन करने के लिए बनाया है।
# सूची बहुत लंबी है, केवल पहले तीन तत्वों को ही प्रिंट करें
lapply(logit, class)[1:3]
आउटपुट:
## $coefficients ## [1] "numeric" ## ## $residuals ## [1] "numeric" ## ## $fitted.values ## [1] "numeric"
प्रत्येक मान को व्यक्त किया जा सकता हैtracमैट्रिक्स के नाम के बाद $ चिह्न लगा होता है। उदाहरण के लिए, आपने मॉडल को logit के रूप में संग्रहीत किया है।tracएआईसी मानदंडों के अनुसार, आप निम्न का उपयोग करते हैं:
logit$aic
आउटपुट:
## [1] 27086.65
चरण 7) मॉडल के प्रदर्शन का आकलन करें
असमंजस का जाल
RSI असमंजस का जाल आपके द्वारा पहले देखे गए विभिन्न मेट्रिक्स की तुलना में वर्गीकरण प्रदर्शन का मूल्यांकन करने के लिए एक बेहतर विकल्प है। सामान्य विचार यह है कि सत्य उदाहरणों को गलत के रूप में वर्गीकृत किए जाने की संख्या की गणना करना है।
भ्रम मैट्रिक्स की गणना करने के लिए, आपको सबसे पहले पूर्वानुमानों का एक सेट तैयार करना होगा ताकि उनकी तुलना वास्तविक लक्ष्यों से की जा सके।
predict <- predict(logit, data_test, type = 'response') # confusion matrix table_mat <- table(data_test$income, predict > 0.5) table_mat
Code व्याख्या
- भविष्यवाणी (logit,data_test, type = 'response'): परीक्षण सेट पर पूर्वानुमान की गणना करें। प्रतिक्रिया संभावना की गणना करने के लिए type = 'response' सेट करें।
- तालिका (डेटा_टेस्ट $ आय, भविष्यवाणी> 0.5): भ्रम मैट्रिक्स की गणना करें। भविष्यवाणी> 0.5 का मतलब है कि यह 1 लौटाता है यदि अनुमानित संभावनाएं 0.5 से ऊपर हैं, अन्यथा 0।
आउटपुट:
## ## FALSE TRUE ## <=50K 6310 495 ## >50K 1074 1229
भ्रम मैट्रिक्स में प्रत्येक पंक्ति एक वास्तविक लक्ष्य को दर्शाती है, जबकि प्रत्येक स्तंभ एक पूर्वानुमानित लक्ष्य को दर्शाता है। इस मैट्रिक्स की पहली पंक्ति 50k से कम आय (गलत वर्ग) पर विचार करती है: 6241 को 50k से कम आय वाले व्यक्तियों के रूप में सही ढंग से वर्गीकृत किया गया था (सच्चा नकारात्मक), जबकि शेष को गलती से 50k से ऊपर वर्गीकृत किया गया था (सकारात्मक झूठी) दूसरी पंक्ति 50k से ऊपर की आय पर विचार करती है, सकारात्मक वर्ग 1229 थे (सच्चा सकारात्मक), जबकि सच्चा नकारात्मक 1074 था।
आप मॉडल की गणना कर सकते हैं शुद्धता कुल प्रेक्षण पर सच्चे सकारात्मक + सच्चे नकारात्मक का योग करके
accuracy_Test <- sum(diag(table_mat)) / sum(table_mat) accuracy_Test
Code व्याख्या
- sum(diag(table_mat)): विकर्ण का योग
- sum(table_mat): मैट्रिक्स का योग.
आउटपुट:
## [1] 0.8277339
मॉडल एक समस्या से ग्रस्त प्रतीत होता है, यह गलत नकारात्मकों की संख्या को अधिक आंकता है। इसे कहा जाता है सटीकता परीक्षण विरोधाभासहमने कहा कि सटीकता कुल मामलों की संख्या के लिए सही भविष्यवाणियों का अनुपात है। हमारे पास अपेक्षाकृत उच्च सटीकता हो सकती है लेकिन एक बेकार मॉडल हो सकता है। ऐसा तब होता है जब कोई प्रमुख वर्ग होता है। यदि आप भ्रम मैट्रिक्स पर वापस देखते हैं, तो आप देख सकते हैं कि अधिकांश मामलों को सच्चे नकारात्मक के रूप में वर्गीकृत किया गया है। अब कल्पना करें, मॉडल ने सभी वर्गों को नकारात्मक (यानी 50k से कम) के रूप में वर्गीकृत किया है। आपके पास 75 प्रतिशत (6718/6718+2257) की सटीकता होगी। आपका मॉडल बेहतर प्रदर्शन करता है लेकिन सच्चे सकारात्मक और सच्चे नकारात्मक के बीच अंतर करने में संघर्ष करता है।
ऐसी स्थिति में, अधिक संक्षिप्त मीट्रिक रखना बेहतर होता है। हम इस पर विचार कर सकते हैं:
- परिशुद्धता=टीपी/(टीपी+एफपी)
- रिकॉल=टीपी/(टीपी+एफएन)
परिशुद्धता बनाम स्मरण
शुद्धता सकारात्मक भविष्यवाणी की सटीकता को देखता है। वापस बुलाना सकारात्मक उदाहरणों का अनुपात है जो क्लासिफायर द्वारा सही ढंग से पता लगाया जाता है;
आप इन दो मेट्रिक्स की गणना करने के लिए दो फ़ंक्शन बना सकते हैं
- निर्माण परिशुद्धता
precision <- function(matrix) {
# True positive
tp <- matrix[2, 2]
# false positive
fp <- matrix[1, 2]
return (tp / (tp + fp))
}
Code व्याख्या
- mat[1,1]: डेटा फ़्रेम के पहले कॉलम का पहला सेल लौटाएँ, यानी सच्चा सकारात्मक
- mat[1,2]; डेटा फ़्रेम के दूसरे कॉलम का पहला सेल लौटाएँ, यानी गलत सकारात्मक
recall <- function(matrix) {
# true positive
tp <- matrix[2, 2]# false positive
fn <- matrix[2, 1]
return (tp / (tp + fn))
}
Code व्याख्या
- mat[1,1]: डेटा फ़्रेम के पहले कॉलम का पहला सेल लौटाएँ, यानी सच्चा सकारात्मक
- mat[2,1]; डेटा फ़्रेम के पहले कॉलम का दूसरा सेल लौटाएँ, यानी गलत नकारात्मक
आप अपने कार्यों का परीक्षण कर सकते हैं
prec <- precision(table_mat) prec rec <- recall(table_mat) rec
आउटपुट:
## [1] 0.712877 ## [2] 0.5336518
जब मॉडल कहता है कि यह 50 हजार से अधिक की आय वाला व्यक्ति है, तो यह केवल 54 प्रतिशत मामलों में सही है, तथा 50 प्रतिशत मामलों में 72 हजार से अधिक की आय वाले व्यक्ति का दावा किया जा सकता है।
आप बना सकते हैं 
सटीकता और स्मरण के आधार पर स्कोर। इन दो मेट्रिक्स का हार्मोनिक माध्य है, जिसका अर्थ है कि यह निचले मूल्यों को अधिक महत्व देता है।
f1 <- 2 * ((prec * rec) / (prec + rec)) f1
आउटपुट:
## [1] 0.6103799
परिशुद्धता बनाम स्मरण समझौता
उच्च परिशुद्धता और उच्च स्मरण दोनों का होना असंभव है।
अगर हम सटीकता बढ़ा दें, तो सही व्यक्ति का बेहतर अनुमान लगाया जा सकेगा, लेकिन हम उनमें से बहुतों को चूक जाएंगे (कम याददाश्त)। कुछ स्थितियों में, हम याददाश्त की तुलना में अधिक सटीकता को प्राथमिकता देते हैं। सटीकता और याददाश्त के बीच एक अवतल संबंध है।
- कल्पना कीजिए, आपको यह अनुमान लगाना है कि किसी मरीज को कोई बीमारी है या नहीं। आप जितना संभव हो उतना सटीक होना चाहते हैं।
- अगर आपको सड़क पर संभावित धोखेबाज लोगों का पता लगाने के लिए चेहरे की पहचान की ज़रूरत है, तो धोखेबाज़ के रूप में लेबल किए गए कई लोगों को पकड़ना बेहतर होगा, भले ही सटीकता कम हो। पुलिस गैर-धोखाधड़ी करने वाले व्यक्ति को रिहा करने में सक्षम होगी।
आरओसी वक्र
RSI रिसीवर Operaविशेषता वक्र बाइनरी वर्गीकरण के साथ उपयोग किया जाने वाला एक और सामान्य उपकरण है। यह परिशुद्धता/रिकॉल वक्र के समान है, लेकिन परिशुद्धता बनाम रिकॉल को प्लॉट करने के बजाय, ROC वक्र गलत सकारात्मक दर के विरुद्ध सच्ची सकारात्मक दर (यानी, रिकॉल) दिखाता है। झूठी सकारात्मक दर नकारात्मक उदाहरणों का अनुपात है जिन्हें गलत तरीके से सकारात्मक के रूप में वर्गीकृत किया गया है। यह एक माइनस सच्ची नकारात्मक दर के बराबर है। सच्ची नकारात्मक दर को भी कहा जाता है विशेषता. इसलिए आरओसी वक्र आरेख संवेदनशीलता (याद) बनाम 1-विशिष्टता
ROC वक्र को प्लॉट करने के लिए, हमें RORC नामक लाइब्रेरी स्थापित करने की आवश्यकता है। हम conda में पा सकते हैं पुस्तकालयआप कोड टाइप कर सकते हैं:
conda install -cr r-rocr –हाँ
हम भविष्यवाणी() और प्रदर्शन() फ़ंक्शन के साथ आरओसी प्लॉट कर सकते हैं।
library(ROCR) ROCRpred <- prediction(predict, data_test$income) ROCRperf <- performance(ROCRpred, 'tpr', 'fpr') plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Code व्याख्या
- भविष्यवाणी (भविष्यवाणी, डेटा_टेस्ट $ आय): ROCR लाइब्रेरी को इनपुट डेटा को बदलने के लिए एक भविष्यवाणी ऑब्जेक्ट बनाने की आवश्यकता है
- प्रदर्शन (ROCRpred, 'tpr','fpr'): ग्राफ में बनाने के लिए दो संयोजन लौटाएँ। यहाँ, tpr और fpr का निर्माण किया गया है। परिशुद्धता और रिकॉल को एक साथ प्लॉट करने के लिए, “prec”, “rec” का उपयोग करें।
आउटपुट:
चरण 8) मॉडल में सुधार करें
आप मॉडल के बीच बातचीत के साथ गैर-रैखिकता जोड़ने का प्रयास कर सकते हैं
- आयु और प्रति सप्ताह घंटे
- लिंग और प्रति सप्ताह घंटे.
आपको दोनों मॉडलों की तुलना करने के लिए स्कोर परीक्षण का उपयोग करना होगा
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
आउटपुट:
## [1] 0.6109181
यह स्कोर पिछले स्कोर से थोड़ा ज़्यादा है। आप डेटा पर काम करते रह सकते हैं और स्कोर को मात देने की कोशिश कर सकते हैं।
सारांश
हम नीचे दी गई तालिका में लॉजिस्टिक रिग्रेशन को प्रशिक्षित करने के लिए फ़ंक्शन को संक्षेप में प्रस्तुत कर सकते हैं:
| पैकेज | उद्देश्य | समारोह | तर्क |
|---|---|---|---|
| - | प्रशिक्षण/परीक्षण डेटासेट बनाएँ | ट्रेन_सेट_बनाएँ() | डेटा, आकार, ट्रेन |
| GLM | सामान्यीकृत रेखीय मॉडल को प्रशिक्षित करें | जीएलएम() | सूत्र, डेटा, परिवार* |
| GLM | मॉडल का सारांश बताएँ | सारांश() | फिटेड मॉडल |
| आधार | भविष्यवाणी करना | अनुमान है () | फिटेड मॉडल, डेटासेट, प्रकार = 'प्रतिक्रिया' |
| आधार | एक भ्रम मैट्रिक्स बनाएँ | मेज़() | y, भविष्यवाणी() |
| आधार | सटीकता स्कोर बनाएं | योग(निदान(तालिका())/योग(तालिका() | |
| आरओसीआर | आरओसी बनाएं : चरण 1 पूर्वानुमान बनाएं | भविष्यवाणी() | भविष्यवाणी(), y |
| आरओसीआर | आरओसी बनाएं : चरण 2 प्रदर्शन बनाएं | प्रदर्शन() | भविष्यवाणी(), 'टीपीआर', 'एफपीआर' |
| आरओसीआर | आरओसी बनाएं : चरण 3 ग्राफ प्लॉट करें | भूखंड() | प्रदर्शन() |
अन्य GLM मॉडल के प्रकार हैं:
– द्विपद: (लिंक = “लॉगिट”)
– गॉसियन: (लिंक = “पहचान”)
- गामा: (लिंक = "उलटा")
– inverse.gaussian: (लिंक = “1/mu^2”)
– पॉइसन: (लिंक = “लॉग”)
– अर्ध: (लिंक = “पहचान”, विचरण = “स्थिर”)
- क्वासिबिनोमियल: (लिंक = "लॉगिट")
– क्वासिपोइसन: (लिंक = “लॉग”)
