Intro

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 returnscumprod(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.

Load Required Packages in R

#require(devtools); install_github('OVVO-Financial/NNS', ref = "NNS-Beta-Version")
library(NNS)
library(lubridate)
library(data.table)
library(quantmod)
library(zoo)

Get data

We will load the data for the S&P 500 index from 1950. This will create the variable GSPC. Further, we will create:

  1. A compounded cumulative return dataset: current_cumret & windows derived from reference_returns
  2. A dataset of closing prices: current & reference
  3. A window length: w
# 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)

Which Calendar Year is Most Similar?

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)

Finding the Most Similar Period (Non-Calendar Year)

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.

Use any length of latest returns

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)

Remove current period, also a verification of similarity!

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)

Method 1: Linear Correlation of Compounded Returns

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

Method 2: Sum-of-Squared Differences of Compounded Returns

The second method minimises the sum of squared differences between compounded cumulative return paths.

Accuracy Check

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!

Apply Sum-of-Squared Differences to Compounded Returns

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

Comments

  • Evaluating each of the methods most similar compounded cumulative return paths via the minimum sum-of-squared errors reveals Method #2 has the best fit.
  • We have not ventured far into the definition of \(similar\). We have demonstrated 2 methods of determining similarity, and unfortunately, the future outcomes are substantially varied based on the definition and evaluation criteria.
  • Based on prevailing evaluation criteria, both future outcomes are significantly different from current levels for the next 88 day period
# View Plot on Both Series
plot(as.zoo(future_GSPC_1), col = c("blue"), xlab = "Date", ylab = "Price", main = "Future Performance for Similar Periods")
par(new = TRUE)
plot(as.zoo(future_GSPC_2), screens = 1, lwd = 3, col = "red", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(4)
mtext("Price", side = 4, line = 3)
legend("topleft", c("Future via Method #1 (LHS)","Future via Method #2 (RHS)"), lty = c(1,1), col = c("blue","red"), cex = 0.5, bty = "n")

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:

Thanks for your interest!

Other Similarity Measures

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.

Future Paths

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)

Indexed Future Paths

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")
}