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(Ad(SPY)["::2003"]) 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.

Thanks for reading.

NOTE: I am currently consulting in an analytics capacity in downtown Chicago. However, I am also looking for collaborators that wish to pursue interesting trading ideas. If you feel my skills may be of help to you, let’s talk. You can email me at ilya.kipnis@gmail.com, or find me on my LinkedIn here.

The sumdiffs indicator seems to have some value. When it moves off the pinned 0 or 100 position, he market seems to move in the same direction. Hard to tell at this resolution. So while it might not be giving more general market-health feedback, from a shorter term perspective (monthly) perhaps it’s useful?

Pingback: Distilled News | Data Analytics & R