1 Σχολιασμός/Παρουσίαση του Dataset

Για την ανάλυση επιλέχθηκε το dataset Microsoft Stock Data το οποίο περιλαμβάνει ιστορικά δεδομένα της μετοχής της Microsoft. Περιέχει πληροφορίες για την καθημερινή τιμή της μετοχής στο χρηματιστήριο.

  • Date: η ημερομηνία της συναλλαγής

  • Open: η τιμή της μετοχής όταν άνοιξε το χρηματιστήριο την συγκεκριμένη ημέρα

  • High: η υψηλότερη τιμή που έφτασε η μετοχή μέσα στη μέρα

  • Low: η χαμηλότερη τιμή της μετοχής μέσα στη μέρα

  • Close: η τιμή της μετοχής όταν έκλεισε το χρηματιστήριο

  • Adj Close: τιμή κλεισίματος προσαρμοσμένη ώστε να αντικατοπτρίζει την αξία μετά τον υπολογισμό τυχόν εταιρικών ενεργειών

  • Volume: ο αριθμός των συναλλαγών που πραγματοποιήθηκαν εκείνη την ημέρα

Kaggle: Microsoft Stock Data

# Εισαγωγή του dataset
MSFT <- read.csv("MSFT.csv")

#Φόρτωση βιβλιοθηκών
library(caTools)   # Για διαχωρισμό train/test
## Warning: package 'caTools' was built under R version 4.5.3
library(ROCR)      # Για ROC καμπύλη και AUC
## Warning: package 'ROCR' was built under R version 4.5.3
library(ggplot2)   # Για οπτικοποίηση

# Μετατροπή της στήλης Date σε ημερομηνία
MSFT$Date <- as.Date(MSFT$Date)

1.1 Δημιουργία Νέας Μεταβλητής

1.1.1 Εξαρτημένη Μεταβλητή (Target)

Για τους σκοπούς της Λογιστικής Παλινδρόμησης, δημιουργούμε μια δυαδική μεταβλητή:

  • diff = 1, αν η τιμή κλεισίματος (Close) είναι υψηλότερη από την τιμή ανοίγματος (Open)
    diff = 0 αν η τιμή κλεισίματος είναι ίση ή χαμηλότερη

    MSFT$diff <- ifelse(MSFT$Close > MSFT$Open, 1, 0)

1.2 Εξέταση Δεδομένων

# εμφάνιση των δεδομένων σε μορφή πίνακα, ώστε να είναι εύκολη η οπτική εξέτασή τους
View(MSFT)
# παρουσίαση των βασικών στατιστικών στοιχείων για κάθε μεταβλητή
summary(MSFT)
##       Date                 Open                High          
##  Min.   :1986-03-13   Min.   :  0.08854   Min.   :  0.09201  
##  1st Qu.:1995-03-06   1st Qu.:  4.05078   1st Qu.:  4.10205  
##  Median :2004-03-11   Median : 26.82000   Median : 27.10000  
##  Mean   :2004-03-12   Mean   : 41.32494   Mean   : 41.76089  
##  3rd Qu.:2013-03-19   3rd Qu.: 40.03500   3rd Qu.: 40.44375  
##  Max.   :2022-03-24   Max.   :344.62000   Max.   :349.67001  
##       Low                Close             Adj.Close        
##  Min.   :  0.08854   Min.   :  0.09028   Min.   :  0.05705  
##  1st Qu.:  4.02734   1st Qu.:  4.07520   1st Qu.:  2.57509  
##  Median : 26.52000   Median : 26.84000   Median : 18.94853  
##  Mean   : 40.87849   Mean   : 41.33563   Mean   : 36.25612  
##  3rd Qu.: 39.50000   3rd Qu.: 39.93750   3rd Qu.: 29.24481  
##  Max.   :342.20001   Max.   :343.10998   Max.   :342.40201  
##      Volume               diff       
##  Min.   :2.304e+06   Min.   :0.0000  
##  1st Qu.:3.461e+07   1st Qu.:0.0000  
##  Median :5.203e+07   Median :0.0000  
##  Mean   :5.875e+07   Mean   :0.4943  
##  3rd Qu.:7.265e+07   3rd Qu.:1.0000  
##  Max.   :1.032e+09   Max.   :1.0000
# εμφάνιση της δομής του dataset και τους τύπους δεδομένων των μεταβλητών.
str(MSFT)
## 'data.frame':    9083 obs. of  8 variables:
##  $ Date     : Date, format: "1986-03-13" "1986-03-14" ...
##  $ Open     : num  0.0885 0.0972 0.1007 0.1024 0.0998 ...
##  $ High     : num  0.102 0.102 0.103 0.103 0.101 ...
##  $ Low      : num  0.0885 0.0972 0.1007 0.099 0.0972 ...
##  $ Close    : num  0.0972 0.1007 0.1024 0.0998 0.0981 ...
##  $ Adj.Close: num  0.0614 0.0636 0.0647 0.0631 0.062 ...
##  $ Volume   : int  1031788800 308160000 133171200 67766400 47894400 58435200 59990400 65289600 32083200 22752000 ...
##  $ diff     : num  1 1 1 0 0 0 0 0 1 1 ...

1.3 Οπτικοποίηση Δεδομένων

# Φόρτωση βιβλιοθήκης
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ lubridate 1.9.5     ✔ tibble    3.3.1
## ✔ purrr     1.2.1     ✔ tidyr     1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

1.3.1 Scatterplot

1.3.1.1 Σχέση Τιμής Ανοίγματος και Τιμής Κλεισίματος

ggplot(data = MSFT, aes(x = Open, y = Close)) +
  geom_point(size = 3, alpha = 0.7, color = "blue") +
  labs(
    title = "Τιμή Ανοίγματος vs Τιμή Κλεισίματος Μετοχής Microsoft",
    x = "Τιμή Ανοίγματος",
    y = "Τιμή Κλεισίματος"
  ) +
  theme_classic()

  • Σχολιασμός:

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

1.3.2 Boxplot

1.3.2.1 Κατανομή Τιμών Κλεισίματος ανά Έτος

#Δημιουργώ το έτος από την ημερομηνία
MSFT$Year <- format(as.Date(MSFT$Date), "%Y")
ggplot(data = MSFT, aes(x = factor(Year), y = Close, fill = factor(Year))) +
  geom_boxplot(alpha = 0.7) +
  labs(
    title = "Κατανομή Τιμής Κλεισίματος ανά Έτος",
    x = "Έτος",
    y = "Τιμή Κλεισίματος",
    fill = "Έτος"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

  # Τροποποίηση της εμφάνισης των ετικετών στον άξονα x 
  # Με γωνία 45 μοιρών για να διβάζονται καλύτερα

  • Σχολιασμός:

    • Το διάγραμμα δείχνει την κατανομή της τιμής κλεισίματος της μετοχής ανά έτος. Κάθε κουτί στο διάγραμμα δείχνει πώς κατανέμονται οι τιμές της μετοχής μέσα στη συγκεκριμένη χρονιά. Έτσι, μπορούμε να δούμε πώς μεταβάλλεται η τιμή της μετοχής της Microsoft μέσα στα χρόνια και αν υπάρχουν μεγάλες διακυμάνσεις.

1.3.3 Histogram

1.3.3.1 Κατανομή Τιμής Κλεισίματος

ggplot(data = MSFT, aes(x = Close)) +
    geom_histogram(binwidth = 10, fill = "purple", color = "#4302d9") +
    labs(
        title = "Κατανομή Τιμής Κλεισίματος της Μετοχής Microsoft",
        x = "Τιμή Κλεισίματος",
        y = "Συχνότητα"
    ) +
    theme_minimal()

  • Σχολιασμός:

    • Το ιστόγραμμα παρουσιάζει τη συχνότητα εμφάνισης των τιμών κλεισίματος της μετοχής της Microsoft. Μέσα από το διάγραμμα μπορούμε να εντοπίσουμε σε ποια επίπεδα τιμών εμφανίζονται πιο συχνά οι τιμές της μετοχής και να παρατηρήσουμε τη συνολική μορφή της κατανομής.

1.3.4 Bar Chart

1.3.4.1 Μέση Τιμή Κλεισίματος ανά Έτος

ggplot(data = MSFT, aes(x = factor(Year), y = Close, fill = factor(Year))) +
  stat_summary(fun = mean, geom = "bar") +
  labs(
    title = "Μέση Τιμή Κλεισίματος της Μετοχής Microsoft ανά Έτος",
    x = "Έτος",
    y = "Μέση Τιμή Κλεισίματος"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "none"
  # Τροποποίηση της εμφάνισης των ετικετών στον άξονα x 
  # Με γωνία 45 μοιρών για να διβάζονται καλύτερα
  )

  • Σχολιασμός:

    • Το bar chart παρουσιάζει τη μέση τιμή κλεισίματος της μετοχής της Microsoft για κάθε έτος. Κάθε μπάρα αντιστοιχεί σε ένα έτος και το ύψος της δείχνει τη μέση τιμή κλεισίματος των ημερών του αντίστοιχου έτους. Το διάγραμμα βοηθά στην κατανόηση της γενικής τάσης της μετοχής μέσα στον χρόνο.

2 Διαχωρισμός σε Train & Test Set

# Ορισμός seed
set.seed(993)

#train, 35% test
split <- sample.split(MSFT$diff, SplitRatio = 0.65)

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

cat("Μέγεθος Set\n")
## Μέγεθος Set
cat("Train Set: ", nrow(train), "εγγραφές\n")
## Train Set:  5903 εγγραφές
cat("Test Set: ", nrow(test),  "εγγραφές\n")
## Test Set:  3180 εγγραφές
cat("Σύνολο: ", nrow(MSFT), "εγγραφές\n")
## Σύνολο:  9083 εγγραφές

3 Δημιουργία Μοντέλου Λογιστικής Παλινδρόμησης

model <- glm(diff ~ Open + High + Low + Close + Volume,
             data = train,
             family = binomial)
## Warning: glm.fit: algorithm did not converge
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(model)
## 
## Call:
## glm(formula = diff ~ Open + High + Low + Close + Volume, family = binomial, 
##     data = train)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.154e+00  1.377e+01  -0.592    0.554
## Open        -3.637e+04  4.417e+04  -0.824    0.410
## High        -6.214e+02  8.645e+02  -0.719    0.472
## Low          3.264e+02  1.569e+03   0.208    0.835
## Close        3.667e+04  4.450e+04   0.824    0.410
## Volume      -5.232e-08  3.303e-07  -0.158    0.874
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8.1825e+03  on 5902  degrees of freedom
## Residual deviance: 7.3447e-03  on 5897  degrees of freedom
## AIC: 12.007
## 
## Number of Fisher Scoring iterations: 25

3.1 Στατιστικά Σημαντικές Μεταβλητές

coef(model)
##   (Intercept)          Open          High           Low         Close 
## -8.153804e+00 -3.637324e+04 -6.214391e+02  3.264152e+02  3.667010e+04 
##        Volume 
## -5.232202e-08
exp(coef(model))
##   (Intercept)          Open          High           Low         Close 
##  2.876391e-04  0.000000e+00 1.295472e-270 5.758788e+141           Inf 
##        Volume 
##  9.999999e-01

Οι μεταβλητές Open, High, Low και Close παρουσιάζουν ισχυρή συσχέτιση με την εξαρτημένη μεταβλητή diff, καθώς άμεσα καθορίζουν αν η τιμή κλεισίματος υπερέβη την τιμή ανοίγματος. Η μεταβλητή Volume μάλλον δεν παρουσιάζει στατιστική σημαντικότητα στο ίδιο επίπεδο.

4 Προβλέψεις στο Test Set

Χρησιμοποιώ την συνάρτηση predict() με type = "response" επιστρέφει εκτιμώμενες πιθανότητες σε τιμές μεταξύ 0 και 1.

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

summary(predictTest)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## 0.000e+00 0.000e+00 4.440e-06 4.937e-01 1.000e+00 1.000e+00

5 Confusion Matrix

# Confusion matrix με κατώφλι 0.5
threshold <- 0.5
predicted_class <- ifelse(predictTest >= threshold, 1, 0)

cm <- table(Actual = test$diff, Predicted = predicted_class)
print(cm)
##       Predicted
## Actual    0    1
##      0 1608    0
##      1    2 1570

5.1 Υπολογισμός Μετρικών

# Εξαγωγή τιμών από confusion matrix
TN <- cm[1,1]  # True Negatives
FP <- cm[1,2]  # False Positives
FN <- cm[2,1]  # False Negatives
TP <- cm[2,2]  # True Positives

# Υπολογισμός μετρικών
accuracy    <- (TP + TN) / sum(cm)
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)

cat("Μετρικές Αξιολόγησης Μοντέλου\n")
## Μετρικές Αξιολόγησης Μοντέλου
cat(sprintf("Ακρίβεια (Accuracy)   : %.4f  (%.2f%%)\n", accuracy, accuracy*100))
## Ακρίβεια (Accuracy)   : 0.9994  (99.94%)
cat(sprintf("Sensitivity (Recall)  : %.4f  (%.2f%%)\n", sensitivity, sensitivity*100))
## Sensitivity (Recall)  : 0.9987  (99.87%)
cat(sprintf("Specificity           : %.4f  (%.2f%%)\n", specificity, specificity*100))
## Specificity           : 1.0000  (100.00%)
# Baseline Model
baseline_accuracy <- max(table(test$diff)) / nrow(test)
cat(sprintf("\nΑκρίβεια Baseline Model\n"))
## 
## Ακρίβεια Baseline Model
cat(sprintf("Baseline Accuracy     : %.4f  (%.2f%%)\n", baseline_accuracy, baseline_accuracy*100))
## Baseline Accuracy     : 0.5057  (50.57%)
cat("\nΣύγκριση\n")
## 
## Σύγκριση
cat(sprintf("Βελτίωση Baseline: +%.2f%%\n", (accuracy - baseline_accuracy)*100))
## Βελτίωση Baseline: +49.37%
  • Εδώ παρατηρώ ότι το μοντέλο υπερτερεί του baseline, γεγονός που δείχνει τη προβλεπτική ισχύ που έχει.

6 Δημιουργία ROCRpred

# Δημιουργία ROCRpred
ROCRpred <- prediction(predictTest, test$diff)

6.1 Δημιουργία νέων Set (train2, test2)

# διαχωρισμός με na.omit
set.seed(993)
split2 <- sample.split(MSFT$diff, SplitRatio = 0.65)
train2  <- subset(MSFT, split2 == TRUE)
test2   <- subset(MSFT, split2 == FALSE)

cat("Μέγεθος Νέων Set (με na.omit)\n")
## Μέγεθος Νέων Set (με na.omit)
cat("train2:", nrow(train2), "εγγραφές\n")
## train2: 5903 εγγραφές
cat("test2: ", nrow(test2),  "εγγραφές\n")
## test2:  3180 εγγραφές

7 ROC Καμπύλη & AUC

# Νέο μοντέλο στο train2
model2 <- glm(diff ~ Open + High + Low + Close + Volume,
              data = train2,
              family = binomial)
## Warning: glm.fit: algorithm did not converge
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
# Πρόβλεψη στο test2
predictTest2 <- predict(model2, newdata = test2, type = "response")

# Δημιουργία ROCRpred για το νέο μοντέλο
ROCRpred2  <- prediction(predictTest2, test2$diff)
ROCRperf2  <- performance(ROCRpred2, "tpr", "fpr")

# Υπολογισμός AUC
aucValue <- performance(ROCRpred2, measure = "auc")
auc <- aucValue@y.values[[1]]

cat(sprintf("=== AUC (Area Under the Curve) ===\n"))
## === AUC (Area Under the Curve) ===
cat(sprintf("AUC = %.4f\n\n", auc))
## AUC = 0.9993
# Σχεδίαση ROC καμπύλης με color-coding
plot(ROCRperf2,
     colorize = TRUE,
     print.cutoffs.at = seq(0, 1, by = 0.1),
     text.adj = c(-0.2, 1.7),
     main = "ROC",
     xlab = "False Positive Rate (1 - Specificity)",
     ylab = "True Positive Rate (Sensitivity)",
     lwd = 2)

# Προσθήκη διαγώνιας γραμμής αναφοράς (random classifier)
abline(a = 0, b = 1, lty = 2, col = "gray50", lwd = 1.5)

# Προσθήκη AUC στο γράφημα
legend("bottomright",
       legend = paste("AUC =", round(auc, 4)),
       bty = "n",
       cex = 1.2,
       text.col = "darkblue")