CroosValidation Logistic Regression and Machine Learning Models for Predicting Stock Market Movements in the Pakistan Stock Exchange (PSX)

Author

Prof. Dr. Zahid Asghar

Tidied Code with Confusion Matrix and Improvements

Libraries and Setup

library(caret)      # For model evaluation and cross-validation

Loading required package: ggplot2

Loading required package: lattice

Warning: package 'lattice' was built under R version 4.5.1

library(rpart)      # For Decision Trees
library(tidyverse)  # For data manipulation and visualization

Warning: package 'tidyverse' was built under R version 4.5.1

Warning: package 'purrr' was built under R version 4.5.1

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ lubridate 1.9.4     ✔ tibble    3.3.0
✔ purrr     1.1.0     ✔ tidyr     1.3.1

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
✖ purrr::lift()   masks caret::lift()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(Metrics)    # For additional evaluation metrics

Warning: package 'Metrics' was built under R version 4.5.1


Attaching package: 'Metrics'

The following objects are masked from 'package:caret':

    precision, recall

library(janitor)    # For cleaning column names


Attaching package: 'janitor'

The following objects are masked from 'package:stats':

    chisq.test, fisher.test

library(MASS)


Attaching package: 'MASS'

The following object is masked from 'package:dplyr':

    select

library(class)      # For KNN
library(boot)

Warning: package 'boot' was built under R version 4.5.1


Attaching package: 'boot'

The following object is masked from 'package:lattice':

    melanoma

Load and Inspect Data

psx <- read_csv("data/psx.csv")

Rows: 1827 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (3): Date, Vol., Change %
dbl (4): Price, Open, High, Low

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Inspect the structure of the dataset
dim(psx)

[1] 1827    7

glimpse(psx)

Rows: 1,827
Columns: 7
$ Date       <chr> "11/15/2024", "11/14/2024", "11/13/2024", "11/12/2024", "11…
$ Price      <dbl> 17.42, 17.19, 16.78, 16.86, 17.02, 17.22, 17.14, 17.31, 16.…
$ Open       <dbl> 17.40, 16.70, 16.95, 17.00, 17.46, 17.14, 17.24, 17.24, 17.…
$ High       <dbl> 17.60, 17.60, 16.95, 17.20, 17.46, 17.49, 17.60, 17.50, 17.…
$ Low        <dbl> 16.90, 16.55, 16.50, 16.70, 16.97, 17.01, 17.00, 16.60, 16.…
$ Vol.       <chr> "896.83K", "1.01M", "239.44K", "179.95K", "364.92K", "208.0…
$ `Change %` <chr> "1.34%", "2.44%", "-0.47%", "-0.94%", "-1.16%", "0.47%", "-…

Data Cleaning and Feature Engineering

# Convert the `Date` column to proper Date format and clean column names
psx <- psx %>%
  mutate(date = as.Date(Date, format = "%m/%d/%Y")) %>%
  dplyr::select(-Date) %>%
  clean_names()

# Create `change_percent` as numeric and a binary `direction` column
psx <- psx %>%
  mutate(
    change_percent = as.numeric(str_remove(change_percent, "%")),
    direction = if_else(change_percent > 0, "Up", "Down")
  )

# Arrange by ascending date
psx <- psx %>% arrange(date)

# Generate lag variables and convert `vol` to numeric (account for M/K suffixes)
psx <- psx %>%
  mutate(
    lag1 = lag(change_percent, 1),
    lag2 = lag(change_percent, 2),
    lag3 = lag(change_percent, 3),
    lag4 = lag(change_percent, 4),
    lag5 = lag(change_percent, 5),
    vol = as.numeric(str_replace_all(vol, c("M" = "e6", "K" = "e3")))
  )

# Drop rows with missing values
psx_clean <- psx %>% drop_na()

# Convert `direction` to a factor for classification
psx_clean <- psx_clean %>%
  mutate(direction = factor(if_else(direction == "Up", 1, 0), levels = c(0, 1), labels = c("Down", "Up")))

Cross-Validation with Logistic Regression

# Define custom summary function to include confusion matrix and accuracy
logistic_summary <- function(data, lev = NULL, model = NULL) {
  confusion <- confusionMatrix(data$pred, data$obs)
  out <- c(Accuracy = confusion$overall["Accuracy"])
  return(out)
}

# Define trainControl for different cross-validation methods
train_control_loocv <- trainControl(method = "LOOCV", summaryFunction = logistic_summary, classProbs = TRUE)
train_control_5fold <- trainControl(method = "cv", number = 5, summaryFunction = logistic_summary, classProbs = TRUE)
train_control_10fold <- trainControl(method = "cv", number = 10, summaryFunction = logistic_summary, classProbs = TRUE)

# Train logistic regression models
set.seed(123)
model_loocv <- train(
  direction ~ lag1 + lag2 + lag3 + lag4 + lag5 + vol,
  data = psx_clean,
  method = "glm",
  family = binomial,
  trControl = train_control_loocv,
  metric = "Accuracy"
)

Warning in train.default(x, y, weights = w, ...): The metric "Accuracy" was not
in the result set. Accuracy.Accuracy will be used instead.

model_5fold <- train(
  direction ~ lag1 + lag2 + lag3 + lag4 + lag5 + vol,
  data = psx_clean,
  method = "glm",
  family = binomial,
  trControl = train_control_5fold,
  metric = "Accuracy"
)

Warning in train.default(x, y, weights = w, ...): The metric "Accuracy" was not
in the result set. Accuracy.Accuracy will be used instead.

model_10fold <- train(
  direction ~ lag1 + lag2 + lag3 + lag4 + lag5 + vol,
  data = psx_clean,
  method = "glm",
  family = binomial,
  trControl = train_control_10fold,
  metric = "Accuracy"
)

Warning in train.default(x, y, weights = w, ...): The metric "Accuracy" was not
in the result set. Accuracy.Accuracy will be used instead.

Extract Training Results

# Combine cross-validation results into a summary data frame
results_train <- data.frame(
  Method = c("LOOCV", "5-Fold CV", "10-Fold CV"),
  Training_Accuracy = c(
    model_loocv$results$Accuracy[1],
    model_5fold$results$Accuracy[1],
    model_10fold$results$Accuracy[1]
  )
)

print(results_train)

      Method Training_Accuracy
1      LOOCV         0.6108672
2  5-Fold CV         0.6108672
3 10-Fold CV         0.6108672

Train-Test Split and Testing Accuracy

# Train-test split based on date
train_data <- psx_clean %>% filter(date < as.Date("2024-01-01"))
test_data <- psx_clean %>% filter(date >= as.Date("2024-01-01"))

# Predictions and accuracy on the test set
loocv_preds <- predict(model_loocv, newdata = test_data)
loocv_test_accuracy <- mean(loocv_preds == test_data$direction)

fold5_preds <- predict(model_5fold, newdata = test_data)
fold5_test_accuracy <- mean(fold5_preds == test_data$direction)

fold10_preds <- predict(model_10fold, newdata = test_data)
fold10_test_accuracy <- mean(fold10_preds == test_data$direction)

# Summarize training and testing accuracies
results <- data.frame(
  Method = c("LOOCV", "5-Fold CV", "10-Fold CV"),
  Training_Accuracy = results_train$Training_Accuracy,
  Test_Accuracy = c(loocv_test_accuracy, fold5_test_accuracy, fold10_test_accuracy)
)

print(results)

      Method Training_Accuracy Test_Accuracy
1      LOOCV         0.6108672     0.6232558
2  5-Fold CV         0.6108672     0.6232558
3 10-Fold CV         0.6108672     0.6232558

Confusion Matrix for Test Set Predictions

# Confusion matrices for the test set
confusionMatrix(data = loocv_preds, reference = test_data$direction, positive = "Up")

Confusion Matrix and Statistics

          Reference
Prediction Down Up
      Down   77 43
      Up     38 57
                                          
               Accuracy : 0.6233          
                 95% CI : (0.5548, 0.6882)
    No Information Rate : 0.5349          
    P-Value [Acc > NIR] : 0.005484        
                                          
                  Kappa : 0.2403          
                                          
 Mcnemar's Test P-Value : 0.656721        
                                          
            Sensitivity : 0.5700          
            Specificity : 0.6696          
         Pos Pred Value : 0.6000          
         Neg Pred Value : 0.6417          
             Prevalence : 0.4651          
         Detection Rate : 0.2651          
   Detection Prevalence : 0.4419          
      Balanced Accuracy : 0.6198          
                                          
       'Positive' Class : Up

confusionMatrix(data = fold5_preds, reference = test_data$direction, positive = "Up")

Confusion Matrix and Statistics

          Reference
Prediction Down Up
      Down   77 43
      Up     38 57
                                          
               Accuracy : 0.6233          
                 95% CI : (0.5548, 0.6882)
    No Information Rate : 0.5349          
    P-Value [Acc > NIR] : 0.005484        
                                          
                  Kappa : 0.2403          
                                          
 Mcnemar's Test P-Value : 0.656721        
                                          
            Sensitivity : 0.5700          
            Specificity : 0.6696          
         Pos Pred Value : 0.6000          
         Neg Pred Value : 0.6417          
             Prevalence : 0.4651          
         Detection Rate : 0.2651          
   Detection Prevalence : 0.4419          
      Balanced Accuracy : 0.6198          
                                          
       'Positive' Class : Up

confusionMatrix(data = fold10_preds, reference = test_data$direction, positive = "Up")

Confusion Matrix and Statistics

          Reference
Prediction Down Up
      Down   77 43
      Up     38 57
                                          
               Accuracy : 0.6233          
                 95% CI : (0.5548, 0.6882)
    No Information Rate : 0.5349          
    P-Value [Acc > NIR] : 0.005484        
                                          
                  Kappa : 0.2403          
                                          
 Mcnemar's Test P-Value : 0.656721        
                                          
            Sensitivity : 0.5700          
            Specificity : 0.6696          
         Pos Pred Value : 0.6000          
         Neg Pred Value : 0.6417          
             Prevalence : 0.4651          
         Detection Rate : 0.2651          
   Detection Prevalence : 0.4419          
      Balanced Accuracy : 0.6198          
                                          
       'Positive' Class : Up

Key Adjustments

Added Confusion Matrices: Included confusion matrices for test set predictions to provide more insights into model performance.
Tidied Formatting: Improved indentation, consistency, and readability of the code.
Combined Results: Created a single data frame summarizing both training and testing accuracies for all cross-validation methods.
Test Accuracy Evaluation: Added predictions on the test set to complement training accuracy metrics.