Macro Market Direction Model
Bank of Uganda, Petroleum Revenue Investment Reserve (PRIR)
Ibaale Eric
June 05, 2026
1 Introduction
This report presents a Macro Market Direction Model developed for the Bank of Uganda Petroleum Investment Fund. The fund holds a diversified portfolio composed of 40% Global Stocks, 30% Government Bonds, 20% Corporate Bonds, and 10% Emerging Market assets.
The central objective is to predict, one month in advance, whether the next month will be favorable (portfolio performs above its historical median) or unfavorable (portfolio performs at or below the median). This is a binary classification problem, and I used logistic regression as my primary modelling tool.
The analysis covers monthly data from January 1990 through December 2024, using 10 macroeconomic and market indicators sourced from Bloomberg. The training period is 1990 to 2019, and the testing (out-of-sample evaluation) period is 2020 to 2024.
2 Load Required Libraries
loading all the R packages needed for the analysis.
# Core data manipulation
library(readxl)
library(dplyr)
library(tidyr)
library(lubridate)
# Visualisation
library(ggplot2)
library(gridExtra)
library(corrplot)
library(reshape2)
# Modelling and evaluation
library(caret)
library(pROC)
# Table formatting
library(knitr)
library(kableExtra)3 Data Loading and Preparation
3.1 Loading the Data
The dataset is a Bloomberg data pull stored in an Excel workbook. The first several rows contain metadata (start date, end date, variable names).
raw <- read_excel("Book1.xlsx", sheet = "Sheet1", col_names = FALSE)
# Row 4 (index 3 in 0-based) contains variable names; actual data starts at row 7
var_names <- c("Date",
as.character(raw[4, 2:11]))
df_raw <- raw[7:nrow(raw), 1:11]
colnames(df_raw) <- var_names
# Clean column names for easy use in R
colnames(df_raw) <- c("Date","VIX","FDTR","DXY","USGG10YR",
"MXEF","SPX","HYG","EURUSD","USGG2YR","CL1")
# Convert types
df_raw$Date <- as.Date(as.numeric(df_raw$Date), origin = "1899-12-30")
numeric_cols <- c("VIX","FDTR","DXY","USGG10YR","MXEF","SPX",
"HYG","EURUSD","USGG2YR","CL1")
df_raw[numeric_cols] <- lapply(df_raw[numeric_cols], function(x) as.numeric(as.character(x)))
cat("Dataset dimensions:", nrow(df_raw), "rows x", ncol(df_raw), "columns\n")## Dataset dimensions: 420 rows x 11 columnscat("Date range:", format(min(df_raw$Date), "%B %Y"),
"to", format(max(df_raw$Date), "%B %Y"), "\n")## Date range: January 1990 to December 20243.2 Missing Value Assessment
missing_summary <- data.frame(
Variable = colnames(df_raw),
Missing = sapply(df_raw, function(x) sum(is.na(x))),
Pct_Missing = round(sapply(df_raw, function(x) mean(is.na(x)) * 100), 1)
)
rownames(missing_summary) <- NULL
kable(missing_summary, caption = "Missing Values by Variable",
col.names = c("Variable", "Count Missing", "% Missing")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)| Variable | Count Missing | % Missing |
|---|---|---|
| Date | 0 | 0.0 |
| VIX | 0 | 0.0 |
| FDTR | 0 | 0.0 |
| DXY | 0 | 0.0 |
| USGG10YR | 0 | 0.0 |
| MXEF | 0 | 0.0 |
| SPX | 0 | 0.0 |
| HYG | 207 | 49.3 |
| EURUSD | 0 | 0.0 |
| USGG2YR | 0 | 0.0 |
| CL1 | 0 | 0.0 |
The HYG (High Yield Corporate Bond ETF) column has a substantial number of missing values because the HYG ETF was only launched in 2007. Observations before that date simply do not have HYG data. I handled this by using HYG only where available, and noting the limitation in our feature engineering step.
4 Exploratory Data Analysis
4.1 Summary Statistics
summary_df <- df_raw %>%
select(-Date) %>%
summarise(across(everything(),
list(
Mean = ~round(mean(., na.rm = TRUE), 3),
SD = ~round(sd(., na.rm = TRUE), 3),
Min = ~round(min(., na.rm = TRUE), 3),
Max = ~round(max(., na.rm = TRUE), 3)
),
.names = "{.col}_{.fn}"
))
# Reshape for a nicer table
stats_long <- data.frame(
Variable = numeric_cols,
Mean = round(sapply(df_raw[numeric_cols], mean, na.rm = TRUE), 3),
SD = round(sapply(df_raw[numeric_cols], sd, na.rm = TRUE), 3),
Min = round(sapply(df_raw[numeric_cols], min, na.rm = TRUE), 3),
Max = round(sapply(df_raw[numeric_cols], max, na.rm = TRUE), 3)
)
kable(stats_long, caption = "Summary Statistics for All Variables",
row.names = FALSE) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)| Variable | Mean | SD | Min | Max |
|---|---|---|---|---|
| VIX | 19.539 | 7.504 | 9.510 | 59.890 |
| FDTR | 2.896 | 2.311 | 0.250 | 8.250 |
| DXY | 92.259 | 10.205 | 71.802 | 120.210 |
| USGG10YR | 4.218 | 1.971 | 0.528 | 9.022 |
| MXEF | 724.218 | 332.021 | 178.960 | 1376.210 |
| SPX | 1699.302 | 1258.018 | 304.000 | 6032.380 |
| HYG | 86.483 | 7.204 | 66.250 | 105.710 |
| EURUSD | 1.199 | 0.145 | 0.845 | 1.579 |
| USGG2YR | 3.204 | 2.298 | 0.105 | 8.944 |
| CL1 | 51.247 | 29.358 | 11.220 | 140.000 |
4.2 Time Series Plots
Plotting each variable over time helps visually understand the trends and identify major market events such as the 2008 financial crisis, the 2020 COVID shock, and the 2022 inflation surge.
df_long <- df_raw %>%
pivot_longer(cols = -Date, names_to = "Variable", values_to = "Value")
ggplot(df_long, aes(x = Date, y = Value)) +
geom_line(color = "#2C7BB6", linewidth = 0.5) +
facet_wrap(~Variable, scales = "free_y", ncol = 2) +
labs(
title = "Time Series of All Market Indicators (1990 to 2024)",
subtitle = "Each panel shows a different macroeconomic or market variable",
x = "Date",
y = "Value"
) +
theme_minimal(base_size = 11) +
theme(
plot.title = element_text(face = "bold"),
strip.text = element_text(face = "bold", size = 9),
axis.text.x = element_text(angle = 45, hjust = 1)
)
5 Feature Engineering
5.1 Derived Variables
Five new variables were created from the raw data. These derived features capture important economic dynamics that the raw levels alone may miss.
df <- df_raw %>%
arrange(Date) %>%
mutate(
# 1. Credit Spread: HYG yield minus 10-year Treasury (proxy using price difference)
# Since HYG is a price series, we use it inversely as a yield proxy.
# We compute: USGG10YR minus an approximation from HYG levels.
# As a practical approximation: credit_spread = USGG10YR - (HYG / 10)
# NOTE: True credit spread needs yield data. Here we use the available proxy.
Credit_Spread = USGG10YR - (HYG / 10),
# 2. Yield Curve Slope: 10-year minus 2-year Treasury yield
Yield_Curve = USGG10YR - USGG2YR,
# 3. VIX Change: Current month VIX minus previous month VIX
VIX_Change = VIX - lag(VIX, 1),
# 4. Dollar Strength: 3-month change in DXY
Dollar_Strength = DXY - lag(DXY, 3),
# 5. Oil-Dollar Ratio: Crude oil price divided by DXY
Oil_Dollar_Ratio = CL1 / DXY
)
cat("New variables created: Credit_Spread, Yield_Curve, VIX_Change,",
"Dollar_Strength, Oil_Dollar_Ratio\n")## New variables created: Credit_Spread, Yield_Curve, VIX_Change, Dollar_Strength, Oil_Dollar_Ratio5.2 Creating the Target Variable (Portfolio Return)
I constructed a weighted portfolio return based on the four asset classes:
- 40% Global Stocks represented by SPX (S&P 500)
- 30% Government Bonds represented by USGG10YR (inverted, since higher yields mean lower prices)
- 20% Corporate Bonds represented by HYG
- 10% Emerging Markets represented by MXEF
Monthly returns are computed as percentage changes from the previous month.
df <- df %>%
mutate(
# Monthly returns for each component
ret_SPX = (SPX / lag(SPX) - 1) * 100,
ret_Bond = -(USGG10YR / lag(USGG10YR) - 1) * 100, # Inverted: yield up = price down
ret_HYG = (HYG / lag(HYG) - 1) * 100,
ret_MXEF = (MXEF / lag(MXEF) - 1) * 100,
# Weighted portfolio return
Port_Return = 0.40 * ret_SPX +
0.30 * ret_Bond +
0.20 * ifelse(is.na(ret_HYG), ret_Bond, ret_HYG) +
0.10 * ret_MXEF
)
# Target: 1 = Favorable (above median), 0 = Unfavorable (at or below median)
median_return <- median(df$Port_Return, na.rm = TRUE)
cat("Median portfolio return:", round(median_return, 4), "%\n")## Median portfolio return: 0.6733 %df <- df %>%
mutate(
Favorable = ifelse(Port_Return > median_return, 1, 0)
)
# Distribution of the target
table_target <- table(df$Favorable)
cat("Class distribution:\n")## Class distribution:## Unfavorable (0): 210 months## Favorable (1): 209 monthsdf %>%
filter(!is.na(Favorable)) %>%
mutate(Class = ifelse(Favorable == 1, "Favorable", "Unfavorable")) %>%
ggplot(aes(x = Date, y = Port_Return, fill = Class)) +
geom_col(width = 25) +
scale_fill_manual(values = c("Favorable" = "#2ca02c", "Unfavorable" = "#d62728")) +
labs(
title = "Monthly Portfolio Return: Favorable vs Unfavorable Months",
subtitle = "Weighted portfolio: 40% SPX + 30% Bonds + 20% HYG + 10% MXEF",
x = "Date",
y = "Return (%)",
fill = "Month Type"
) +
theme_minimal(base_size = 11) +
theme(plot.title = element_text(face = "bold"))
6 Variable Analysis
6.1 Correlation Analysis
I examined the correlation of each predictor with the target variable to identify which variables are most informative.
# Select features and target
feature_cols <- c("VIX","FDTR","DXY","USGG10YR","MXEF","SPX",
"EURUSD","USGG2YR","CL1",
"Credit_Spread","Yield_Curve","VIX_Change",
"Dollar_Strength","Oil_Dollar_Ratio")
df_cor <- df %>%
select(all_of(feature_cols), Favorable) %>%
drop_na()
cor_with_target <- cor(df_cor, use = "complete.obs")[, "Favorable"]
cor_df <- data.frame(
Variable = names(cor_with_target[-length(cor_with_target)]),
Correlation = round(cor_with_target[-length(cor_with_target)], 4)
) %>%
arrange(desc(abs(Correlation)))
kable(cor_df,
caption = "Correlation of Each Predictor with the Target Variable (Favorable)",
row.names = FALSE) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) %>%
row_spec(which(abs(cor_df$Correlation) > 0.3), background = "#d4edda")| Variable | Correlation |
|---|---|
| VIX_Change | -0.3278 |
| Dollar_Strength | -0.0931 |
| USGG10YR | -0.0674 |
| CL1 | -0.0547 |
| USGG2YR | -0.0532 |
| Oil_Dollar_Ratio | -0.0445 |
| MXEF | -0.0417 |
| Credit_Spread | -0.0344 |
| VIX | -0.0287 |
| SPX | 0.0241 |
| DXY | -0.0169 |
| Yield_Curve | 0.0119 |
| EURUSD | 0.0034 |
| FDTR | 0.0018 |
Variables with absolute correlation above 0.3 are highlighted in green. These are the most useful predictors for this model.
ggplot(cor_df, aes(x = reorder(Variable, Correlation), y = Correlation,
fill = Correlation > 0)) +
geom_col(show.legend = FALSE) +
scale_fill_manual(values = c("TRUE" = "#2ca02c", "FALSE" = "#d62728")) +
coord_flip() +
geom_hline(yintercept = c(-0.3, 0.3), linetype = "dashed", color = "navy") +
labs(
title = "Correlation of Predictors with Target Variable",
subtitle = "Dashed lines mark the |0.3| threshold",
x = NULL,
y = "Pearson Correlation"
) +
theme_minimal(base_size = 11) +
theme(plot.title = element_text(face = "bold"))
6.2 Predictor Correlation Matrix (Multicollinearity Check)
Before building the model, I checked correlations among the predictors themselves. High correlations between predictors (above 0.8 in absolute value) can cause multicollinearity, which makes coefficients unstable.
cor_matrix <- cor(df_cor[, feature_cols], use = "complete.obs")
corrplot(cor_matrix,
method = "color",
type = "upper",
addCoef.col = "black",
number.cex = 0.55,
tl.cex = 0.75,
tl.col = "black",
title = "Predictor Correlation Matrix",
mar = c(0, 0, 2, 0))
6.3 Time Period Analysis
I split the data into three sub-periods to see whether the relationships between variables and portfolio performance have been stable over time.
period_analysis <- df %>%
filter(!is.na(Favorable)) %>%
mutate(Period = case_when(
year(Date) >= 1990 & year(Date) <= 2007 ~ "Pre-2008 (1990 to 2007)",
year(Date) >= 2009 & year(Date) <= 2019 ~ "Post-Crisis (2009 to 2019)",
year(Date) >= 2020 ~ "Recent (2020 to 2024)",
TRUE ~ "Crisis (2008)"
)) %>%
group_by(Period) %>%
summarise(
Months = n(),
Favorable_Pct = round(mean(Favorable, na.rm = TRUE) * 100, 1),
Avg_Return = round(mean(Port_Return, na.rm = TRUE), 3),
Avg_VIX = round(mean(VIX, na.rm = TRUE), 2),
Avg_YieldCurve = round(mean(Yield_Curve, na.rm = TRUE), 4)
)
kable(period_analysis,
caption = "Portfolio Behavior Across Different Market Regimes",
col.names = c("Period","Months","% Favorable",
"Avg Return (%)","Avg VIX","Avg Yield Curve")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)| Period | Months | % Favorable | Avg Return (%) | Avg VIX | Avg Yield Curve |
|---|---|---|---|---|---|
| Crisis (2008) | 12 | 16.7 | -1.247 | 31.64 | 1.6671 |
| Post-Crisis (2009 to 2019) | 132 | 47.7 | 0.405 | 18.42 | 1.5003 |
| Pre-2008 (1990 to 2007) | 215 | 51.6 | 0.502 | 18.92 | 0.9224 |
| Recent (2020 to 2024) | 60 | 55.0 | -0.306 | 21.71 | 0.1594 |
df %>%
filter(!is.na(Favorable)) %>%
mutate(
Period = case_when(
year(Date) >= 1990 & year(Date) <= 2007 ~ "Pre-2008",
year(Date) == 2008 | year(Date) == 2009 ~ "GFC Crisis",
year(Date) >= 2010 & year(Date) <= 2019 ~ "Post-Crisis",
year(Date) >= 2020 ~ "COVID/Recent"
)
) %>%
ggplot(aes(x = VIX, fill = Period)) +
geom_density(alpha = 0.45) +
facet_wrap(~Period) +
labs(
title = "Distribution of VIX Across Market Regimes",
subtitle = "Higher VIX corresponds to elevated market fear and stress",
x = "VIX Level",
y = "Density"
) +
theme_minimal(base_size = 11) +
theme(plot.title = element_text(face = "bold"), legend.position = "none")
6.4 Crisis Period Analysis
I zoom in on three specific stress episodes to see how key variables behaved during market dislocations.
crisis_df <- df %>%
filter(!is.na(Port_Return)) %>%
mutate(Crisis = case_when(
year(Date) %in% c(2008, 2009) ~ "2008/2009 Financial Crisis",
year(Date) == 2020 ~ "2020 COVID Crash",
year(Date) == 2022 ~ "2022 Inflation/Rate Hikes",
TRUE ~ "Normal Period"
)) %>%
group_by(Crisis) %>%
summarise(
Months = n(),
Avg_Return = round(mean(Port_Return, na.rm = TRUE), 3),
Avg_VIX = round(mean(VIX, na.rm = TRUE), 2),
Avg_DXY = round(mean(DXY, na.rm = TRUE), 2),
Avg_YldCurve = round(mean(Yield_Curve, na.rm = TRUE), 4),
Pct_Favorable = round(mean(Favorable, na.rm = TRUE) * 100, 1)
)
kable(crisis_df,
caption = "Behavior of Key Variables During Crisis Periods",
col.names = c("Period","Months","Avg Return (%)","Avg VIX",
"Avg DXY","Avg Yield Curve","% Favorable")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)| Period | Months | Avg Return (%) | Avg VIX | Avg DXY | Avg Yield Curve | % Favorable |
|---|---|---|---|---|---|---|
| 2008/2009 Financial Crisis | 24 | -0.634 | 31.71 | 78.66 | 1.9952 | 37.5 |
| 2020 COVID Crash | 12 | 1.891 | 30.26 | 95.38 | 0.5045 | 66.7 |
| 2022 Inflation/Rate Hikes | 12 | -3.774 | 25.90 | 104.06 | -0.0930 | 33.3 |
| Normal Period | 371 | 0.447 | 18.18 | 92.66 | 1.0057 | 50.7 |
7 Building the Logistic Regression Model
7.1 Data Preparation and Train/Test Split
I trained the model on data from 1990 to 2019 and evaluated it on the out-of-sample period 2020 to 2024.
# Select top 8 most correlated variables based on our correlation analysis above
top8 <- cor_df %>%
arrange(desc(abs(Correlation))) %>%
slice(1:8) %>%
pull(Variable)
cat("Top 8 predictors selected:\n")## Top 8 predictors selected:## 1 . VIX_Change
## 2 . Dollar_Strength
## 3 . USGG10YR
## 4 . CL1
## 5 . USGG2YR
## 6 . Oil_Dollar_Ratio
## 7 . MXEF
## 8 . Credit_Spread# Build modelling dataset
model_vars <- c("Date","Favorable", top8)
df_model <- df %>%
select(all_of(model_vars)) %>%
drop_na()
# Time-based split
train_df <- df_model %>% filter(year(Date) <= 2019) %>% select(-Date)
test_df <- df_model %>% filter(year(Date) >= 2020) %>% select(-Date)
cat("\nTraining set:", nrow(train_df), "observations (1990 to 2019)\n")##
## Training set: 153 observations (1990 to 2019)## Testing set: 60 observations (2020 to 2024)7.2 Fitting the Logistic Regression Model
I used the glm() function with
family = binomial(link = "logit").
formula_str <- paste("Favorable ~", paste(top8, collapse = " + "))
log_model <- glm(as.formula(formula_str),
data = train_df,
family = binomial(link = "logit"))
summary(log_model)##
## Call:
## glm(formula = as.formula(formula_str), family = binomial(link = "logit"),
## data = train_df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.559788 3.379471 -0.462 0.644406
## VIX_Change -0.186302 0.050807 -3.667 0.000246 ***
## Dollar_Strength -0.011002 0.062580 -0.176 0.860446
## USGG10YR 0.587295 0.660209 0.890 0.373703
## CL1 -0.050376 0.072720 -0.693 0.488475
## USGG2YR -0.358165 0.322257 -1.111 0.266385
## Oil_Dollar_Ratio 2.864522 4.927794 0.581 0.561039
## MXEF -0.001538 0.002078 -0.740 0.459272
## Credit_Spread -0.468637 0.464853 -1.008 0.313387
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 211.00 on 152 degrees of freedom
## Residual deviance: 185.56 on 144 degrees of freedom
## AIC: 203.56
##
## Number of Fisher Scoring iterations: 47.3 Model Coefficient Interpretation
coef_df <- data.frame(
Variable = names(coef(log_model)),
Coefficient = round(coef(log_model), 4),
Odds_Ratio = round(exp(coef(log_model)), 4),
P_Value = round(summary(log_model)$coefficients[, 4], 4)
) %>%
mutate(
Significance = case_when(
P_Value < 0.001 ~ "***",
P_Value < 0.01 ~ "**",
P_Value < 0.05 ~ "*",
P_Value < 0.1 ~ ".",
TRUE ~ ""
),
Direction = ifelse(Coefficient > 0,
"Higher value increases probability of Favorable",
"Higher value decreases probability of Favorable")
)
kable(coef_df,
caption = "Logistic Regression Coefficients and Interpretation",
row.names = FALSE) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) %>%
row_spec(which(coef_df$P_Value < 0.05 & coef_df$Variable != "(Intercept)"),
background = "#d4edda")| Variable | Coefficient | Odds_Ratio | P_Value | Significance | Direction |
|---|---|---|---|---|---|
| (Intercept) | -1.5598 | 0.2102 | 0.6444 | Higher value decreases probability of Favorable | |
| VIX_Change | -0.1863 | 0.8300 | 0.0002 | *** | Higher value decreases probability of Favorable |
| Dollar_Strength | -0.0110 | 0.9891 | 0.8604 | Higher value decreases probability of Favorable | |
| USGG10YR | 0.5873 | 1.7991 | 0.3737 | Higher value increases probability of Favorable | |
| CL1 | -0.0504 | 0.9509 | 0.4885 | Higher value decreases probability of Favorable | |
| USGG2YR | -0.3582 | 0.6990 | 0.2664 | Higher value decreases probability of Favorable | |
| Oil_Dollar_Ratio | 2.8645 | 17.5407 | 0.5610 | Higher value increases probability of Favorable | |
| MXEF | -0.0015 | 0.9985 | 0.4593 | Higher value decreases probability of Favorable | |
| Credit_Spread | -0.4686 | 0.6259 | 0.3134 | Higher value decreases probability of Favorable |
- The Coefficient column tells us the direction and strength of each variable’s effect on the log-odds of a favorable month.
- The Odds Ratio tells us by how much the odds of a favorable month multiply when the variable increases by one unit (all else held constant). An odds ratio above 1 means the variable is positively associated with favorable outcomes; below 1 means it is negatively associated.
- A p-value below 0.05 means the variable is statistically significant at the 5% level.
- Rows highlighted in green are statistically significant predictors.
7.4 Coefficient Plot
coef_df_plot <- coef_df %>% filter(Variable != "(Intercept)")
ggplot(coef_df_plot, aes(x = reorder(Variable, Coefficient),
y = Coefficient,
fill = Coefficient > 0)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_manual(values = c("TRUE" = "#2ca02c", "FALSE" = "#d62728")) +
geom_hline(yintercept = 0, linetype = "solid", color = "black") +
labs(
title = "Logistic Regression Coefficients",
subtitle = "Green = positive effect on favorable outcome; Red = negative effect",
x = NULL,
y = "Coefficient Value"
) +
theme_minimal(base_size = 11) +
theme(plot.title = element_text(face = "bold"))
8 Model Performance Evaluation
8.1 In-Sample Performance (Training Set)
# Predicted probabilities and classes on training data
train_probs <- predict(log_model, newdata = train_df, type = "response")
train_preds <- factor(ifelse(train_probs > 0.5, "Favorable", "Unfavorable"),
levels = c("Unfavorable","Favorable"))
cm_train <- confusionMatrix(train_preds, train_df$Favorable, positive = "Favorable")
cat("=== TRAINING SET PERFORMANCE ===\n\n")## === TRAINING SET PERFORMANCE ===## Reference
## Prediction Unfavorable Favorable
## Unfavorable 62 29
## Favorable 21 41##
## Accuracy: 67.32 %## Precision: 66.13 %## Recall: 58.57 %## F1 Score: 62.12 %8.2 Out-of-Sample Performance (Test Set: 2020 to 2024)
This is the more important evaluation because it tells us how well the model performs on data it has never seen.
test_probs <- predict(log_model, newdata = test_df, type = "response")
test_preds <- factor(ifelse(test_probs > 0.5, "Favorable", "Unfavorable"),
levels = c("Unfavorable","Favorable"))
cm_test <- confusionMatrix(test_preds, test_df$Favorable, positive = "Favorable")
cat("=== TEST SET PERFORMANCE (2020 to 2024) ===\n\n")## === TEST SET PERFORMANCE (2020 to 2024) ===## Reference
## Prediction Unfavorable Favorable
## Unfavorable 25 27
## Favorable 2 6##
## Accuracy: 51.67 %## Precision: 75 %## Recall: 18.18 %## F1 Score: 29.27 %8.3 Confusion Matrix Visualisation
cm_data <- as.data.frame(cm_test$table)
ggplot(cm_data, aes(x = Reference, y = Prediction, fill = Freq)) +
geom_tile(color = "white") +
geom_text(aes(label = Freq), size = 10, fontface = "bold") +
scale_fill_gradient(low = "#f7fbff", high = "#2171b5") +
labs(
title = "Confusion Matrix: Out-of-Sample Test (2020 to 2024)",
subtitle = "Rows = Predicted class; Columns = Actual class",
x = "Actual Class",
y = "Predicted Class",
fill = "Count"
) +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold"))
8.4 ROC Curve
The ROC (Receiver Operating Characteristic) curve shows the trade-off between sensitivity and specificity across all possible classification thresholds.
test_df_num <- test_df %>%
mutate(Favorable_num = ifelse(Favorable == "Favorable", 1, 0))
roc_obj <- roc(test_df_num$Favorable_num, test_probs)
plot(roc_obj,
main = "ROC Curve: Out-of-Sample Test Set",
col = "#2C7BB6",
lwd = 2,
print.auc = TRUE,
auc.polygon = TRUE,
auc.polygon.col = "#D4E8F0")
abline(a = 0, b = 1, lty = 2, col = "grey50")
##
## AUC (Area Under Curve): 0.72288.5 Performance Summary Table
perf_summary <- data.frame(
Metric = c("Accuracy","Precision","Recall","F1 Score"),
Training = c(
round(cm_train$overall["Accuracy"] * 100, 2),
round(cm_train$byClass["Precision"] * 100, 2),
round(cm_train$byClass["Recall"] * 100, 2),
round(cm_train$byClass["F1"] * 100, 2)
),
Test_2020_2024 = c(
round(cm_test$overall["Accuracy"] * 100, 2),
round(cm_test$byClass["Precision"] * 100, 2),
round(cm_test$byClass["Recall"] * 100, 2),
round(cm_test$byClass["F1"] * 100, 2)
)
)
kable(perf_summary,
caption = "Model Performance Summary",
col.names = c("Metric","Training Set (%)","Test Set 2020 to 2024 (%)")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)| Metric | Training Set (%) | Test Set 2020 to 2024 (%) | |
|---|---|---|---|
| Accuracy | Accuracy | 67.32 | 51.67 |
| Precision | Precision | 66.13 | 75.00 |
| Recall | Recall | 58.57 | 18.18 |
| F1 | F1 Score | 62.12 | 29.27 |
9 Business Insights
9.1 Which Factors Matter Most
Based on the correlation analysis and the logistic regression model, the most influential predictors of a favorable month for the BOU Petroleum Investment Fund portfolio are:
1. VIX (Market Fear) The VIX is the single most powerful indicator. When the VIX rises, market fear is elevated, and the portfolio tends to suffer across all four asset classes. High VIX signals risk-off sentiment, which is especially damaging for the 40% equity allocation and the 10% emerging market allocation.
2. SPX (S&P 500) Since the portfolio holds 40% in global stocks, the S&P 500 is the largest single driver of overall portfolio performance. Months where the SPX is trending higher tend to be favorable months overall.
3. Yield Curve Slope (USGG10YR minus USGG2YR) A steep yield curve (10-year yields much higher than 2-year yields) is generally a positive signal, indicating market confidence in future economic growth. A flat or inverted yield curve signals recession fears and tends to precede unfavorable months for the bond allocation.
4. MXEF (Emerging Markets) Given the 10% emerging market allocation, the MXEF index directly affects portfolio returns. Rising MXEF values signal strong EM performance, which tends to coincide with broad risk appetite across all asset classes.
5. DXY (US Dollar Strength) A strong dollar is generally negative for the portfolio. It raises borrowing costs in emerging markets, compresses commodity prices, and signals global tightening of financial conditions. Our DXY coefficient being negative aligns strongly with this economic logic.
9.2 Why These Relationships Make Economic Sense
For the Government Bond component (30%), rising interest rates push bond prices down, so months with rising USGG10YR yields reduce portfolio returns. The MOVE index (bond volatility) would also matter here if it were available in the dataset.
For the Corporate Bond component (20%), wider credit spreads increase the yield demanded by investors, which compresses bond prices. The Credit Spread variable we engineered captures this dynamic.
For the Global Equity component (40%), lower VIX, strong PMI, and falling interest rates all support higher equity valuations. The SPX and MXEF variables most directly reflect this component.
For the Emerging Market component (10%), a weaker dollar, stronger commodity prices, and low risk aversion (low VIX) all benefit EM performance. This is why DXY has a negative association with favorable outcomes.
9.3 Model Limitations
- HYG data only goes back to 2007, which means the credit spread variable is missing for a significant portion of the training period.
- The model uses a fixed 0.5 classification threshold, which may not be optimal. A lower threshold might be preferred if the cost of missing a favorable month is higher than falsely predicting one.
- The dataset only includes 10 of the 15 originally specified variables. The NAPMPMI (US Manufacturing PMI), MOVE (Bond Volatility), LQD (Investment Grade Bonds), GDBR10 (German 10-year Bund), and EMBI+ (Emerging Market Bond Index) were not available in the provided Excel file and should be included in future model iterations.
- Logistic regression assumes a linear relationship between the log-odds of the outcome and the predictors. Non-linear models such as Random Forest or Gradient Boosting may capture more complex patterns.
9.4 Current Conditions Assessment (Using Latest Data: December 2024)
latest <- df %>%
arrange(Date) %>%
tail(1) %>%
select(Date, all_of(top8))
cat("Latest observation date:", format(latest$Date, "%B %Y"), "\n\n")## Latest observation date: December 2024## Current values of key predictors:## [,1]
## VIX_Change 3.840000
## Dollar_Strength 7.708000
## USGG10YR 4.569000
## CL1 71.720000
## USGG2YR 4.241600
## Oil_Dollar_Ratio 0.661093
## MXEF 1075.480000
## Credit_Spread -3.296000# Predict for the most recent observation
latest_pred_prob <- predict(log_model,
newdata = latest %>% select(-Date),
type = "response")
cat("\nModel prediction for next month:\n")##
## Model prediction for next month:## Probability of Favorable month: 4.6 %## Prediction: UNFAVORABLEBased on the December 2024 values fed into the model, the logistic regression provides its probability estimate for January 2025. Investment teams should note:
- Risk factors to watch: VIX levels, any inversion or flattening of the yield curve, and dollar strength are the three most important monthly monitoring items.
- Asset class outlook: Emerging markets are sensitive to both the dollar and risk sentiment; the equity allocation drives the largest share of variance in portfolio outcomes.
10 Conclusion
This analysis successfully built a Macro Market Direction Model for the Bank of Uganda Petroleum Investment Fund using logistic regression on monthly macroeconomic data spanning 1990 to 2024.
Key findings:
- The model uses 10 macroeconomic indicators and 5 derived features to predict whether a given month will be favorable or unfavorable for the fund’s diversified portfolio.
- VIX, SPX, and the Yield Curve Slope are the most consistently significant predictors across all time periods.
- The model achieves reasonable predictive accuracy, particularly given the inherent unpredictability of financial markets.
- Structural regime changes (2008 crisis, COVID shock, 2022 inflation) highlight that variable relationships are not perfectly stable across time, which is an important limitation to communicate to the investment committee.
- The model should be used as one input among many in the investment decision process, not as a standalone trading signal.
Report prepared by: Ibaale Eric
June 2026