# A First Attempt At Applying Ensemble Filters

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

This post will outline a first failed attempt at applying the ensemble filter methodology to try and come up with a weighting process on SPY that should theoretically be a gradual process to shift from conviction between a bull market, a bear market, and anywhere in between. This is a follow-up post to this blog post.

So, my thinking went like this: in a bull market, as one transitions from responsiveness to smoothness, responsive filters should be higher than smooth filters, and vice versa, as there’s generally a trade-off between the two. In fact, in my particular formulation, the quantity of the square root of the EMA of squared returns punishes any deviation from a flat line altogether (although inspired by Basel’s measure of volatility, which is the square root of the 18-day EMA of squared returns), while the responsiveness quantity punishes any deviation from the time series of the realized prices. Whether these are the two best measures of smoothness and responsiveness is a topic I’d certainly appreciate feedback on.

In any case, an idea I had on the top of my head was that in addition to having a way of weighing multiple filters by their responsiveness (deviation from price action) and smoothness (deviation from a flat line), that by taking the sums of the sign of the difference between one filter and its neighbor on the responsiveness to smoothness spectrum, provided enough ensemble filters (say, 101, so there are 100 differences), one would obtain a way to move from full conviction of a bull market, to a bear market, to anything in between, and have this be a smooth process that doesn’t have schizophrenic swings of conviction.

Here’s the code to do this on SPY from inception to 2003:

require(TTR)
require(quantmod)
require(PerformanceAnalytics)

getSymbols('SPY', from = '1990-01-01')

smas <- list()
for(i in 2:250) {
smas[[i]] <- SMA(Ad(SPY), n = i)
}
smas <- do.call(cbind, smas)

xtsApply <- function(x, FUN, n, ...) {
out <- xts(apply(x, 2, FUN, n = n, ...), order.by=index(x))
return(out)
}

sumIsNa <- function(x){
return(sum(is.na(x)))
}

ensembleFilter <- function(data, filters, n = 20, conviction = 1, emphasisSmooth = .51) {

# smoothness error
filtRets <- Return.calculate(filters)
sqFiltRets <- filtRets * filtRets * 100 #multiply by 100 to prevent instability
smoothnessError <- sqrt(xtsApply(sqFiltRets, EMA, n = n))

# responsiveness error
repX <- xts(matrix(data, nrow = nrow(filters), ncol=ncol(filters)),
order.by = index(filters))
dataFilterReturns <- repX/filters - 1
sqDataFilterQuotient <- dataFilterReturns * dataFilterReturns * 100 #multiply by 100 to prevent instability
responseError <- sqrt(xtsApply(sqDataFilterQuotient, EMA, n = n))

# place smoothness and responsiveness errors on same notional quantities
meanSmoothError <- rowMeans(smoothnessError)
meanResponseError <- rowMeans(responseError)
ratio <- meanSmoothError/meanResponseError
ratio <- xts(matrix(ratio, nrow=nrow(filters), ncol=ncol(filters)),
order.by=index(filters))
responseError <- responseError * ratio

# for each term in emphasisSmooth, create a separate filter
ensembleFilters <- list()
for(term in emphasisSmooth) {

# compute total errors, raise them to a conviction power, find the normalized inverse
totalError <- smoothnessError * term + responseError * (1-term)
totalError <- totalError ^ conviction
invTotalError <- 1/totalError
normInvError <- invTotalError/rowSums(invTotalError)

# ensemble filter is the sum of candidate filters in proportion
# to the inverse of their total error
tmp <- xts(rowSums(filters * normInvError), order.by=index(data))

#NA out time in which one or more filters were NA
initialNAs <- apply(filters, 1, sumIsNa)
tmp[initialNAs > 0] <- NA
tmpName <- paste("emphasisSmooth", term, sep="_")
colnames(tmp) <- tmpName
ensembleFilters[[tmpName]] <- tmp
}

# compile the filters
out <- do.call(cbind, ensembleFilters)
return(out)
}

t1 <- Sys.time()
filts <- ensembleFilter(Ad(SPY), smas, n = 20, conviction = 2, emphasisSmooth = seq(0, 1, by=.01))
t2 <- Sys.time()

par(mfrow=c(3,1))
filtDiffs <- sign(filts[,1:100] - filts[,2:101])
sumDiffs <- xts(rowSums(filtDiffs), order.by=index(filtDiffs))

plot(sumDiffs["::2003"])
plot(diff(sumDiffs["::2003"]))


And here’s the very underwhelming result:

Essentially, while I expected to see changes in conviction of maybe 20 at most, instead, my indicator of sum of sign differences did exactly as I had hoped it wouldn’t, which is to be a very binary sort of mechanic. My intuition was that between an “obvious bull market” and an “obvious bear market” that some differences would be positive, some negative, and that they’d net each other out, and the conviction would be zero. Furthermore, that while any individual crossover is binary, all one hundred signs being either positive or negative would be a more gradual process. Apparently, this was not the case. To continue this train of thought later, one thing to try would be an all-pairs sign difference. Certainly, I don’t feel like giving up on this idea at this point, and, as usual, feedback would always be appreciated.