If a particular prediction comes true, how surprised should we be?
The prediction
The page that sparked my curiosity tells of a prediction made a year ago that the S&P 500 would beat its historic high by the end of 2011. It says that at the point the prediction was made, the level of the index was about 1010.
According to Wikipedia the all-time high close was 1565.15 on 2007 October 09, and the all-time intraday high was 1576.09 on 2007 October 11.
The surprise
So if the prediction actually comes to pass, then how surprised should we be?
To answer that let’s do a simulation using randomly selected daily log returns from the S&P 500. We want to see — over that year and a half period — the probability of the high being higher than the historical high. We can see an estimate of that probability using an R function written for the purpose:
> spx.predtest1()
[1] 0.048493
> spx.predtest1()
[1] 0.048307
So almost a 5% chance of getting a new all-time high. That is done with the data I happened to have hanging about. It starts in 1950.
We can instead use only more recent data. Here is a go with about a decade of data:
> spx.predtest1(rets=tail(spxret, 2500))
[1] 0.063795
> spx.predtest1(rets=tail(spxret, 2500))
[1] 0.064094
This gives on the order of a 6.4% chance of getting a new high.
But wait
I’ve lied to you up until now. Actually there was a get-out-of-jail condition on the prediction. It said:
“If the Index held at or above our proprietary support zone (1000.00- 950.00 region), it would eventually trade to a new historical high within 12 – 18 months (July- December 2011 timeframe)”
So instead of accepting all paths, we need to throw out paths that take us below 950 unless a new high happens first. It’s not hard to write an R function for that:
> spx.predtest2()
[1] 0.1009603
> spx.predtest2()
[1] 0.09969513
With the full set of returns the probability of this scenario is just about 10%.
> spx.predtest2(rets=tail(spxret, 2500))
[1] 0.2560359
> spx.predtest2(rets=tail(spxret, 2500))
[1] 0.2607624
The probability increases to over 25% with a decade of data.
And now
Fair enough for someone to remind the public of their predictions. But perhaps there is selection bias in the reminders (I have no idea if this particular prognosticator has such bias or not).
If we were completely sceptical, then we would take this as a new prediction from now until the end of the year. If we skip the complication of the conditional, we can look at the probability of the S&P hitting an all-time high in the approximately 125 trading days from the beginning of July until the end of the year:
> spx.predtest1(target=log(1577/1320.64), time=125)
[1] 0.141888
> spx.predtest1(target=log(1577/1320.64), time=125)
[1] 0.141285
We get a chance of about 14%.
> spx.predtest1(target=log(1577/1320.64), time=125, rets=tail(spxret, 2500))
[1] 0.197302
> spx.predtest1(target=log(1577/1320.64), time=125, rets=tail(spxret, 2500))
[1] 0.197462
With the returns restricted to the last decade we get almost 20%.
Figures 1 and 2 each show 100 random paths for these cases.
Figure 1: 100 random paths for July through December in 2011 using 6 decades of data.
Figure 2: 100 random paths for July through December in 2011 using the most recent decade of data.
Analysis weaknesses
We get substantially different answers depending on if we use one or six decades of data. That is because volatility changes over time. A better approach would be to use a garch model to simulate the returns where the simulation starts with the volatility state of July 2010 (or July 2011 for the last analysis).
Appendix R
Except for the axis labels, the two figures were made by:
> rmat6 <- matrix(sample(spxret, 12500, replace=TRUE), nrow=125)
> lmat6 <- 1320.64 * exp(apply(rmat6, 2, cumsum))
> matplot(lmat6, type='l')
> abline(h=1577)
>
> rmat1 <- matrix(sample(tail(spxret, 2500), 12500, replace=TRUE), nrow=125)
> lmat1 <- 1320.64 * exp(apply(rmat1, 2, cumsum))
> matplot(lmat1, type='l')
> abline(h=1577)
The definition of spx.predtest1 is:
function (rets=spxret, target=log(1577/1010), time=370, trials=1e6)
{
hits <- 0
for(i in 1:trials) {
this.ret <- max(cumsum(sample(rets, time, replace=TRUE)))
if(this.ret > target) hits <- hits + 1
}
hits/trials
}
The definition of spx.predtest2 is:
function (rets=spxret, target=log(1577/1010), low=log(950/1010), time=370, trials=1e5)
{
hits <- 0
allowed <- 0
both <- 0
for(i in 1:trials) {
this.ret <- cumsum(sample(rets, time, replace=TRUE))
retran <- range(this.ret)
if(retran[1] > low) {
allowed <- allowed + 1
if(retran[2] > target) hits <- hits + 1
} else if(retran[2] > target) {
both <- both + 1
# is high before low?
if(min(which(this.ret > target)) < min(which(this.ret < low))) {
allowed <- allowed + 1
hits <- hits + 1
}
}
}
# c(hits=hits, allowed=allowed, both=both, prob=hits / allowed)
hits / allowed
}
Hello dear Pat,
Might you consider using
library(colorspace)
rainbow_hcl
For the next time you make such a plot?
🙂
Cheers,
Tal
Tal,
Thanks — I’ll have a play some time.