Το επιλεγμένο σύνολο δεδομένων περιέχει πληροφορίες σχετικά με διάφορα μοντέλα φορητών υπολογιστών, τις προδιαγραφές τους και τις αντίστοιχες τιμές τους. Είναι χρήσιμο για την ανάλυση του τρόπου με τον οποίο διάφορα χαρακτηριστικά (όπως η μάρκα, το μέγεθος της οθόνης, η μνήμη RAM και ο επεξεργαστής) επηρεάζουν την τιμή ενός φορητού υπολογιστή. Αυτό το σύνολο δεδομένων μπορεί να βοηθήσει τις επιχειρήσεις, τους καταναλωτές και τους αναλυτές να κατανοήσουν τις τάσεις της αγοράς και τις στρατηγικές τιμολόγησης.
Μετατροπή των Inches και RAM.
Στο αρχικό Dataset, τα attributes Inches,
Weight και RAM ήταν τύπου
Categorical, παρά το γεγονός ότι ήταν νούμερα.
Έγινε η μετατροπή τους σε Numeric για την καλύτερη
ερμηνεία του συνόλου.
Μετατροπή των τιμών.
Οι τιμές των φορητών υπολογιστών ήταν εκφρασμένες σε Ρουπία
Ινδίας.
Αυτές μετατράπηκαν σε ευρώ και έγινε στρογγυλοποίηση
των 2 δεκαδικών στοιχείων για καλύτερη κατανόηση του
συνόλου.
Έλεγχος και χειρισμός ελλιπών τιμών.
Τα αντικείμενα του συνόλου δεδομένων ήταν 1303.
Μετά τον έλεγχο για διπλότυπα και την αφαίρεση
των ελλιπών τιμών,
έμειναν 1273 αντικείμενα.
kable(df, format = "html", align = "c", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE, position = "center") %>%
column_spec(3, bold = TRUE)| Χαρακτηριστικό | Περιγραφή | Τύπος |
|---|---|---|
| Εταιρεία | Η μάρκα του φορητού υπολογιστή (π.χ. Dell, HP, Apple). | Categorical |
| TypeName | Η κατηγορία/ο τύπος του φορητού υπολογιστή (π.χ. Gaming, Ultrabook, Notebook). | Categorical |
| Inches | Το μέγεθος της οθόνης του φορητού υπολογιστή σε ίντσες. | Numeric |
| ScreenResolution | Η ανάλυση της οθόνης (π.χ. 1920x1080, 4K). | Categorical |
| CPU | Τα στοιχεία του επεξεργαστή (π.χ. Intel Core i5, AMD Ryzen 7). | Categorical |
| RAM | Η ποσότητα της μνήμης τυχαίας προσπέλασης (RAM) σε gigabytes (GB). | Numeric |
| Μνήμη | Ο τύπος και το μέγεθος του αποθηκευτικού χώρου (π.χ. 256 GB SSD, 1 TB HDD). | Categorical |
| GPU | Η μονάδα επεξεργασίας γραφικών (π.χ. NVIDIA GTX 1650, Intel HD Graphics). | Categorical |
| Βάρος | Το βάρος του φορητού υπολογιστή σε κιλά(kg). | Numeric |
| Λειτουργικό Σύστημα | Το λειτουργικό σύστημα του φορητού υπολογιστή (π.χ. Windows, macOS, Linux). | Categorical |
| Τιμή | Η τιμή του φορητού υπολογιστή σε Ευρώ. | Numeric |
| IsExpensive | Κατηγοριοποιεί τα λάπτοπ σε ακριβά και μη ακριβά εάν η τιμή τους ξεπερνάει τα 800 ευρώ | Boolean |
Για τον διαχωρισμό του συνόλου δεδομένων χρησιμοποίησα την μεταβλητή IsExpensive. Το training set είναι το 80% της βάσης με seed 953.
library(caTools)
set.seed(953)
split <- sample.split(laptopData$IsExpensive,SplitRatio=0.8)
dataTrain = subset(laptopData, split == TRUE)
dataTest = subset(laptopData, split == FALSE)Παρατηρώ ότι οι καταχωρήσεις στο Train-set είναι:
## [1] 1017
ενώ στο Test-set:
## [1] 255
Για την δημιουργία του μοντέλου λογιστικής παλινδρόμησης μετέτρεψα τις κατηγορικές μεταβλητές σε factors και επειδή αυτές είχαν πολλά επίπεδα, κράτησα μόνο τα 5 δημοφιλέστερα επίπεδα κάθε κατηγορίας και τα υπόλοιπα μπήκαν στο επίπεδο “Other” κάθε μεταβλητής.
Ξεκίνησα με την μεταβλητή IsExpensive ως εξαρτημένη και έβαλα όλες τις υπόλοιπες μεταβλητές ως ανεξάρτητες στο μοντέλο μου.
library(forcats)
# Ομαδοποίηση: κρατάμε τα top 5 και τα υπόλοιπα πάνε σε "Other"
dataTrain$Gpu <- fct_lump(as.factor(dataTrain$Gpu), n = 5)
dataTrain$Cpu <- fct_lump(as.factor(dataTrain$Cpu), n = 5)
dataTrain$Company <- fct_lump(as.factor(dataTrain$Company), n = 5)
dataTrain$OpSys <- fct_lump(as.factor(dataTrain$OpSys), n = 5)
dataTrain$TypeName <- fct_lump(as.factor(dataTrain$TypeName), n = 5)
dataTrain$ScreenResolution <- fct_lump(as.factor(dataTrain$ScreenResolution), n = 5)
dataTrain$Memory <- fct_lump(as.factor(dataTrain$Memory), n = 5)
# Λογιστική Παλινδρόμηση με όλες τις ανεξάρτητες μεταβλητές
laptopmodel <- glm(IsExpensive ~ . - Price - Unnamed..0,
data = dataTrain, family = "binomial")
library(car)
Anova(laptopmodel, type = "II") ## Analysis of Deviance Table (Type II tests)
##
## Response: IsExpensive
## LR Chisq Df Pr(>Chisq)
## Company 10.552 5 0.061018 .
## TypeName 66.048 5 6.793e-13 ***
## Inches 0.005 1 0.943338
## ScreenResolution 19.042 5 0.001888 **
## Cpu 15.048 5 0.010161 *
## Ram 66.547 1 3.417e-16 ***
## Memory 30.839 5 1.008e-05 ***
## Gpu 58.705 5 2.250e-11 ***
## OpSys 34.625 5 1.787e-06 ***
## Weight 1.727 1 0.188778
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
predictTrain <- predict(laptopmodel, type="response", newdata=dataTrain)
table(dataTrain$IsExpensive, predictTrain > 0.75)##
## FALSE TRUE
## 0 724 18
## 1 120 154
Παρατηρώ ότι στο αρχικό μοντέλο γίνονται 120 + 18 = 138 λάθος προβλέψεις.
Για την αφαίρεση μεταβλητών που δεν προσθέτουν αξία, ακολούθησα την διαδικασία αφαίρεσης μεταβλητών. Από τις τιμές του significance συμπαιρένω ότι οι μεταβλητές Company, Inches, Cpu, Weight, ScreenResolution δεν προσφέρουν ιδιαίτερη αξία στο μοντέλο οπότε προχωράω στην αφαίρεση τους.
laptopmodel_updated <- glm(IsExpensive ~ Ram + Memory + TypeName + Gpu + OpSys,
data = dataTrain, family = "binomial")
Anova(laptopmodel_updated, type = "II") ## Analysis of Deviance Table (Type II tests)
##
## Response: IsExpensive
## LR Chisq Df Pr(>Chisq)
## Ram 104.348 1 < 2.2e-16 ***
## Memory 41.176 5 8.644e-08 ***
## TypeName 114.124 5 < 2.2e-16 ***
## Gpu 55.904 5 8.506e-11 ***
## OpSys 35.963 5 9.663e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
predictTrain_updated <- predict(laptopmodel_updated, type="response", newdata=dataTrain)
table(dataTrain$IsExpensive, predictTrain_updated > 0.75)##
## FALSE TRUE
## 0 725 17
## 1 113 162
Μετά την αφαίρεση των παραπάνω μεταβλητών οι λάθος προβλέψεις μου μειώνονται στις 113 + 17 = 130, όπου σημαίνει ότι το μοντέλο βελτιώθηκε ελάχιστα.
Εφόσον έγιναν πολλαπλές προσπάθειες αφαίρεσης μεταβλητών από το μοντέλο μου, παρατηρώ ότι δεν μπορώ να καταλήξω σε μοντέλο με καλύτερη απόδοση από αυτό. Οπότε θα κρατήσω αυτό το μοντέλο για τις προβλέψεις στο test set.
ggplot(dataTrain, aes(x = Ram, y = IsExpensive, color = TypeName)) +
geom_point() +
geom_smooth(method = "glm", method.args = list(family = "binomial")) +
labs(title = "Logistic Regression Plot for variables Ram and TypeName",
x = "Independent Variable (RAM)",
y = "Probability") +
theme_minimal()Για την πρόβλεψη των τιμών του test set, αρχικά πραγματοποιήθηκαν οι ίδιες μετατροπές στις κατηγορικές μεταβλητές όπως και στο train set. Στη συνέχεια, δημιουργήθηκε το μοντέλο πρόβλεψης predictTest, το οποίο βασίζεται στο μοντέλο laptopmodel_updated και χρησιμοποιεί τις μεταβλητές με τη μεγαλύτερη συσχέτιση για να κάνει προβλέψεις στο test set.
# Επικαιροποίηση του test set ανάλογα με το train set
dataTest$Gpu <- fct_other(dataTest$Gpu, keep = levels(dataTrain$Gpu))
dataTest$Cpu <- fct_other(dataTest$Cpu, keep = levels(dataTrain$Cpu))
dataTest$Company <- fct_other(dataTest$Company, keep = levels(dataTrain$Company))
dataTest$OpSys <- fct_other(dataTest$OpSys, keep = levels(dataTrain$OpSys))
dataTest$TypeName <- fct_other(dataTest$TypeName, keep = levels(dataTrain$TypeName))
dataTest$ScreenResolution <- fct_other(dataTest$ScreenResolution, keep = levels(dataTrain$ScreenResolution))
dataTest$Memory <- fct_other(dataTest$Memory, keep = levels(dataTrain$Memory))
predictTest <- predict(laptopmodel_updated, newdata = dataTest, type = "response")
# Επιλέγουμε τυχαία 10 θέσεις από το test set
sample_indices <- sample(1:length(predictTest), 10)
# Εμφανίζουμε τις αντίστοιχες τιμές
predictTest[sample_indices]## 1085 444 218 1266 600 816
## 8.479893e-01 1.235925e-02 5.930947e-02 2.906135e-02 1.057110e-09 6.850721e-03
## 1082 912 913 405
## 5.930947e-02 4.077461e-03 2.889283e-02 4.150432e-09
# Δημιουργία threshold
predictedClass <- ifelse(predictTest > 0.75, 1, 0)
# Εξάλειψη των γραμμών που έχουν NA στην πρόβλεψη
valid <- !is.na(predictedClass) & !is.na(dataTest$IsExpensive)
# Υπολογισμός της ακρίβειας χωρίς τις NA τιμές
mean(predictedClass[valid] == dataTest$IsExpensive[valid])## [1] 0.8431373
##
## FALSE TRUE
## 0 173 13
## 1 27 42
Παραπάνω εμφανίζονται οι πιθανότητες, από τυχαίες εγγραφές του dataset, τα λάπτοπ να είναι ακριβά. Ορίζοντας ως threshold το 0.75, θεωρούμε ότι ένα λάπτοπ προβλέπεται ως “ακριβό” όταν η πιθανότητα να ανήκει στην κατηγορία των ακριβών είναι μεγαλύτερη η ίση με 0.75. Αντίστοιχα, αν η πιθανότητα είναι μικρότερη από 0.75, το λάπτοπ προβλέπεται ως “μή ακριβό”. Τέλος, η ακρίβεια του μοντέλου για το συγκεκριμένο test-set είναι 84.3%, όπως φαίνεται και παραπάνω.
library(ROCR)
# Create ROCR prediction and performance objects
ROCRpred <- prediction(predictTest, dataTest$IsExpensive)
perf <- performance(ROCRpred, "tpr", "fpr")
# Extract TPR and FPR values
roc_data <- data.frame(
fpr = perf@x.values[[1]],
tpr = perf@y.values[[1]]
)
ggplot(roc_data, aes(x = fpr, y = tpr)) +
geom_line(color = "blue", size = 1.2) +
geom_abline(linetype = "dashed", color = "gray") +
labs(title = "ROC Curve for Logistic Regression Model",
x = "False Positive Rate (1 - Specificity)",
y = "True Positive Rate (Sensitivity)") +
theme_minimal()## [1] "AUC: 0.9287"
Τέλος, η ROC καμπύλη δείχνει ότι το λογιστικό μοντέλο έχει πολύ καλή ικανότητα διάκρισης μεταξύ ακριβών και μη ακριβών laptops, καθώς η καμπύλη **πλησιάζει το επάνω αριστερό άκρ*ο, μακριά από τη διαγώνιο της τυχαίας πρόβλεψης. Η τιμή του AUC είναι 0.9287, γεγονός που υποδηλώνει ότι το μοντέλο έχει πολύ υψηλή προβλεπτική ακρίβεια, με πάνω από 90% πιθανότητα** να κατατάξει σωστά ένα τυχαίο ζεύγος παρατηρήσεων. Συνεπώς, το μοντέλο θεωρείται ιδιαίτερα αποδοτικό στη συγκεκριμένη ταξινόμηση.