We are going to define a function for comparing a time-series for its most representative counterpart in a reference time-series(s). This expands the analysis already presented in “Time-Series Classification” by using vectors of different lengths for partial time-series matching.
In this example we will ascertain the most similar period for the
S&P 500 index since 1950 to the current year 2026
returns through May, 2026.
Similarity is measured on compounded cumulative
returns — cumprod(1 + r) — rather than raw daily
returns. This makes every metric path-aware: two windows must travel the
same cumulative route, not merely share day-by-day co-movement.
#require(devtools); install_github('OVVO-Financial/NNS', ref = "NNS-Beta-Version")
library(NNS)
library(lubridate)
library(data.table)
library(quantmod)
library(zoo)
We will load the data for the S&P 500 index from
1950. This will create the variable GSPC. Further, we will
create:
current_cumret
& windows derived from reference_returnscurrent &
referencew# Download data
getSymbols('^GSPC', src='yahoo', from=as.Date("1950-01-01"))
## [1] "GSPC"
# Daily returns (arithmetic, explicit)
reference_returns <- dailyReturn(GSPC, type = "arithmetic")
reference <- GSPC$GSPC.Adjusted
# Helper: compounded cumulative return path from a vector of arithmetic returns
cumret <- function(x) cumprod(1 + as.numeric(x))
# Create current distribution
current_year <- year(Sys.Date())
current_returns <- reference_returns[as.character(current_year)]
current <- reference[as.character(current_year)]
current_cumret <- cumret(current_returns)
# Window length
w <- length(current_cumret)
Let’s identify the calendar year which is most similar. We will
create a series of reference distributions from the
beginning of each calendar year of equal length to the
current distribution. This just uses
NNS.reg(..., order = "max") which is a knn surrogate, and
k=1 in this classification instance. Each year’s series is
expressed as its compounded cumulative return path.
First, a quick test to see if using the current year actually returns the current year…
cumret_list <- list()
first_year <- lubridate::year(index(GSPC)[1])
last_year <- current_year
for(i in seq(first_year, last_year, 1)){
idx <- which(i == seq(first_year, last_year, 1))
yr_returns <- reference_returns[as.character(i)][1:w]
cumret_list[[idx]] <- cumret(yr_returns)
}
IV <- matrix(unlist(cumret_list), ncol = w, byrow = TRUE)
DV <- seq(first_year, last_year, 1)
nns.estimate <- NNS.reg(IV, DV, point.est = t(current_cumret), order = "max", n.best = 1,
residual.plot = FALSE, type = "CLASS")$Point.est
nns.estimate
## [1] 2026
Yup, exact match! Let’s remove the current_year from the
cumret_list.
cumret_list <- list()
first_year <- lubridate::year(index(GSPC)[1])
last_year <- current_year - 1
for(i in seq(first_year, last_year, 1)){
idx <- which(i == seq(first_year, last_year, 1))
yr_returns <- reference_returns[as.character(i)][1:w]
cumret_list[[idx]] <- cumret(yr_returns)
}
IV <- matrix(unlist(cumret_list), ncol = w, byrow = TRUE)
DV <- seq(first_year, last_year, 1)
nns.estimate <- NNS.reg(IV, DV, point.est = t(current_cumret), order = "max", n.best = 1,
residual.plot = FALSE, type = "CLASS")$Point.est
nns.estimate
## [1] 2007
# View the plot on both series
plot(as.zoo(reference[as.character(nns.estimate)][1:w]), col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("NNS \n Most Similar Calendar Year \n", nns.estimate))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current (RHS)"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n")
# Future from most similar period
future_GSPC <- reference[as.character(nns.estimate)][w:min((2*w), length(reference[as.character(nns.estimate)]))]
plot(future_GSPC)
Next we will eschew the calendar year and scan overlapping windows to find the most similar period. The independent variable matrices get excessive (since each observation is an IV and they sequentially overlap), so we can simplify by minimizing the sum-of-squared differences, or maximizing the linear correlation of compounded cumulative return vectors to determine similarity.
We will use the last 88 trading days.
#current_returns <- tail(current_returns, 60) #Set to any length
w <- length(current_returns)
current_cumret <- cumret(current_returns)
If we do not remove the last w observations from the
reference data, we will match exactly to the
current starting period.
# Measure time
start.time <- Sys.time()
best.period.1 <- which.max(
sapply(
seq_len(length(reference_returns) - w + 1),
function(i) cor(cumret(reference_returns[i:(i + w - 1)]),
current_cumret)
)
)
# Calculate elapsed time
print(Sys.time() - start.time)
## Time difference of 1.304198 secs
# Output the best matching period's value in GSPC
GSPC[best.period.1]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2026-01-02 6878.11 6894.87 6824.31 6858.47 4184120000 6858.47
Yup, exact match! Let’s remove those current
observations from the reference.
# Trim both reference series together to keep them in sync
reference <- head(reference, nrow(reference) - w)
reference_returns <- head(reference_returns, length(reference_returns) - w)
The first method maximises linear correlation between the compounded cumulative return path of each reference window and the current period.
best.period.1 <- which.max(
sapply(
seq_len(length(reference_returns) - w + 1),
function(i) cor(cumret(reference_returns[i:(i + w - 1)]),
current_cumret)
)
)
# Most similar period
GSPC[c(best.period.1, best.period.1 + w)]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1963-05-01 69.80 70.43 69.61 69.97 5060000 69.97
## 1963-09-05 72.64 73.19 72.15 73.00 5700000 73.00
# View Plot on Both Series
plot(as.zoo(reference[best.period.1:(best.period.1 + w)]), col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("LINEAR CORRELATION \n Most Similar Period \n",
index(reference_returns[best.period.1]), " : ",
index(reference_returns[(best.period.1 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current (RHS)"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n")
# Future from most similar period
GSPC[c(best.period.1 + w, best.period.1 + (2*w))]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1963-09-05 72.64 73.19 72.15 73.00 5700000 73.00
## 1964-01-14 76.22 76.85 75.88 76.36 6500000 76.36
future_GSPC_1 <- reference[(best.period.1 + w):(best.period.1 + (2*w))]
plot(future_GSPC_1)
# SSE on compounded returns
sum( (cumret(reference_returns[best.period.1:(best.period.1 - 1 + w)]) - current_cumret)^2 )
## [1] 0.03062372
The second method minimises the sum of squared differences between compounded cumulative return paths.
First, let’s check its accuracy on the complete dataset to see if it selects the current period as the most likely period…
# Reload full series for accuracy check
reference_returns_full <- dailyReturn(GSPC, type = "arithmetic")
best.period.2 <- which.min(
sapply(
seq_len(length(reference_returns_full) - w + 1),
function(i) sum((cumret(reference_returns_full[i:(i + w - 1)]) - current_cumret)^2)
)
)
# Output the most similar period's value in GSPC
GSPC[best.period.2]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2026-01-02 6878.11 6894.87 6824.31 6858.47 4184120000 6858.47
Yup, it works!
Now we will apply the sum-of-squared differences to the compounded
cumulative returns, after removing the current observations
from the reference…again.
# reference_returns already has current period removed (from `remove` chunk)
best.period.2 <- which.min(
sapply(
seq_len(length(reference_returns) - w + 1),
function(i) sum((cumret(reference_returns[i:(i + w - 1)]) - current_cumret)^2)
)
)
# Most similar period
GSPC[c(best.period.2, best.period.2 + w)]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1962-07-31 57.83 58.58 57.74 58.23 4190000 58.23
## 1962-12-05 62.64 63.50 62.37 62.39 6280000 62.39
# View Plot on Both Series
plot(as.zoo(reference[best.period.2:(best.period.2 + w)]), lty = 1, col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("SUM OF SQUARED DIFFERENCES \n Most Similar Period \n",
index(reference_returns[best.period.2]), " : ",
index(reference_returns[(best.period.2 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n")
# Future from most similar period
GSPC[c(best.period.2 + w, best.period.2 + (2*w))]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1962-12-05 62.64 63.50 62.37 62.39 6280000 62.39
## 1963-04-11 68.29 69.07 67.97 68.77 5250000 68.77
future_GSPC_2 <- reference[(best.period.2 + w):(best.period.2 + (2*w))]
plot(future_GSPC_2)
# SSE on compounded returns
sum( (cumret(reference_returns[best.period.2:(best.period.2 - 1 + w)]) - current_cumret)^2 )
## [1] 0.02176564
I have included the binary classification of the most similar period
and a dynamic time warping. The binary classification is the percentage
of days where both compounded cumulative return paths are simultaneously
above or below their common starting value of 1:
sum(x > 1 & y > 1 | x < 1 & y < 1) / length(x).
First, we will check their accuracy.
custom_cor_2 <- function(x, y){
xc <- cumret(x)
yc <- cumret(y)
a <- sum(xc > 1 & yc > 1 | xc < 1 & yc < 1) / length(xc)
return(a)
}
# Reload full series for accuracy check
reference_returns_full <- dailyReturn(GSPC, type = "arithmetic")
best.period.3 <- which.max(
sapply(
seq_len(length(reference_returns_full) - w + 1),
function(i) custom_cor_2(reference_returns_full[i:(i + w - 1)], current_returns)
)
)
# Most similar period
GSPC[best.period.3]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2026-01-02 6878.11 6894.87 6824.31 6858.47 4184120000 6858.47
require(TSdist)
best.period.4 <- which.min(
sapply(
seq_len(length(reference_returns_full) - w + 1),
function(i) TSdist::DTWDistance(cumret(reference_returns_full[i:(i + w - 1)]), current_cumret)
)
)
# Most similar period
GSPC[best.period.4]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2026-01-02 6878.11 6894.87 6824.31 6858.47 4184120000 6858.47
Yup, they both pass the accuracy check. Now let’s apply to the rest
of the series after removing the current observations…
# reference_returns already has current period removed (from `remove` chunk)
best.period.3 <- which.max(
sapply(
seq_len(length(reference_returns) - w + 1),
function(i) custom_cor_2(reference_returns[i:(i + w - 1)], current_returns)
)
)
# Most similar period
GSPC[c(best.period.3, best.period.3 + w)]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1950-05-01 18.22 18.22 18.22 18.22 2390000 18.22
## 1950-09-05 18.68 18.68 18.68 18.68 1250000 18.68
best.period.4 <- which.min(
sapply(
seq_len(length(reference_returns) - w + 1),
function(i) TSdist::DTWDistance(cumret(reference_returns[i:(i + w - 1)]), current_cumret)
)
)
# Most similar period
GSPC[c(best.period.4, best.period.4 + w)]
## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 1971-09-30 97.90 98.97 97.48 98.34 13490000 98.34
## 1972-02-03 104.68 105.43 103.85 104.64 19880000 104.64
par(mfrow = c(2,2))
# View Plot on Both Series
plot(as.zoo(reference[best.period.1:(best.period.1 + w)]), lty = 1, col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("LINEAR CORRELATION \n Most Similar Period \n",
index(reference_returns[best.period.1]), " : ", index(reference_returns[(best.period.1 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current (RHS)"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n", horiz = T)
# View Plot on Both Series
plot(as.zoo(reference[best.period.2:(best.period.2 + w)]), lty = 1, col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("SUM OF SQUARED DIFFERENCES \n Most Similar Period \n",
index(reference_returns[best.period.2]), " : ", index(reference_returns[(best.period.2 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n", horiz = T)
# View Plot on Both Series
plot(as.zoo(reference[best.period.3:(best.period.3 + w)]), lty = 1, col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("BINARY CLASSIFICATION \n Most Similar Period \n",
index(reference_returns[best.period.3]), " : ", index(reference_returns[(best.period.3 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n", horiz = T)
# View Plot on Both Series
plot(as.zoo(reference[best.period.4:(best.period.4 + w)]), lty = 1, col = c("blue"), xlab = "Date", ylab = "Price",
main = paste("DYNAMIC TIME WARPING \n Most Similar Period \n",
index(reference_returns[best.period.4]), " : ", index(reference_returns[(best.period.4 + w)])))
par(new = TRUE)
plot(as.zoo(current), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Reference","Current"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n", horiz = T)
Again, different definitions of similarity will yield different periods of association.
par(mfrow = c(2,2))
future_GSPC_1 <- reference[(best.period.1 + w):(best.period.1 + (2*w))]
plot(future_GSPC_1)
future_GSPC_2 <- reference[(best.period.2 + w):(best.period.2 + (2*w))]
plot(future_GSPC_2)
future_GSPC_3 <- reference[(best.period.3 + w):(best.period.3 + (2*w))]
plot(future_GSPC_3)
future_GSPC_4 <- reference[(best.period.4 + w):(best.period.4 + (2*w))]
plot(future_GSPC_4)
Indexing all four forward paths to 100 at their common start makes directional and magnitude differences directly comparable across methods.
index_to_100 <- function(x) as.numeric(x) / as.numeric(x[1]) * 100
par(mfrow = c(2, 2))
future_paths <- list(future_GSPC_1, future_GSPC_2, future_GSPC_3, future_GSPC_4)
method_names <- c("LINEAR CORRELATION", "SUM OF SQUARED DIFF",
"BINARY CLASSIFICATION", "DYNAMIC TIME WARPING")
ref_periods <- c(best.period.1, best.period.2, best.period.3, best.period.4)
for(j in seq_along(future_paths)){
fp_indexed <- index_to_100(future_paths[[j]])
plot(fp_indexed, type = "l", col = "blue",
xlab = "Trading Days", ylab = "Indexed Price (Start = 100)",
main = paste(method_names[j], "\n Future Path \n",
index(reference_returns[ref_periods[j] + w])))
abline(h = 100, lty = 2, col = "gray50")
}
Comments
I look forward to further discussions and collaboration with those equally as passionate about these issues, and open to embracing alternative solutions. If you found this presentation interesting or useful, please feel free to reach out via e-mail: ovvo.financial.systems@gmail.com
Thanks for your interest!