🔹 Περιγραφή του συνόλου δεδομένων

Το επιλεγμένο σύνολο δεδομένων περιέχει πληροφορίες σχετικά με διάφορα μοντέλα φορητών υπολογιστών, τις προδιαγραφές τους και τις αντίστοιχες τιμές τους. Είναι χρήσιμο για την ανάλυση του τρόπου με τον οποίο διάφορα χαρακτηριστικά (όπως η μάρκα, το μέγεθος της οθόνης, η μνήμη RAM και ο επεξεργαστής) επηρεάζουν την τιμή ενός φορητού υπολογιστή. Αυτό το σύνολο δεδομένων μπορεί να βοηθήσει τις επιχειρήσεις, τους καταναλωτές και τους αναλυτές να κατανοήσουν τις τάσεις της αγοράς και τις στρατηγικές τιμολόγησης.

Link for the dataset(Kaggle.com)

🔹 Αρχική διερεύνηση του συνόλου

  1. Μετατροπή των Inches και RAM.
    Στο αρχικό Dataset, τα attributes Inches, Weight και RAM ήταν τύπου Categorical, παρά το γεγονός ότι ήταν νούμερα.
    Έγινε η μετατροπή τους σε Numeric για την καλύτερη ερμηνεία του συνόλου.

  2. Μετατροπή των τιμών.
    Οι τιμές των φορητών υπολογιστών ήταν εκφρασμένες σε Ρουπία Ινδίας.
    Αυτές μετατράπηκαν σε ευρώ και έγινε στρογγυλοποίηση των 2 δεκαδικών στοιχείων για καλύτερη κατανόηση του συνόλου.

  3. Έλεγχος και χειρισμός ελλιπών τιμών.
    Τα αντικείμενα του συνόλου δεδομένων ήταν 1303.
    Μετά τον έλεγχο για διπλότυπα και την αφαίρεση των ελλιπών τιμών,
    έμειναν 1273 αντικείμενα.

    Εικόνα 1: OpenRefine Preproccesing Steps
    Εικόνα 1: OpenRefine Preproccesing Steps

Χαρακτηριστικά του συνόλου

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

🔹 Γραμμική παλινδρόμηση

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

#Correlation Price - RAM
cor(laptopData$Price, laptopData$Ram)
## [1] 0.6866854
#Price vs RAM
model_r <- lm(laptopData$Price ~ laptopData$Ram, data = laptopData)
summary(model_r)
## 
## Call:
## lm(formula = laptopData$Price ~ laptopData$Ram, data = laptopData)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2814.23  -184.48   -57.16   141.87  1667.70 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     223.004     14.727   15.14   <2e-16 ***
## laptopData$Ram   48.946      1.454   33.66   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 288.6 on 1270 degrees of freedom
## Multiple R-squared:  0.4715, Adjusted R-squared:  0.4711 
## F-statistic:  1133 on 1 and 1270 DF,  p-value: < 2.2e-16
SSE_r = sum(model_r$residuals^2)
RMSE_r <- sqrt(SSE_r/nrow(laptopData))
RMSE_r
## [1] 288.3253

Η πρώτη μεταβλητή που επέλεξα είναι η Ram λόγω της υψηλής συσχέτησης (0.6866) που έχει με την εξαρτημένη μεταβλητή. Το R-squared (0.4711) δείχνει ότι το μοντέλο εξηγεί περίπου το 47% της διακύμανσης των δεδομένων, που υποδεικνύει ότι το μοντέλο έχει κάποιου βαθμού predictive δύναμη, αλλά δεν είναι εξαιρετικό. Από την άλλη, η τιμή RMSE = 288.33 δείχνει τη μέση απόκλιση των προβλέψεων από τις πραγματικές τιμές, πράγμα που σημαίνει ότι η μέση διαφορά μεταξύ των προβλεπόμενων και των πραγματικών τιμών είναι περίπου 288 ευρώ.

#Correlation Price - Inches
cor(laptopData$Price, laptopData$Inches)
## [1] 0.04470401
#Price vs Ram + Inches
model_ri <- lm(laptopData$Price ~ laptopData$Ram + laptopData$Inches, data = laptopData)
summary(model_ri)
## 
## Call:
## lm(formula = laptopData$Price ~ laptopData$Ram + laptopData$Inches, 
##     data = laptopData)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2864.68  -182.82   -58.01   131.39  1678.60 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        384.218     63.127   6.086 1.53e-09 ***
## laptopData$Ram      49.493      1.466  33.772  < 2e-16 ***
## laptopData$Inches  -10.961      4.174  -2.626  0.00875 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 287.9 on 1269 degrees of freedom
## Multiple R-squared:  0.4744, Adjusted R-squared:  0.4736 
## F-statistic: 572.7 on 2 and 1269 DF,  p-value: < 2.2e-16
SSE_ri = sum(model_ri$residuals^2)
RMSE_ri <- sqrt(SSE_ri/nrow(laptopData))
RMSE_ri
## [1] 287.5451

Η προσθήκη της μεταβλητής Inches στο μοντέλο, παρότι η συσχέτισή της με την τιμή είναι χαμηλή (r ≈ 0.045), βελτιώνει ελαφρώς την ακρίβεια του μοντέλου. Συγκεκριμένα, το R-squared αυξάνεται από 0.4711 σε 0.4744, δείχνοντας ότι το μοντέλο εξηγεί πλέον ένα λίγο μεγαλύτερο ποσοστό της διακύμανσης της τιμής. Παράλληλα, η τιμή του RMSE μειώνεται από 288.33 σε 287.55, κάτι που σημαίνει ότι η μέση απόκλιση των προβλέψεων από τις πραγματικές τιμές μειώνεται κατά περίπου 0.8 ευρώ. Αν και η βελτίωση είναι περιορισμένη, είναι μετρήσιμη και στατιστικά σημαντική, γεγονός που δείχνει ότι η μεταβλητή Inches προσθέτει κάποια αξία στο μοντέλο και μπορεί να συμπεριληφθεί.

#Correlation Price - Weight
cor(laptopData$Price, laptopData$Inches)
## [1] 0.04470401
#Price vs Ram + Inches + Weight
model_riw <- lm(laptopData$Price ~ laptopData$Ram + laptopData$Inches + + laptopData$Weight, data = laptopData)
summary(model_riw)
## 
## Call:
## lm(formula = laptopData$Price ~ laptopData$Ram + laptopData$Inches + 
##     +laptopData$Weight, data = laptopData)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2854.92  -182.65   -58.14   132.19  1677.47 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        387.949     64.510   6.014 2.37e-09 ***
## laptopData$Ram      49.349      1.513  32.607  < 2e-16 ***
## laptopData$Inches  -11.758      4.759  -2.470   0.0136 *  
## laptopData$Weight    4.524     11.881   0.381   0.7034    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 288 on 1267 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.4745, Adjusted R-squared:  0.4733 
## F-statistic: 381.4 on 3 and 1267 DF,  p-value: < 2.2e-16
SSE_riw = sum(model_riw$residuals^2)
RMSE_riw <- sqrt(SSE_riw/nrow(laptopData))
RMSE_riw
## [1] 287.4808

Η προσθήκη της μεταβλητής Weight στο μοντέλο, μαζί με τις Ram και Inches, δεν φαίνεται να προσφέρει ουσιαστική βελτίωση στην ακρίβεια του. Συγκεκριμένα, το R-squared αυξάνεται ελάχιστα από 0.4744 σε 0.4745, κάτι που υποδηλώνει ότι εξηγείται σχεδόν το ίδιο ποσοστό της διακύμανσης της τιμής. Αντίστοιχα, η τιμή του RMSE μειώνεται ελάχιστα από 287.55 σε 287.48, δηλαδή μόλις κατά 0.07 ευρώ, μια μεταβολή που είναι αμελητέα. Επιπλέον, η μεταβλητή Weight εμφανίζεται στατιστικά μη σημαντική (p = 0.7034), γεγονός που ενισχύει την άποψη ότι δεν συμβάλλει ουσιαστικά στο μοντέλο. Συνεπώς, η μεταβλητή Weight δεν προσθέτει αξία στο μοντέλο και δεν κρίνεται απαραίτητο να συμπεριληφθεί.

Άρα το μοντέλο στο οποίο καταλήγω έχει μόνο δύο ανεξάρτητες μεταβλητές, την RAM και την Inches.

#Best model chart
ggplot(laptopData, aes(x = Ram, y = Price)) +
  geom_point() + 
  labs(x = "Ram + Inches", y = "Price") +
  geom_abline(aes(intercept = coef(model_ri)[1], 
                  slope = coef(model_ri)[2]), colour = "red")

🔹 Διαχωρισμός του συνόλου σε Train και Test

Για τον διαχωρισμό του συνόλου δεδομένων χρησιμοποίησα την μεταβλητή 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 είναι:

nrow(dataTrain)
## [1] 1017

ενώ στο Test-set:

nrow(dataTest)
## [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

Για την πρόβλεψη των τιμών του 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
table(dataTest$IsExpensive, predictTest > 0.75)
##    
##     FALSE TRUE
##   0   173   13
##   1    27   42

Παραπάνω εμφανίζονται οι πιθανότητες, από τυχαίες εγγραφές του dataset, τα λάπτοπ να είναι ακριβά. Ορίζοντας ως threshold το 0.75, θεωρούμε ότι ένα λάπτοπ προβλέπεται ως “ακριβό” όταν η πιθανότητα να ανήκει στην κατηγορία των ακριβών είναι μεγαλύτερη η ίση με 0.75. Αντίστοιχα, αν η πιθανότητα είναι μικρότερη από 0.75, το λάπτοπ προβλέπεται ως “μή ακριβό”. Τέλος, η ακρίβεια του μοντέλου για το συγκεκριμένο test-set είναι 84.3%, όπως φαίνεται και παραπάνω.

🔹 ROCR Curve και AUC

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()

auc <- performance(ROCRpred, "auc")@y.values[[1]]
print(paste("AUC:", round(auc, 4)))
## [1] "AUC: 0.9287"

Τέλος, η ROC καμπύλη δείχνει ότι το λογιστικό μοντέλο έχει πολύ καλή ικανότητα διάκρισης μεταξύ ακριβών και μη ακριβών laptops, καθώς η καμπύλη **πλησιάζει το επάνω αριστερό άκρ*ο, μακριά από τη διαγώνιο της τυχαίας πρόβλεψης. Η τιμή του AUC είναι 0.9287, γεγονός που υποδηλώνει ότι το μοντέλο έχει πολύ υψηλή προβλεπτική ακρίβεια, με πάνω από 90% πιθανότητα** να κατατάξει σωστά ένα τυχαίο ζεύγος παρατηρήσεων. Συνεπώς, το μοντέλο θεωρείται ιδιαίτερα αποδοτικό στη συγκεκριμένη ταξινόμηση.