US Cars

1.Περιγραφή του Dataset

Το US Cars Dataset προέρχεται από το Kaggle και αφορά μεταχειρισμένα αυτοκίνητα που πωλούνται στις Ηνωμένες Πολιτείες. Περιέχει 2499 εγγραφές και για κάθε μία 12 μεταβλητές που περιέχουν πληροφορίες όπως η μάρκα, το μοντέλο, το έτος κατασκευής, η κατάσταση του τίτλου, η απόσταση που έχει διανύσει το αυτοκίνητο, η πολιτεία πώλησης και άλλες λεπτομέρειες.

2.Αιτιολόγηση της Επιλογής και Επιχειρηματικά Ερωτήματα

Το dataset αυτό μπορεί να χρησιμοποιηθεί σε διάφορες περιπτώσεις σε σχέση με την επιχειρηματική αναλυτική. Για παράδειγμα, στην πρόβλεψη των τιμών βάσει χαρακτηριστικών όπως μάρκα, μοντέλο, χιλιομετρική κάλυψη, στην αναγνώριση τάσεων σε διαφορετικές πολιτείες των ΗΠΑ, στην κατανόηση της επίδρασης της κατάστασης του τίτλου στην τιμή και στην βελτιστοποίηση αποθεμάτων και στρατηγικών πώλησης για εταιρείες που εμπορεύονται αυτοκίνητα. Πιο συγκεκριμένα, τα πιθανά επιχειρηματικά ερωτήματα που θα μπορούσαν να απαντηθούν είναι τα εξής:

1. Ποιοι παράγοντες επηρεάζουν περισσότερο την τιμή ενός μεταχειρισμένου αυτοκινήτου;
2. Υπάρχουν πολιτείες όπου οι τιμές είναι σημαντικά υψηλότερες ή χαμηλότερες;
3. Πώς επηρεάζει η μάρκα και το μοντέλο την πιθανότητα πώλησης ενός αυτοκινήτου;
4. Ποια είναι η επίδραση της κατάστασης του τίτλου στην αξία μεταπώλησης;
5. Υπάρχουν συγκεκριμένες χρονικές περιόδοι που επηρεάζουν τις τιμές (π.χ., αλλαγές σεζόν);

3.Περιγραφή των Μεταβλητών

index: Αναγνωριστικό γραμμής. (integer)
price: Τιμή του αυτοκινήτου σε δολάρια “$”. (integer)
brand: Μάρκα του αυτοκινήτου (π.χ. Toyota, Ford). (string)
model: Μοντέλο του αυτοκινήτου. (string)
year: Έτος κατασκευής. (integer)
title_status: Κατάσταση του τίτλου (π.χ. “clean vehicle”). (string)
mileage: Χιλιόμετρα που έχει διανύσει το αυτοκίνητο (σε μίλια). (float)
color: Χρώμα αυτοκινήτου. (string)
vin: Αριθμός πλαισίου (μοναδικό χαρακτηριστικό). (string)
lot: Αριθμός παρτίδας. (integer)
state: Πολιτεία των ΗΠΑ όπου βρίσκεται το όχημα. (string)
country: Πάντα “USA”. (string)
condition: Χρονικό διάστημα που απομένει για τη δημοπρασία. (string)

4.Περιγραφά Στατιστικά

4.1 Ανάγνωση Dataset

library(readxl) 
dataset <- read_excel("C:\\Users\\maria\\Downloads\\US_Cars.xlsx")

## New names:
## • `` -> `...1`

head(dataset)

## # A tibble: 6 × 13
##    ...1 price brand    model  year title_status mileage color vin      lot state
##   <dbl> <dbl> <chr>    <chr> <dbl> <chr>          <dbl> <chr> <chr>  <dbl> <chr>
## 1     0  6300 toyota   crui…  2008 clean vehic…  274117 black jtez… 1.59e8 new …
## 2     1  2899 ford     se     2011 clean vehic…  190552 silv… 2fmd… 1.67e8 tenn…
## 3     2  5350 dodge    mpv    2018 clean vehic…   39590 silv… 3c4p… 1.68e8 geor…
## 4     3 25000 ford     door   2014 clean vehic…   64146 blue  1ftf… 1.68e8 virg…
## 5     4 27700 chevrol… 1500…  2018 clean vehic…    6654 red   3gcp… 1.68e8 flor…
## 6     5  5700 dodge    mpv    2018 clean vehic…   45561 white 2c4r… 1.68e8 texas
## # ℹ 2 more variables: country <chr>, condition <chr>

# Εφόσον στο dataset δεν υπάρχει κάποια διωνυμική μεταβλητή θα επεξεργαστώ την price
dataset$high_price <- ifelse(dataset$price > median(dataset$price, na.rm = TRUE), 1, 0)

4.2 Περιγραφικά Στατιστικά
  
**Price:**

``` r
summary(dataset$price)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0   10200   16900   18768   25556   84900

mode_price <- as.numeric(names(sort(table(dataset$price), decreasing = TRUE)[1]))
std_dev_price <- sd(dataset$price, na.rm = TRUE)   
var_price <- var(dataset$price, na.rm = TRUE)  
range_price <- range(dataset$price, na.rm = TRUE)   

Επικρατούσα τιμή: 0
Τυπική Απόκλιση: 1.2116095^{4}
Διακύμανση: 1.4679976^{8}

Year:

summary(dataset$year)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1973    2016    2018    2017    2019    2020

mode_year <- as.numeric(names(sort(table(dataset$year), decreasing = TRUE)[1]))
std_dev_year <- sd(dataset$year, na.rm = TRUE)  
var_year <- var(dataset$year, na.rm = TRUE) 
range_year <- range(dataset$year, na.rm = TRUE)  

Επικρατούσα τιμή: 2019
Τυπική Απόκλιση: 3.4426562
Διακύμανση: 11.8518815

Mileage:

summary(dataset$mileage)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0   21467   35365   52299   63473 1017936

mode_mileage <- as.numeric(names(sort(table(dataset$mileage), decreasing = TRUE)[1]))
std_dev_mileage <- sd(dataset$mileage, na.rm = TRUE)  
var_mileage <- var(dataset$mileage, na.rm = TRUE)  
range_mileage <- range(dataset$mileage, na.rm = TRUE)  

Επικρατούσα τιμή: 1
Τυπική Απόκλιση: 5.9705516^{4}
Διακύμανση: 3.5647487^{9}

5.Διερεύνηση Συσχετίσεων

library(ggplot2)
ggplot(dataset, aes(x = mileage, y = price)) +
  geom_point(alpha = 0.5, color = "blue") + 
  theme_minimal() +
  labs(
    title = "Σχέση μεταξύ Mileage και Price",
    x = "Mileage (miles)",
    y = "Price (USD)"
  ) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    axis.title = element_text(size = 14),
    panel.grid.major = element_line(color = "gray80")
  )

Παρατηρούμε ότι υπάρχει αρνητική συσχέτηση ανάμεσα στο price και στο mileage, καθώς όσο λιγότερα είναι τα μίλια, τόσο μεγαλύτερη είναι η τιμή.

ggplot(dataset, aes(x = year, y = price)) +
  geom_point(alpha = 0.5, color = "orange") + 
  theme_minimal() +
  labs(
    title = "Σχέση μεταξύ Year και Price",
    x = "Year",
    y = "Price (USD)"
  ) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    axis.title = element_text(size = 14),
    panel.grid.major = element_line(color = "gray80")
  )

Παρατηρούμε ότι υπάρχει θετική συσχέτηση ανάμεσα στο price και στο year, καθώς όσο νεότερης κατασκευής είναι το αυτοκίνητο, τόσο μεγαλύτερη είναι η τιμή.

6.Διαγράμματα

Scatterplot

ggplot(dataset, aes(x = year, y = mileage)) +
  geom_point(alpha = 0.5, color = "maroon") + 
  theme_minimal() +
  labs(
    title = "Σχέση μεταξύ Year και Mileage",
    x = "Year",
    y = "Mileage (miles)"
  ) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    axis.title = element_text(size = 14),
    panel.grid.major = element_line(color = "gray80")
  )

Παρατηρούμε ότι υπάρχει ελαφρυά αρνητική συσχέτηση ανάμεσα στο year και στο mileage, καθώς όσο νεότερης κατασκευής είναι το αυτοκίνητο, τόσο λιγότερα είναι τα μίλια που έχει διανύσει.

Boxplot

ggplot(dataset, aes(x = factor(year), y = mileage)) +
  geom_boxplot(fill = "lightblue", color = "black") +
  labs(title = "Boxplot of Mileage by Year",
       x = "Year",
       y = "Mileage") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

Παρατηρούμε ότι τα νεότερα αυτοκίνητα (2015-2020) έχουν γενικά χαμηλότερα χιλιόμετρα, καθώς είναι πιο πρόσφατα. Τα παλαιότερα αυτοκίνητα εμφανίζουν μεγαλύτερη διασπορά στα χιλιόμετρα, με κάποια να έχουν υπερβολικά υψηλές τιμές (outliers). Επιπλέον, υπάρχουν αρκετά ακραία σημεία, ιδιαίτερα για τα έτη 2003-2013, που υποδεικνύουν ότι κάποια οχήματα έχουν διανύσει πολύ περισσότερα χιλιόμετρα από το μέσο όρο και μπορεί να είναι είτε ταξί, επαγγελματικά οχήματα, είτε λαναθασμένες καταχωρήσεις δεδομένων.

Histogram

ggplot(dataset, aes(x = mileage)) +
  geom_histogram(fill = "purple", color = "black", bins = 30, alpha = 0.7) +
  labs(title = "Histogram of Mileage",
       x = "Mileage",
       y = "Count") +
  theme_minimal()

Παρατηρούμε ότι η πλειονότητα των αυτοκινήτων έχει χαμηλά χιλιόμετρα (0-100.000). Καθώς τα χιλιόμετρα αυξάνονται, η συχνότητα μειώνεται σταδιακά. Ακόμα, υπάρχουν λίγα οχήματα με πολύ υψηλά χιλιόμετρα (outliers), όπως 500.000 και 1.000.000.

Bar Chart

ggplot(dataset, aes(x = factor(year))) +
  geom_bar(fill = "darkgreen", color = "black") +
  labs(title = "Bar Chart of Car Count per Year",
       x = "Year",
       y = "Count") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

Παρατηρούμε ότι από το 2010 και μετά, υπάρχει μια έντονη αύξηση στον αριθμό των αυτοκινήτων, με μια εκρηκτική αύξηση το 2019. Αυτό μπορεί να οφείλεται στις τεχνολογικές εξελίξεις και στην αύξηση της παραγωγής και χρήσης των αυτοκινήτων,. Πριν το 2000, ο αριθμός των αυτοκινήτων φαίνεται πολύ χαμηλός έως σχεδόν μηδενικός. Το 2020 υπάρχει σημαντική μείωση σε σχέση με το 2019, κάτι που μπορεί να σχετίζεται με την πανδημία COVID-19 ή άλλους παράγοντες.

7.Γραμμική Παλινδρόμηση

# Απλό μοντέλο: τιμή συναρτήσει των χιλιομέτρων
model_simple <- lm(price ~ mileage, data = dataset)

# Πολλαπλό μοντέλο: τιμή συναρτήσει των mileage και year
model_multi <- lm(price ~ mileage + year, data = dataset)

# Σύνοψη απλού μοντέλου
summary(model_simple)

## 
## Call:
## lm(formula = price ~ mileage, data = dataset)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -23022  -7572  -2270   5526  63936 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.302e+04  2.953e+02   77.97   <2e-16 ***
## mileage     -8.134e-02  3.721e-03  -21.86   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11100 on 2497 degrees of freedom
## Multiple R-squared:  0.1607, Adjusted R-squared:  0.1603 
## F-statistic:   478 on 1 and 2497 DF,  p-value: < 2.2e-16

# SSE
sse_simple <- sum(residuals(model_simple)^2)
sse_multi <- sum(residuals(model_multi)^2)

# R-squared των μοντέλων
r2_simple <- summary(model_simple)$r.squared
r2_multi <- summary(model_multi)$r.squared

Απλό μοντέλο:
SSE: 3.0778671^{11}
R²: 0.1606713

Πολλαπλό μοντέλο:
SSE: 2.8942485^{11}
R²: 0.2107437

Σχολιασμός
Στην παρούσα ανάλυση συγκρίναμε δύο γραμμικά μοντέλα που έχουν ως εξαρτημένη μεταβλητή την τιμή των αυτοκινήτων (price). Το απλό μοντέλο περιλαμβάνει μόνο μία ανεξάρτητη μεταβλητή, τα διανυθέντα μίλια (mileage). Το πολλαπλό μοντέλο εμπλουτίζεται με μία επιπλέον μεταβλητή, το έτος κατασκευής του οχήματος (year).

Το R-squared (R²) στο απλό μοντέλο είναι χαμηλό, γεγονός που σημαίνει ότι το mileage από μόνο του εξηγεί μικρό μέρος της διακύμανσης της τιμής. Αυτό είναι λογικό, καθώς η τιμή επηρεάζεται από πολλούς παράγοντες. Στο πολλαπλό μοντέλο, το R² αυξάνεται αισθητά, δηλαδή το μοντέλο εξηγεί πολύ μεγαλύτερο ποσοστό της διακύμανσης. Το year φαίνεται να προσθέτει σημαντική πληροφορία. Το SSE (Sum of Squared Errors) είναι μικρότερο στο πολλαπλό μοντέλο, υποδηλώνοντας καλύτερη προσαρμογή του μοντέλου στα δεδομένα.

Η αρνητική συσχέτιση της μεταβλητής mileage με την τιμή επιβεβαιώνεται και μέσα από το μοντέλο: όσο περισσότερα χιλιόμετρα έχει διανύσει ένα αυτοκίνητο, τόσο χαμηλότερη είναι η αξία του. Η μεταβλητή year έχει θετική συσχέτιση με την τιμή: τα νεότερα αυτοκίνητα τείνουν να πωλούνται σε υψηλότερες τιμές, όπως ήταν αναμενόμενο. Το πολλαπλό μοντέλο προσφέρει πιο ρεαλιστική εικόνα της αγοράς, αφού λαμβάνει υπόψη τόσο τη “φθορά” (μέσω των χιλιομέτρων), όσο και τη “νεότητα” του οχήματος (μέσω του έτους).

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

8.Λογιστική Παλινδρόμηση

library(caTools)
library(ROCR)

# Διαχωρισμός σε training (65%) και testing (35%) sets με seed = 908
set.seed(908)
split <- sample.split(dataset$price, SplitRatio = 0.65) 

train <- subset(dataset, split == TRUE)
test <- subset(dataset, split == FALSE)

Training set size: 1756
Testing set size: 743

model <- glm(high_price ~ year + mileage + brand + model + color + title_status + state + condition,
             data = train, family = binomial)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

smy = summary(model)
smy$coefficients[1:15,]

##                           Estimate   Std. Error       z value     Pr(>|z|)
## (Intercept)          -5.392887e+02 1.773149e+04 -0.0304141841 9.757367e-01
## year                  2.658825e-01 9.881960e-02  2.6905844056 7.132699e-03
## mileage              -3.066380e-05 4.772816e-06 -6.4246762699 1.321504e-10
## brandaudi             9.471725e+00 2.088644e+04  0.0004534868 9.996382e-01
## brandbmw              1.206390e+01 1.773037e+04  0.0006804087 9.994571e-01
## brandbuick            1.206902e+01 1.773037e+04  0.0006806973 9.994569e-01
## brandcadillac         3.138240e+01 1.945705e+04  0.0016129062 9.987131e-01
## brandchevrolet        1.375169e+01 1.773037e+04  0.0007756010 9.993812e-01
## brandchrysler         1.303079e+01 1.773037e+04  0.0007349414 9.994136e-01
## branddodge            1.295793e+01 1.773037e+04  0.0007308322 9.994169e-01
## brandford             1.453132e+01 1.773037e+04  0.0008195724 9.993461e-01
## brandgmc              8.809965e+00 1.773037e+04  0.0004968855 9.996035e-01
## brandharley-davidson  2.602254e+01 2.507453e+04  0.0010378077 9.991719e-01
## brandheartland       -9.502606e+00 2.507453e+04 -0.0003789744 9.996976e-01
## brandhonda            9.919559e+00 1.773037e+04  0.0005594670 9.995536e-01

# Εξαναγκάζουμε όλα τα factor levels του test set να συμφωνούν με αυτά του train
for (col in c("brand", "model", "color", "title_status", "state", "condition")) {
  train[[col]] <- factor(train[[col]])
  test[[col]] <- factor(test[[col]], levels = levels(train[[col]]))
}

predictTest <- predict(model, newdata = test, type = "response")
head(predictTest)

##            1            2            3            4            5            6 
##           NA 1.259396e-09 9.987509e-01 5.774193e-01 8.057736e-11 2.170630e-02

Ερμηνεία:
1. NA Λείπει δεδομένο
2. 1.259396e-09 Πρακτικά 0% -> Σχεδόν σίγουρα low price
3. 9.987509e-01 99.87% -> Σχεδόν σίγουρα high price
4. 5.774193e-01 57.7% -> Πιθανότερο high price, αλλά όχι σίγουρα
5. 8.057736e-11 Πρακτικά 0% -> Σχεδόν σίγουρα low price
6. 2.170630e-02 2.17% -> Πολύ πιθανό να είναι low price
* Πιθανότητα για high_price = 1

# Κατηγοριοποίηση: αν η πιθανότητα > 0.5 → 1, αλλιώς → 0
predictClass <- ifelse(predictTest > 0.5, 1, 0)

# Αφαίρεση των NA (προαιρετικό αλλά προτεινόμενο)
valid_idx <- !is.na(predictTest)
predictClass <- predictClass[valid_idx]
actual <- test$high_price[valid_idx]

# Confusion Matrix
table(Predicted = predictClass, Actual = actual)

##          Actual
## Predicted   0   1
##         0 323  59
##         1  43 298

Accuracy: 0.8589212
Precision: 0.8825137
Recall: 0.8347339
F1-Score: 0.8579591
Tο μοντέλο έχει πολύ καλή ακρίβεια στις προβλέψεις για high-price αυτοκίνητα, αν και χάνει ένα μικρό ποσοστό high-price (λόγω false negatives). Η F1-score είναι πολύ καλή, ισορροπεί precision και recall.

library(cleanrmd)