GLM σε R: Γενικευμένο γραμμικό μοντέλο με παράδειγμα

Τι είναι η λογιστική παλινδρόμηση;

Η λογιστική παλινδρόμηση χρησιμοποιείται για να προβλέψει μια τάξη, δηλαδή μια πιθανότητα. Η λογιστική παλινδρόμηση μπορεί να προβλέψει με ακρίβεια ένα δυαδικό αποτέλεσμα.

Φανταστείτε ότι θέλετε να προβλέψετε εάν ένα δάνειο απορρίπτεται / γίνεται αποδεκτό βάσει πολλών χαρακτηριστικών. Η λογιστική παλινδρόμηση έχει τη μορφή 0/1. y = 0 εάν ένα δάνειο απορριφθεί, y = 1 εάν γίνει δεκτό.

Ένα μοντέλο λογιστικής παλινδρόμησης διαφέρει από το μοντέλο γραμμικής παλινδρόμησης με δύο τρόπους.

• Πρώτα απ 'όλα, η λογιστική παλινδρόμηση δέχεται μόνο διχοτομημένη (δυαδική) είσοδο ως εξαρτώμενη μεταβλητή (δηλαδή, ένα διάνυσμα 0 και 1).
• Δεύτερον, το αποτέλεσμα μετριέται με την ακόλουθη πιθανοτική συνάρτηση ζεύξης που ονομάζεται sigmoid λόγω του σχήματος S:

Η έξοδος της συνάρτησης είναι πάντα μεταξύ 0 και 1. Ελέγξτε την παρακάτω εικόνα

Η συνάρτηση σιγμοειδής επιστρέφει τιμές από 0 έως 1. Για την εργασία ταξινόμησης, χρειαζόμαστε μια διακριτή έξοδο 0 ή 1.

Για να μετατρέψουμε μια συνεχή ροή σε ξεχωριστή τιμή, μπορούμε να ορίσουμε μια απόφαση δεσμευμένη στο 0,5. Όλες οι τιμές πάνω από αυτό το όριο ταξινομούνται ως 1

Σε αυτό το σεμινάριο, θα μάθετε

• Τι είναι η λογιστική παλινδρόμηση;
• Τρόπος δημιουργίας Generalized Liner Model (GLM)
• Βήμα 1) Ελέγξτε συνεχείς μεταβλητές
• Βήμα 2) Ελέγξτε τις μεταβλητές παράγοντα
• Βήμα 3) Μηχανική χαρακτηριστικών
• Βήμα 4) Συνοπτική Στατιστική
• Βήμα 5) Εκπαίδευση / σύνολο δοκιμών
• Βήμα 6) Δημιουργήστε το μοντέλο
• Βήμα 7) Αξιολογήστε την απόδοση του μοντέλου

Τρόπος δημιουργίας Generalized Liner Model (GLM)

Ας χρησιμοποιήσουμε το σύνολο δεδομένων ενηλίκων για να απεικονίσουμε τη λογιστική παλινδρόμηση. Το "ενηλίκων" είναι ένα εξαιρετικό σύνολο δεδομένων για την εργασία ταξινόμησης. Ο στόχος είναι να προβλεφθεί εάν το ετήσιο εισόδημα σε δολάρια ενός ατόμου θα υπερβεί τις 50.000. Το σύνολο δεδομένων περιέχει 46.033 παρατηρήσεις και δέκα χαρακτηριστικά:

• ηλικία: ηλικία του ατόμου. Αριθμητικός
• εκπαίδευση: Εκπαιδευτικό επίπεδο του ατόμου. Παράγοντας.
• marital.status: Οικογενειακή κατάσταση του ατόμου. Συντελεστής δηλ. Ποτέ-παντρεμένος, παντρεμένος-συζύγος,…
• φύλο: Φύλο του ατόμου. Παράγοντας, δηλαδή Άνδρας ή Γυναίκα
• εισόδημα: μεταβλητή στόχος. Έσοδα άνω ή κάτω των 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,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… 

Θα προχωρήσουμε ως εξής:

• Βήμα 1: Ελέγξτε συνεχείς μεταβλητές
• Βήμα 2: Ελέγξτε τις μεταβλητές του παράγοντα
• Βήμα 3: Μηχανική χαρακτηριστικών
• Βήμα 4: Συνοπτική στατιστική
• Βήμα 5: Εκπαίδευση / σύνολο δοκιμών
• Βήμα 6: Δημιουργήστε το μοντέλο
• Βήμα 7: Αξιολογήστε την απόδοση του μοντέλου
• βήμα 8: Βελτιώστε το μοντέλο

Η αποστολή σας είναι να προβλέψετε ποιο άτομο θα έχει έσοδα υψηλότερα από 50K.

Σε αυτό το σεμινάριο, κάθε βήμα θα αναλυθεί για να πραγματοποιήσει μια ανάλυση σε ένα πραγματικό σύνολο δεδομένων.

Βήμα 1) Ελέγξτε συνεχείς μεταβλητές

Στο πρώτο βήμα, μπορείτε να δείτε την κατανομή των συνεχών μεταβλητών.

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

Επεξήγηση κώδικα

• συνεχής <- select_if (data_adult, is.numeric): Χρησιμοποιήστε τη συνάρτηση select_if () από τη βιβλιοθήκη dplyr για να επιλέξετε μόνο τις αριθμητικές στήλες
• περίληψη (συνεχής): Εκτυπώστε τη στατιστική περίληψης

Παραγωγή:

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

Από τον παραπάνω πίνακα, μπορείτε να δείτε ότι τα δεδομένα έχουν εντελώς διαφορετικές κλίμακες και ώρες. Τοper.weeks έχει μεγάλα ακραία σημεία (.ie κοιτάξτε το τελευταίο τεταρτημόριο και τη μέγιστη τιμή).

Μπορείτε να το αντιμετωπίσετε ακολουθώντας δύο βήματα:

• 1: Σχεδιάστε τη διανομή του hour.per.week
• 2: Τυποποίηση των συνεχών μεταβλητών

1. Σχεδιάστε τη διανομή

Ας δούμε πιο κοντά την κατανομή του hour.per.week

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

Παραγωγή:

Η μεταβλητή έχει πολλά outliers και όχι καλά καθορισμένη κατανομή. Μπορείτε να αντιμετωπίσετε εν μέρει αυτό το πρόβλημα διαγράφοντας το κορυφαίο 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

Επεξήγηση κώδικα

• quantile (data_adult $ hours.per.week, .99): Υπολογίστε την τιμή του 99 τοις εκατό του χρόνου εργασίας

Παραγωγή:

## 99%## 80 

Το 98% του πληθυσμού εργάζεται κάτω από 80 ώρες την εβδομάδα.

Μπορείτε να ρίξετε τις παρατηρήσεις πάνω από αυτό το όριο. Χρησιμοποιείτε το φίλτρο από τη βιβλιοθήκη dplyr.

data_adult_drop <-data_adult %>%filter(hours.per.week
Παραγωγή:
## [1] 45537 10 
 

Τυποποιήστε τις συνεχείς μεταβλητές

Μπορείτε να τυποποιήσετε κάθε στήλη για να βελτιώσετε την απόδοση, επειδή τα δεδομένα σας δεν έχουν την ίδια κλίμακα. Μπορείτε να χρησιμοποιήσετε τη συνάρτηση mutate_if από τη βιβλιοθήκη dplyr. Η βασική σύνταξη είναι:
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)
Επεξήγηση κώδικα

mutate_if (is.numeric, funs (κλίμακα)): Η συνθήκη είναι μόνο αριθμητική στήλη και η συνάρτηση είναι κλίμακα

Παραγωγή:
## 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 columnfactor <- data.frame(select_if(data_adult_rescale, is.factor))ncol(factor)
Επεξήγηση κώδικα

data.frame (select_if (data_adult, is.factor)): Αποθηκεύουμε τις στήλες παράγοντα σε παράγοντα σε έναν τύπο πλαισίου δεδομένων. Η βιβλιοθήκη ggplot2 απαιτεί ένα αντικείμενο πλαισίου δεδομένων.

Παραγωγή:
## [1] 6 
Το σύνολο δεδομένων περιέχει 6 κατηγορικές μεταβλητές
Το δεύτερο βήμα είναι πιο εξειδικευμένο. Θέλετε να σχεδιάσετε ένα γράφημα ράβδων για κάθε στήλη στον παράγοντα πλαισίου δεδομένων. Είναι πιο βολικό να αυτοματοποιήσετε τη διαδικασία, ειδικά σε περίπτωση που υπάρχουν πολλές στήλες.
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)))
Επεξήγηση κώδικα

lapply (): Χρησιμοποιήστε τη συνάρτηση lapply () για να περάσετε μια συνάρτηση σε όλες τις στήλες του συνόλου δεδομένων. Αποθηκεύετε την έξοδο σε μια λίστα
συνάρτηση (x): Η συνάρτηση θα υποβληθεί σε επεξεργασία για κάθε x. Εδώ είναι οι στήλες
ggplot (συντελεστής, aes (get (x))) + geom_bar () + θέμα (axis.text.x = element_text (angle = 90)): Δημιουργήστε ένα γράφημα ράβδων για κάθε στοιχείο x. Σημείωση, για να επιστρέψετε το x ως στήλη, πρέπει να το συμπεριλάβετε στο get ()

Το τελευταίο βήμα είναι σχετικά εύκολο. Θέλετε να εκτυπώσετε τα 6 γραφήματα.
# Print the graphgraph
Παραγωγή:
## [[1]]

## ## [[2]]

## ## [[3]]

## ## [[4]]

## ## [[5]]

## ## [[6]]

Σημείωση: Χρησιμοποιήστε το επόμενο κουμπί για να μεταβείτε στο επόμενο γράφημα

Βήμα 3) Μηχανική χαρακτηριστικών
Αναδιατύπωση της εκπαίδευσης
Από το παραπάνω γράφημα, μπορείτε να δείτε ότι η μεταβλητή εκπαίδευση έχει 16 επίπεδα. Αυτό είναι σημαντικό και ορισμένα επίπεδα έχουν σχετικά χαμηλό αριθμό παρατηρήσεων. Εάν θέλετε να βελτιώσετε τον όγκο των πληροφοριών που μπορείτε να λάβετε από αυτήν τη μεταβλητή, μπορείτε να τις αναδιαμορφώσετε σε υψηλότερο επίπεδο. Δηλαδή, δημιουργείτε μεγαλύτερες ομάδες με παρόμοιο επίπεδο εκπαίδευσης. Για παράδειγμα, το χαμηλό επίπεδο εκπαίδευσης θα μετατραπεί σε εγκατάλειψη. Τα υψηλότερα επίπεδα εκπαίδευσης θα αλλάξουν σε μάστερ.
Εδώ είναι η λεπτομέρεια:
 

 
 

Παλιό επίπεδο
 

Νέο επίπεδο
 

 

 

 
 

Προσχολικός
 

εγκατάλειψη
 

 
 

10η
 

Εγκατάλειψη
 

 
 

11η
 

Εγκατάλειψη
 

 
 

12η
 

Εγκατάλειψη
 

 
 

1η-4η
 

Εγκατάλειψη
 

 
 

5η-6η
 

Εγκατάλειψη
 

 
 

7ος-8ος
 

Εγκατάλειψη
 

 
 

9η
 

Εγκατάλειψη
 

 
 

HS-Grad
 

Χάινγκραντ
 

 
 

Κάποιο Κολέγιο
 

Κοινότητα
 

 
 

Assoc-acdm
 

Κοινότητα
 

 
 

Assoc-φωνη
 

Κοινότητα
 

 
 

Πτυχίο
 

Πτυχίο
 

 
 

Δάσκαλοι
 

Δάσκαλοι
 

 
 

Καθηγητής-σχολείο
 

Δάσκαλοι
 

 
 

Διδακτορικό
 

Διδακτορικό
 

 

 

 
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")))))))
Επεξήγηση κώδικα

Χρησιμοποιούμε το ρήμα μετάλλαξης από βιβλιοθήκη dplyr. Αλλάζουμε τις αξίες της εκπαίδευσης με τη δήλωση ifelse

Στον παρακάτω πίνακα, δημιουργείτε μια συνοπτική στατιστική για να δείτε, κατά μέσο όρο, πόσα χρόνια εκπαίδευσης (z-value) χρειάζεται για να φτάσετε στο Bachelor, Master ή PhD.
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##   ## 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
Αναδιατύπωση της οικογενειακής κατάστασης
Είναι επίσης δυνατό να δημιουργηθούν χαμηλότερα επίπεδα για την οικογενειακή κατάσταση. Στον ακόλουθο κώδικα αλλάζετε το επίπεδο ως εξής:
 

 
 

Παλιό επίπεδο
 

Νέο επίπεδο
 

 

 

 
 

Δεν παντρεύτηκε ποτέ
 

Χωρίς παντρεμένο
 

 
 

Παντρεμένος-σύζυγος-απουσιάζει
 

Χωρίς παντρεμένο
 

 
 

Παντρεμένος-AF-σύζυγος
 

Παντρεμένος
 

 
 

Παντρεμένος-συζύγος
 
 

 
 

Σε διασταση
 

Σε διασταση
 

 
 

Διαζευγμένος
 
 

 
 

Χήρες
 

Χήρα
 

 

 

 
# 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")))))
 Μπορείτε να ελέγξετε τον αριθμό των ατόμων σε κάθε ομάδα. 
table(recast_data$marital.status)
Παραγωγή:
## ## Married Not_married Separated Widow## 21165 15359 7727 1286 
Βήμα 4) Συνοπτική Στατιστική
Είναι καιρός να ελέγξετε κάποια στατιστικά στοιχεία σχετικά με τις μεταβλητές-στόχους μας. Στο παρακάτω γράφημα, μετράτε το ποσοστό των ατόμων που κερδίζουν περισσότερα από 50k δεδομένου του φύλου τους.
# Plot gender incomeggplot(recast_data, aes(x = gender, fill = income)) +geom_bar(position = "fill") +theme_classic()
Παραγωγή:

Στη συνέχεια, ελέγξτε εάν η προέλευση του ατόμου επηρεάζει τα κέρδη του.
# Plot origin incomeggplot(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 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()
Παραγωγή:

Η γραφική παράσταση επιβεβαιώνει ότι η κατανομή του χρόνου εργασίας ταιριάζει σε διαφορετικές ομάδες. Στην πλοκή, και τα δύο φύλα δεν έχουν ομοιογενείς παρατηρήσεις.
Μπορείτε να ελέγξετε την πυκνότητα του εβδομαδιαίου χρόνου εργασίας ανά τύπο εκπαίδευσης. Οι διανομές έχουν πολλές διαφορετικές επιλογές. Μπορεί πιθανώς να εξηγηθεί από τον τύπο της σύμβασης στις ΗΠΑ.
# Plot distribution working time by educationggplot(recast_data, aes(x = hours.per.week)) +geom_density(aes(color = education), alpha = 0.5) +theme_classic()
Επεξήγηση κώδικα

ggplot (recast_data, aes (x = hours.per.week)): Ένα διάγραμμα πυκνότητας απαιτεί μόνο μία μεταβλητή
geom_density (aes (color = education), alpha = 0.5): Το γεωμετρικό αντικείμενο για τον έλεγχο της πυκνότητας

Παραγωγή:

Για να επιβεβαιώσετε τις σκέψεις σας, μπορείτε να πραγματοποιήσετε ένα μονόδρομο τεστ ANOVA:
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
Η δοκιμή ANOVA επιβεβαιώνει τη διαφορά του μέσου όρου μεταξύ των ομάδων.
Μη γραμμικότητα
Πριν εκτελέσετε το μοντέλο, μπορείτε να δείτε εάν ο αριθμός των ωρών εργασίας σχετίζεται με την ηλικία.
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()
Επεξήγηση κώδικα

ggplot (recast_data, aes (x = age, y = hours.per.week)): Ορίστε την αισθητική του γραφήματος
geom_point (aes (χρώμα = εισόδημα), μέγεθος = 0,5): Κατασκευάστε την κουκκίδα
stat_smooth (): Προσθέστε τη γραμμή τάσης με τα ακόλουθα ορίσματα:

method = 'lm': Σχεδιάστε την προσαρμοσμένη τιμή εάν η γραμμική παλινδρόμηση
τύπος = y ~ poly (x, 2): Τοποθετήστε μια πολυωνυμική παλινδρόμηση
se = TRUE: Προσθέστε το τυπικό σφάλμα
aes (χρώμα = εισόδημα): Σπάστε το μοντέλο κατά εισόδημα



Παραγωγή:

Με λίγα λόγια, μπορείτε να δοκιμάσετε τους όρους αλληλεπίδρασης στο μοντέλο για να επιλέξετε το μη γραμμικό αποτέλεσμα μεταξύ του εβδομαδιαίου χρόνου εργασίας και άλλων λειτουργιών. Είναι σημαντικό να εντοπιστεί υπό ποια κατάσταση διαφέρει ο χρόνος εργασίας.
Συσχέτιση
Ο επόμενος έλεγχος είναι να απεικονιστεί η συσχέτιση μεταξύ των μεταβλητών. Μπορείτε να μετατρέψετε τον τύπο επιπέδου παράγοντα σε αριθμητικό, ώστε να σχεδιάσετε έναν χάρτη θερμότητας που να περιέχει τον συντελεστή συσχέτισης που υπολογίζεται με τη μέθοδο 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")
Επεξήγηση κώδικα

data.frame (lapply (recast_data, as.integer)): Μετατροπή δεδομένων σε αριθμητικό
Το ggcorr () σχεδιάζει τον χάρτη θερμότητας με τα ακόλουθα ορίσματα:

μέθοδος: Μέθοδος υπολογισμού της συσχέτισης
nbreaks = 6: Αριθμός διακοπής
hjust = 0.8: Θέση ελέγχου του ονόματος της μεταβλητής στην πλοκή
label = TRUE: Προσθέστε ετικέτες στο κέντρο των παραθύρων
label_size = 3: Ετικέτες μεγέθους
color = "grey50"): Χρώμα της ετικέτας



Παραγωγή:

Βήμα 5) Εκπαίδευση / σύνολο δοκιμών
Κάθε εποπτευόμενη εργασία μηχανικής εκμάθησης απαιτεί τον διαχωρισμό των δεδομένων μεταξύ ενός συνόλου τρένων και ενός συνόλου δοκιμών. Μπορείτε να χρησιμοποιήσετε τη "λειτουργία" που δημιουργήσατε στα άλλα εποπτευόμενα εκπαιδευτικά σεμινάρια για να δημιουργήσετε ένα σετ τρένων / δοκιμών.
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)
Παραγωγή:
## [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)
Επεξήγηση κώδικα

τύπος <- εισόδημα ~.: Δημιουργήστε το μοντέλο που ταιριάζει
logit <- glm (formula, data = data_train, family = 'binomial'): Προσαρμόστε ένα λογιστικό μοντέλο (οικογένεια = 'binomial') με τα δεδομένα data_train.
περίληψη (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
Η περίληψη του μοντέλου μας αποκαλύπτει ενδιαφέρουσες πληροφορίες. Η απόδοση μιας λογιστικής παλινδρόμησης αξιολογείται με συγκεκριμένες βασικές μετρήσεις.

AIC (Κριτικά πληροφοριών Akaike): Αυτό είναι το ισοδύναμο του R2 στη λογιστική παλινδρόμηση. Μετρά την καταλληλότητα όταν επιβάλλεται ποινή στον αριθμό των παραμέτρων. Οι μικρότερες τιμές AIC δείχνουν ότι το μοντέλο είναι πιο κοντά στην αλήθεια.
Null deviance: Ταιριάζει στο μοντέλο μόνο με την τομή. Ο βαθμός ελευθερίας είναι n-1. Μπορούμε να την ερμηνεύσουμε ως τιμή τετραγώνου Chi (προσαρμοσμένη τιμή διαφορετική από τη δοκιμή υπόθεσης πραγματικής αξίας).
Residual Deviance: Μοντέλο με όλες τις μεταβλητές. Ερμηνεύεται επίσης ως δοκιμή υπόθεσης Chi-square.
Αριθμός επαναλήψεων βαθμολογίας Fisher: Αριθμός επαναλήψεων πριν από τη σύγκλιση.

Η έξοδος της συνάρτησης glm () αποθηκεύεται σε μια λίστα. Ο παρακάτω κώδικας δείχνει όλα τα διαθέσιμα στοιχεία στη μεταβλητή logit που κατασκευάσαμε για την αξιολόγηση της λογιστικής παλινδρόμησης.
# Η λίστα είναι πολύ μεγάλη, εκτυπώστε μόνο τα τρία πρώτα στοιχεία
lapply(logit, class)[1:3]
Παραγωγή:
## $coefficients## [1] "numeric"#### $residuals## [1] "numeric"#### $fitted.values## [1] "numeric"
Κάθε τιμή μπορεί να εξαχθεί με το σύμβολο $ ακολουθούμενο από το όνομα των μετρήσεων. Για παράδειγμα, αποθηκεύσατε το μοντέλο ως logit. Για να εξαγάγετε τα κριτήρια AIC, χρησιμοποιείτε:
logit$aic
Παραγωγή:
## [1] 27086.65
Βήμα 7) Αξιολογήστε την απόδοση του μοντέλου
Πίνακας σύγχυσης
Ο πίνακας σύγχυσης είναι μια καλύτερη επιλογή για την αξιολόγηση της απόδοσης ταξινόμησης σε σύγκριση με τις διαφορετικές μετρήσεις που είδατε προηγουμένως. Η γενική ιδέα είναι να μετρήσετε τον αριθμό των φορών που ταξινομούνται οι πραγματικές εμφανίσεις είναι ψευδείς.

Για τον υπολογισμό του πίνακα σύγχυσης, πρέπει πρώτα να έχετε ένα σύνολο προβλέψεων, ώστε να μπορούν να συγκριθούν με τους πραγματικούς στόχους.
predict <- predict(logit, data_test, type = 'response')# confusion matrixtable_mat <- table(data_test$income, predict > 0.5)table_mat
Επεξήγηση κώδικα

προβλέψτε (logit, data_test, type = 'response'): Υπολογίστε την πρόβλεψη στο σύνολο δοκιμών. Ορίστε τον τύπο = 'απόκριση' για να υπολογίσετε την πιθανότητα απόκρισης.
πίνακας (data_test $ έσοδα, προβλέψτε> 0,5): Υπολογίστε τον πίνακα σύγχυσης. προβλέψτε> 0,5 σημαίνει ότι επιστρέφει 1 εάν οι προβλεπόμενες πιθανότητες είναι πάνω από 0,5, αλλιώς 0.

Παραγωγή:
#### FALSE TRUE## <=50K 6310 495## >50K 1074 1229
Κάθε σειρά σε έναν πίνακα σύγχυσης αντιπροσωπεύει έναν πραγματικό στόχο, ενώ κάθε στήλη αντιπροσωπεύει έναν προβλεπόμενο στόχο. Η πρώτη σειρά αυτού του πίνακα θεωρεί ότι το εισόδημα είναι μικρότερο από 50k (το False class): 6241 ταξινομήθηκαν σωστά ως άτομα με εισόδημα μικρότερο από 50k ( True αρνητικό ), ενώ το υπόλοιπο κατηγοριοποιήθηκε εσφαλμένα ως πάνω από 50k ( False positive ). Η δεύτερη σειρά θεωρεί ότι το εισόδημα πάνω από 50k, η θετική τάξη ήταν 1229 ( True positive ), ενώ το True αρνητικό ήταν 1074.
Μπορείτε να υπολογίσετε την ακρίβεια του μοντέλου αθροίζοντας το πραγματικό θετικό + το πραγματικό αρνητικό σε σχέση με τη συνολική παρατήρηση

accuracy_Test <- sum(diag(table_mat)) / sum(table_mat)accuracy_Test
Επεξήγηση κώδικα

άθροισμα (diag (table_mat)): Άθροισμα της διαγώνιας
άθροισμα (table_mat): Άθροισμα του πίνακα.

Παραγωγή:
## [1] 0.8277339 
Το μοντέλο φαίνεται να υποφέρει από ένα πρόβλημα, υπερεκτιμά τον αριθμό των ψευδών αρνητικών. Αυτό ονομάζεται παράδοξο δοκιμής ακρίβειας . Δηλώσαμε ότι η ακρίβεια είναι ο λόγος των σωστών προβλέψεων προς τον συνολικό αριθμό περιπτώσεων. Μπορούμε να έχουμε σχετικά υψηλή ακρίβεια αλλά ένα άχρηστο μοντέλο. Συμβαίνει όταν υπάρχει μια κυρίαρχη τάξη. Εάν κοιτάξετε πίσω τον πίνακα σύγχυσης, μπορείτε να δείτε ότι οι περισσότερες περιπτώσεις ταξινομούνται ως αληθινές αρνητικές. Φανταστείτε τώρα, το μοντέλο ταξινόμησε όλες τις τάξεις ως αρνητικές (δηλαδή χαμηλότερες από 50k). Θα έχετε ακρίβεια 75 τοις εκατό (6718/6718 + 2257). Το μοντέλο σας έχει καλύτερη απόδοση, αλλά δυσκολεύεται να διακρίνει το πραγματικό θετικό με το πραγματικό αρνητικό.
Σε μια τέτοια κατάσταση, είναι προτιμότερο να έχουμε μια πιο περιεκτική μέτρηση. Μπορούμε να δούμε:

Ακρίβεια = TP / (TP + FP)
Ανάκληση = TP / (TP + FN)

Ακρίβεια έναντι ανάκλησης
Η ακρίβεια εξετάζει την ακρίβεια της θετικής πρόβλεψης. Ανάκληση είναι η αναλογία θετικών παρουσιών που εντοπίζονται σωστά από τον ταξινομητή.
Μπορείτε να δημιουργήσετε δύο συναρτήσεις για τον υπολογισμό αυτών των δύο μετρήσεων

Κατασκευή ακρίβειας

precision <- function(matrix) {# True positivetp <- matrix[2, 2]# false positivefp <- matrix[1, 2]return (tp / (tp + fp))}
Επεξήγηση κώδικα

mat [1,1]: Επιστρέψτε το πρώτο κελί της πρώτης στήλης του πλαισίου δεδομένων, δηλαδή το πραγματικό θετικό
χαλί [1,2]; Επιστρέψτε το πρώτο κελί της δεύτερης στήλης του πλαισίου δεδομένων, δηλ. Το ψευδώς θετικό

recall <- function(matrix) {# true positivetp <- matrix[2, 2]# false positivefn <- matrix[2, 1]return (tp / (tp + fn))}
Επεξήγηση κώδικα

mat [1,1]: Επιστρέψτε το πρώτο κελί της πρώτης στήλης του πλαισίου δεδομένων, δηλαδή το πραγματικό θετικό
χαλί [2,1]; Επιστρέψτε το δεύτερο κελί της πρώτης στήλης του πλαισίου δεδομένων, δηλαδή το αρνητικό αρνητικό

Μπορείτε να ελέγξετε τις λειτουργίες σας
prec <- precision(table_mat)precrec <- recall(table_mat)rec
Παραγωγή:
## [1] 0.712877## [2] 0.5336518
Όταν το μοντέλο λέει ότι είναι ένα άτομο άνω των 50k, είναι σωστό μόνο στο 54 τοις εκατό της υπόθεσης και μπορεί να αξιώσει άτομα άνω των 50k στο 72 τοις εκατό της υπόθεσης.
Μπορείτε να δημιουργήσετε το είναι ένα αρμονικός μέσος αυτών των δύο μετρήσεις, που σημαίνει ότι δίνει περισσότερο βάρος στις χαμηλότερες τιμές.

f1 <- 2 * ((prec * rec) / (prec + rec))f1
Παραγωγή:
## [1] 0.6103799 
Ανταλλαγή ακριβείας έναντι ανάκλησης
Είναι αδύνατο να έχουμε τόσο υψηλή ακρίβεια όσο και υψηλή ανάκληση.
Εάν αυξήσουμε την ακρίβεια, το σωστό άτομο θα προβλεφθεί καλύτερα, αλλά θα χάναμε πολλά από αυτά (χαμηλότερη ανάκληση). Σε ορισμένες περιπτώσεις, προτιμούμε μεγαλύτερη ακρίβεια από την ανάκληση. Υπάρχει μια κοίλη σχέση μεταξύ ακρίβειας και ανάκλησης.

Φανταστείτε, πρέπει να προβλέψετε εάν ένας ασθενής έχει μια ασθένεια. Θέλετε να είστε όσο το δυνατόν ακριβέστεροι.
Εάν πρέπει να εντοπίσετε πιθανούς δόλιους ανθρώπους στο δρόμο μέσω της αναγνώρισης προσώπου, θα ήταν καλύτερα να πιάσετε πολλά άτομα που έχουν χαρακτηριστεί ως δόλια, παρόλο που η ακρίβεια είναι χαμηλή. Η αστυνομία θα είναι σε θέση να απελευθερώσει το μη δόλιο άτομο.

Η καμπύλη ROC
Η καμπύλη χαρακτηριστικού λειτουργίας του δέκτη είναι ένα άλλο κοινό εργαλείο που χρησιμοποιείται με δυαδική ταξινόμηση. Είναι πολύ παρόμοιο με την καμπύλη ακρίβειας / ανάκλησης, αλλά αντί να σχεδιάζει την ακρίβεια έναντι της ανάκλησης, η καμπύλη ROC εμφανίζει τον πραγματικό θετικό ρυθμό (δηλαδή ανάκληση) έναντι του ψευδώς θετικού ρυθμού. Το ψευδώς θετικό ποσοστό είναι η αναλογία αρνητικών παρουσιών που ταξινομούνται λανθασμένα ως θετικές. Είναι ίσο με ένα μείον τον πραγματικό αρνητικό ρυθμό. Ο πραγματικός αρνητικός ρυθμός ονομάζεται επίσης ειδικότητα . Εξ ου και η καμπύλη ROC σχεδιάζει ευαισθησία (ανάκληση) έναντι 1-ειδικότητας
Για να σχεδιάσουμε την καμπύλη ROC, πρέπει να εγκαταστήσουμε μια βιβλιοθήκη που ονομάζεται RORC. Μπορούμε να βρούμε στη βιβλιοθήκη conda. Μπορείτε να πληκτρολογήσετε τον κωδικό:
conda install -cr r-rocr - ναι
Μπορούμε να σχεδιάσουμε το ROC με τις λειτουργίες πρόβλεψης () και απόδοσης ().
library(ROCR)ROCRpred <- prediction(predict, data_test$income)ROCRperf <- performance(ROCRpred, 'tpr', 'fpr')plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2, 1.7))
Επεξήγηση κώδικα

πρόβλεψη (πρόβλεψη, data_test $ έσοδα): Η βιβλιοθήκη ROCR πρέπει να δημιουργήσει ένα αντικείμενο πρόβλεψης για να μετατρέψει τα δεδομένα εισόδου
απόδοση (ROCRpred, 'tpr', 'fpr'): Επιστρέψτε τους δύο συνδυασμούς για παραγωγή στο γράφημα. Εδώ κατασκευάζονται tpr και fpr. Για να σχεδιάσετε την ακρίβεια και να ανακαλέσετε μαζί, χρησιμοποιήστε "prec", "rec".

Παραγωγή:

Βήμα 8) Βελτιώστε το μοντέλο
Μπορείτε να προσπαθήσετε να προσθέσετε μη γραμμικότητα στο μοντέλο με την αλληλεπίδραση μεταξύ

ηλικία και ώρες.per.week
φύλο και ώρες .per.week.

Πρέπει να χρησιμοποιήσετε τη δοκιμή βαθμολογίας για να συγκρίνετε και τα δύο μοντέλα
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 
Το σκορ είναι ελαφρώς υψηλότερο από το προηγούμενο. Μπορείτε να συνεχίσετε να εργάζεστε στα δεδομένα προσπαθώντας να κερδίσετε το σκορ.

Περίληψη
Μπορούμε να συνοψίσουμε τη λειτουργία για να εκπαιδεύσουμε μια λογιστική παλινδρόμηση στον παρακάτω πίνακα:
 

 
 

Πακέτο
 

Σκοπός
 

λειτουργία
 

διαφωνία
 

 

 

 
 

-
 

Δημιουργία συνόλου δεδομένων τρένου / δοκιμής
 

create_train_set ()
 

δεδομένα, μέγεθος, τρένο
 

 
 

γλαμ
 

Εκπαιδεύστε ένα Γενικευμένο Γραμμικό Μοντέλο
 

glm ()
 

τύπος, δεδομένα, οικογένεια *
 

 
 

γλαμ
 

Συνοψίστε το μοντέλο
 

περίληψη()
 

προσαρμοσμένο μοντέλο
 

 
 

βάση
 

Κάντε προβλέψεις
 

προλέγω()
 

προσαρμοσμένο μοντέλο, σύνολο δεδομένων, type = 'απόκριση'
 

 
 

βάση
 

Δημιουργήστε έναν πίνακα σύγχυσης
 

τραπέζι()
 

y, προβλέψτε ()
 

 
 

βάση
 

Δημιουργήστε βαθμολογία ακρίβειας
 

άθροισμα (διάγραμμα (πίνακας ()) / άθροισμα (πίνακας ()
 

 
 

ROCR
 

Δημιουργία ROC: Βήμα 1 Δημιουργία πρόβλεψης
 

προφητεία()
 

προβλέψτε (), y
 

 
 

ROCR
 

Δημιουργία ROC: Βήμα 2 Δημιουργία απόδοσης
 

εκτέλεση()
 

πρόβλεψη (), "tpr", "fpr"
 

 
 

ROCR
 

Δημιουργία ROC: Βήμα 3 Σχεδιάγραμμα
 

οικόπεδο()
 

εκτέλεση()
 

 

 

Οι άλλοι τύποι μοντέλων GLM είναι:
- διωνυμία: (link = "logit")
- gaussian: (σύνδεσμος = "ταυτότητα")
- Γάμμα: (σύνδεσμος = "αντίστροφο")
- inverse.gaussian: (σύνδεσμος = "1 / mu 2")
- poisson: (σύνδεσμος = "log")
- οιονεί: (σύνδεσμος = "ταυτότητα", διακύμανση = "σταθερά")
- quasibinomial: (link = "logit")
- quasipoisson: (link = "log")