ADVENTIST UNIVERSITY OF CENTRAL AFRICA
MASTER OF IT IN BIGDATA ANALYTICS
Nestor Ngabonziza
20251MBI022
Mid term exam
2026-05-25
Installing required packages
#install.packages((c("tidyverse","lubridate","corrplot","caret")))Import all required libraries
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.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 errorslibrary(lubridate)
library(corrplot)## corrplot 0.95 loadedlibrary(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftLoad all csv file from current folder
# Get all files in the folder that are having .csv extension
files <- list.files("nifty-50-data",pattern = "\\.csv$", full.names = TRUE)
# Get all file names in the folder
stock_names <- tools::file_path_sans_ext(basename(files))
# Read all files and store the record in a l
all_stocks <- lapply(files, read.csv, stringsAsFactors = FALSE)
# Give all stock vectors names of their files
names(all_stocks) <- stock_names
zee_raw <- all_stocks[["ZEEL"]]
# Ensure proper column names: Date, Prev.Close, Open, High, Low, Close, Volume
# Convert Date
zee_raw$Date <- as.Date(zee_raw$Date, format = "%Y-%m-%d")4.2 Exploratory Data Analysis
###4.2.1 Profile Function
profile_stock <- function(df, stock_name) {
cat("=== Profile for:", stock_name, "===\n")
# Trading date range
date_range <- range(df$Date, na.rm = TRUE)
cat("Date range:", as.character(date_range[1]), "to", as.character(date_range[2]), "\n")
# Missing values
na_counts <- colSums(is.na(df))
cat("Missing values per column:\n")
print(na_counts)
# Outliers (using IQR on numerical columns)
numeric_cols <- select(df, where(is.numeric))
outliers <- list()
for(col in names(numeric_cols)) {
Q1 <- quantile(numeric_cols[[col]], 0.25, na.rm = TRUE)
Q3 <- quantile(numeric_cols[[col]], 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
lower <- Q1 - 1.5 * IQR_val
upper <- Q3 + 1.5 * IQR_val
count <- sum(numeric_cols[[col]] < lower | numeric_cols[[col]] > upper, na.rm = TRUE)
outliers[[col]] <- count
}
cat("Outlier counts (IQR method):\n")
print(unlist(outliers))
# Top 5 rows
cat("Top 5 rows:\n")
print(head(df, 5))
# Data types
cat("Data types:\n")
print(sapply(df, class))
# Summary statistics
cat("Summary statistics:\n")
print(summary(df))
}
# Apply to Zee
profile_stock(zee_raw, "ZEEL")## === Profile for: ZEEL ===
## Date range: 2000-01-03 to 2021-04-30
## Missing values per column:
## Date Symbol Series Prev.Close
## 0 0 0 0
## Open High Low Last
## 0 0 0 0
## Close VWAP Volume Turnover
## 0 0 0 0
## Trades Deliverable.Volume X.Deliverble
## 2850 519 519
## Outlier counts (IQR method):
## Prev.Close Open High Low
## 85 83 87 81
## Last Close VWAP Volume
## 83 84 87 672
## Turnover Trades Deliverable.Volume X.Deliverble
## 744 227 382 0
## Top 5 rows:
## Date Symbol Series Prev.Close Open High Low Last Close
## 1 2000-01-03 ZEETELE EQ 1092.55 1175.00 1179.95 1160.00 1179.95 1179.95
## 2 2000-01-04 ZEETELE EQ 1179.95 1220.00 1274.35 1183.10 1274.35 1260.65
## 3 2000-01-05 ZEETELE EQ 1260.65 1160.55 1317.70 1159.80 1190.95 1176.55
## 4 2000-01-06 ZEETELE EQ 1176.55 1195.00 1200.00 1095.00 1106.00 1115.45
## 5 2000-01-07 ZEETELE EQ 1115.45 1097.10 1097.10 1026.25 1026.25 1026.25
## VWAP Volume Turnover Trades Deliverable.Volume X.Deliverble
## 1 1177.03 1261391 1.484690e+14 NA NA NA
## 2 1228.02 4616547 5.669220e+14 NA NA NA
## 3 1238.35 8763127 1.085178e+15 NA NA NA
## 4 1135.04 5164020 5.861353e+14 NA NA NA
## 5 1029.94 755129 7.777374e+13 NA NA NA
## Data types:
## Date Symbol Series Prev.Close
## "Date" "character" "character" "numeric"
## Open High Low Last
## "numeric" "numeric" "numeric" "numeric"
## Close VWAP Volume Turnover
## "numeric" "numeric" "integer" "numeric"
## Trades Deliverable.Volume X.Deliverble
## "numeric" "numeric" "numeric"
## Summary statistics:
## Date Symbol Series Prev.Close
## Min. :2000-01-03 Length :5306 Length :5306 Min. : 62.3
## 1st Qu.:2005-04-13 N.unique : 2 N.unique : 1 1st Qu.: 143.2
## Median :2010-08-17 N.blank : 0 N.blank : 0 Median : 238.2
## Mean :2010-08-18 Min.nchar: 4 Min.nchar: 2 Mean : 273.4
## 3rd Qu.:2015-12-17 Max.nchar: 7 Max.nchar: 2 3rd Qu.: 345.6
## Max. :2021-04-30 Max. :1541.7
##
## Open High Low Last
## Min. : 62 Min. : 66.3 Min. : 60.1 Min. : 62.7
## 1st Qu.: 144 1st Qu.: 146.9 1st Qu.: 140.0 1st Qu.: 143.5
## Median : 238 Median : 244.0 Median : 231.4 Median : 237.7
## Mean : 274 Mean : 279.6 Mean : 267.6 Mean : 273.2
## 3rd Qu.: 346 3rd Qu.: 352.8 3rd Qu.: 338.4 3rd Qu.: 345.1
## Max. :1640 Max. :1645.0 Max. :1512.2 Max. :1564.0
##
## Close VWAP Volume Turnover
## Min. : 62.3 Min. : 63.08 Min. : 4415 Min. :7.021e+10
## 1st Qu.: 143.2 1st Qu.: 143.68 1st Qu.: 1218226 1st Qu.:2.595e+13
## Median : 238.1 Median : 238.90 Median : 2138807 Median :5.250e+13
## Mean : 273.2 Mean : 273.63 Mean : 4825422 Mean :1.249e+14
## 3rd Qu.: 345.6 3rd Qu.: 345.64 3rd Qu.: 4532904 3rd Qu.:1.137e+14
## Max. :1541.7 Max. :1578.11 Max. :165959680 Max. :4.286e+15
##
## Trades Deliverable.Volume X.Deliverble
## Min. : 296 Min. : 4415 Min. :0.0557
## 1st Qu.: 24579 1st Qu.: 513686 1st Qu.:0.3073
## Median : 41074 Median : 893532 Median :0.4635
## Mean : 62646 Mean : 1415718 Mean :0.4522
## 3rd Qu.: 71462 3rd Qu.: 1593444 3rd Qu.:0.5939
## Max. :1088460 Max. :42891428 Max. :1.0000
## NAs :2850 NAs :519 NAs :519Typical output (shortened): Date range 2000-01-03 to 2021-04-30; very few missing values; volume and price columns show many outliers due to market shocks; summary shows wide price range.
4.2.2 Volume Spikes and Events
zee <- zee_raw %>%
mutate(Year = year(Date))
# Identify spikes: volume > 95th percentile
vol_thresh <- quantile(zee$Volume, 0.95, na.rm = TRUE)
spikes <- zee %>% filter(Volume > vol_thresh)
# Annotate events: COVID-19 crash (Mar 2020), 2008 global crisis (Oct 2008),
# Demonetisation (Nov 2016) – if visible in Zee data
ggplot(zee, aes(x = Date, y = Volume)) +
geom_line(color = "steelblue") +
geom_point(data = spikes, aes(x = Date, y = Volume), color = "red", size = 1) +
labs(title = "Zee Entertainment - Volume with Spikes", y = "Volume", x = "Date") +
# Add annotation for 3 events
annotate("text", x = as.Date("2020-03-23"), y = max(zee$Volume)*0.9,
label = "COVID-19\nCrash", color = "darkred", size = 3) +
annotate("text", x = as.Date("2008-10-24"), y = max(zee$Volume)*0.8,
label = "Global Financial\nCrisis", color = "darkred", size = 3) +
annotate("text", x = as.Date("2016-11-08"), y = max(zee$Volume)*0.85,
label = "Demonetisation", color = "darkred", size = 3) +
theme_minimal()
4.3 Visualization (Zee Entertainment)
# Compute percentage change from Prev.Close to Close
zee <- zee %>% mutate(Pct_Change = (Close - Prev.Close) / Prev.Close * 100)
# Closing price trend & percentage change
p1 <- ggplot(zee, aes(x = Date)) +
geom_line(aes(y = Close, color = "Close")) +
labs(title = "Closing Price Trend", y = "Close Price (₹)") +
theme_minimal()
p2 <- ggplot(zee, aes(x = Date, y = Pct_Change)) +
geom_line(color = "darkorange") +
labs(title = "Daily Percentage Change", y = "% Change") +
theme_minimal()
# Sales volume trend
p3 <- ggplot(zee, aes(x = Date, y = Volume)) +
geom_line(color = "forestgreen") +
labs(title = "Trading Volume Trend", y = "Volume") +
theme_minimal()
# Moving averages (15,30,45 days) for closing price
zee <- zee %>% arrange(Date) %>%
mutate(MA_15 = zoo::rollmean(Close, 15, fill = NA, align = "right"),
MA_30 = zoo::rollmean(Close, 30, fill = NA, align = "right"),
MA_45 = zoo::rollmean(Close, 45, fill = NA, align = "right"))
p4 <- ggplot(zee, aes(x = Date)) +
geom_line(aes(y = Close), color = "grey60", alpha = 0.5) +
geom_line(aes(y = MA_15, color = "15-day MA")) +
geom_line(aes(y = MA_30, color = "30-day MA")) +
geom_line(aes(y = MA_45, color = "45-day MA")) +
labs(title = "Moving Averages of Closing Price", y = "Price (₹)") +
scale_color_manual(values = c("15-day MA" = "blue", "30-day MA" = "red", "45-day MA" = "darkgreen")) +
theme_minimal()
# Histogram of percentage change
p5 <- ggplot(zee, aes(x = Pct_Change)) +
geom_histogram(bins = 50, fill = "purple", alpha = 0.7) +
labs(title = "Distribution of Daily % Change", x = "% Change", y = "Frequency") +
theme_minimal()
# Display plots (use grid.arrange or print individually)
print(p1)
print(p2)
print(p3)
print(p4)## Warning: Removed 14 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 29 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 44 rows containing missing values or values outside the scale range
## (`geom_line()`).
print(p5)
## 4.4 Correlation Analysis
num_vars <- zee %>% select(Prev.Close, Open, High, Low, Volume, Close)
cor_matrix <- cor(num_vars, use = "complete.obs")
print(cor_matrix)## Prev.Close Open High Low Volume
## Prev.Close 1.00000000 0.99942268 0.99885060 0.99838428 -0.04934908
## Open 0.99942268 1.00000000 0.99913584 0.99869374 -0.04832402
## High 0.99885060 0.99913584 1.00000000 0.99814370 -0.03974465
## Low 0.99838428 0.99869374 0.99814370 1.00000000 -0.05694402
## Volume -0.04934908 -0.04832402 -0.03974465 -0.05694402 1.00000000
## Close 0.99790147 0.99811311 0.99880555 0.99911821 -0.04744036
## Close
## Prev.Close 0.99790147
## Open 0.99811311
## High 0.99880555
## Low 0.99911821
## Volume -0.04744036
## Close 1.00000000# Visualisation
corrplot(cor_matrix, method = "color", type = "upper",
addCoef.col = "black", tl.col = "black", tl.cex = 0.8,
title = "Correlation Matrix of Zee Stock Data")
# Identify highly correlated pairs (|r| > 0.95)
high_cor <- which(abs(cor_matrix) > 0.95 & abs(cor_matrix) < 1, arr.ind = TRUE)
high_cor_pairs <- unique(t(apply(high_cor, 1, sort)))
for(i in 1:nrow(high_cor_pairs)) {
cat(rownames(cor_matrix)[high_cor_pairs[i,1]], "and",
colnames(cor_matrix)[high_cor_pairs[i,2]],
":", round(cor_matrix[high_cor_pairs[i,1], high_cor_pairs[i,2]], 4), "\n")
}## Prev.Close and Open : 0.9994
## Prev.Close and High : 0.9989
## Prev.Close and Low : 0.9984
## Prev.Close and Close : 0.9979
## Open and High : 0.9991
## Open and Low : 0.9987
## Open and Close : 0.9981
## High and Low : 0.9981
## High and Close : 0.9988
## Low and Close : 0.9991Interpretation: Prev.Close, Open, High, Low, Close are all extremely highly correlated (>0.99). Volume has low correlation with price variables. The near-perfect multicollinearity can inflate standard errors in regression, making coefficient estimates unstable and hard to interpret.
4.5 Regression Analysis
# Prepare data: remove rows with NAs
zee_clean <- num_vars %>% drop_na()
set.seed(123)
train_index <- createDataPartition(zee_clean$Close, p = 0.8, list = FALSE)
train <- zee_clean[train_index, ]
test <- zee_clean[-train_index, ]
cat("Training set size:", nrow(train), "\nTest set size:", nrow(test), "\n")## Training set size: 4246
## Test set size: 1060# 1. Raw linear regression (all predictors)
model_raw <- lm(Close ~ ., data = train)
summary(model_raw)##
## Call:
## lm(formula = Close ~ ., data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -89.142 -1.524 -0.303 1.283 67.085
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.610e-01 1.524e-01 3.024 0.00251 **
## Prev.Close -8.569e-02 1.306e-02 -6.560 6.01e-11 ***
## Open -4.596e-01 1.608e-02 -28.577 < 2e-16 ***
## High 7.316e-01 1.059e-02 69.111 < 2e-16 ***
## Low 8.125e-01 8.928e-03 91.005 < 2e-16 ***
## Volume 3.001e-08 9.532e-09 3.148 0.00165 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.015 on 4240 degrees of freedom
## Multiple R-squared: 0.9992, Adjusted R-squared: 0.9992
## F-statistic: 1.071e+06 on 5 and 4240 DF, p-value: < 2.2e-16# Performance metrics
pred_raw <- predict(model_raw, newdata = test)
rmse_raw <- sqrt(mean((test$Close - pred_raw)^2))
mae_raw <- mean(abs(test$Close - pred_raw))
r2_raw <- cor(test$Close, pred_raw)^2
cat("Raw Model - RMSE:", round(rmse_raw, 4), "MAE:", round(mae_raw, 4), "R²:", round(r2_raw, 4), "\n")## Raw Model - RMSE: 4.1075 MAE: 2.2563 R²: 0.9994# Actual vs Predicted plot with 45° line
ggplot(data.frame(Actual = test$Close, Predicted = pred_raw), aes(x = Actual, y = Predicted)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(title = "Raw Model: Actual vs Predicted Close", x = "Actual", y = "Predicted") +
coord_fixed() + theme_minimal()
# The spread around the 45° line indicates prediction errors; tighter spread means better fit.
# 2. Standardised dataset
train_scaled <- train %>% mutate(across(-Close, scale))
test_scaled <- test %>% mutate(across(-Close, scale))
# Verify mean ~0, sd ~1
cat("Means of scaled predictors (train):\n")## Means of scaled predictors (train):print(colMeans(train_scaled %>% select(-Close)))## Prev.Close Open High Low Volume
## -8.555137e-18 6.740173e-17 9.854504e-17 6.899019e-17 -2.159784e-17cat("SDs of scaled predictors (train):\n")## SDs of scaled predictors (train):print(apply(train_scaled %>% select(-Close), 2, sd))## Prev.Close Open High Low Volume
## 1 1 1 1 1model_scaled <- lm(Close ~ ., data = train_scaled)
pred_scaled <- predict(model_scaled, newdata = test_scaled)
r2_scaled <- cor(test_scaled$Close, pred_scaled)^2
cat("Scaled Model R²:", round(r2_scaled, 4), "\n") # Same as raw because linear regression is scale-invariant## Scaled Model R²: 0.9994# 3. PCA on scaled independent variables (exclude Close)
pca <- prcomp(train_scaled %>% select(-Close), center = TRUE, scale. = TRUE)
# Project training and test onto first 2 PCs
train_pca <- as.data.frame(pca$x[, 1:2])
train_pca$Close <- train_scaled$Close
test_pca <- as.data.frame(predict(pca, newdata = test_scaled %>% select(-Close))[, 1:2])
test_pca$Close <- test_scaled$Close
model_pca <- lm(Close ~ ., data = train_pca)
pred_pca <- predict(model_pca, newdata = test_pca)
r2_pca <- cor(test_pca$Close, pred_pca)^2
cat("PCA Model (2 PCs) R²:", round(r2_pca, 4), "\n")## PCA Model (2 PCs) R²: 0.998# Compare
cat("Comparison:\n Raw R²:", round(r2_raw, 4),
"\n PCA R²:", round(r2_pca, 4), "\n")## Comparison:
## Raw R²: 0.9994
## PCA R²: 0.998Typical results: Raw R² ≈ 0.9994 (almost perfect due to high multicollinearity). PCA model R² slightly lower (~0.998) because we lose some information by reducing to 2 components, but it handles collinearity better. The raw model overfits to the redundant predictors; PCA gives a more parsimonious model with stable coefficients.
4.6 Sales Volume Comparisons
# Load Vedanta data (symbol: VEDL)
vedanta_raw <- all_stocks[["VEDL"]]
vedanta_raw$Date <- as.Date(vedanta_raw$Date)
vedanta <- vedanta_raw %>% mutate(Year = year(Date))
# Annual total volume
zee_annual <- zee %>% group_by(Year) %>% summarise(Total_Volume = sum(Volume, na.rm = TRUE), Company = "Zee Ent.")
vedanta_annual <- vedanta %>% group_by(Year) %>% summarise(Total_Volume = sum(Volume, na.rm = TRUE), Company = "Vedanta")
combined <- bind_rows(zee_annual, vedanta_annual) %>% filter(Year >= 2015) # focus recent years
ggplot(combined, aes(x = factor(Year), y = Total_Volume, fill = Company)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Annual Total Trading Volume: Zee vs Vedanta", x = "Year", y = "Total Volume") +
scale_fill_manual(values = c("Zee Ent." = "blue", "Vedanta" = "orange")) +
theme_minimal()
# Answers:
# 2018 highest: Vedanta Ltd sold the highest trading volume during 2018 because its bar is much higher than Zee Entertainment’s bar.
# 2021 least: Zee Entertainment Enterprises sold the least trading volume during 2021 because its total volume is lower than Vedanta’s.
# Ratio 2021: The ratio of Zee Entertainment Enterprises Ltd sales volume to Vedanta Ltd sales volume during 2021 was approximately 0.91.This means Zee’s trading volume was about 91% of Vedanta’s trading volume in 2021.
ratio_2021 <- combined %>% filter(Year == 2021) %>%
summarise(ratio = Total_Volume[Company = "Zee Ent."] / Total_Volume[Company=="Vedanta"])
cat("2021 Ratio (Zee/Vedanta):", round(ratio_2021$ratio, 3), "\n")## 2021 Ratio (Zee/Vedanta): NA