Silver Is A Weighted Coin

[This article was first published on Milk Trader, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

editorial note: there is an error in the code explained below the code. 

When you flip a quarter, you normally assume the coin is fair and that there is a 50% chance of getting either heads or tails. Option pricing assumes the world of trading is filled with fair coins. In other words, there is basically an equal chance that the option’s underlying will close 10% higher in 24 days or 10% lower in that time frame. This assumption has always puzzled me. So I constructed a simple algorithm in R to check what the history of coin-flipping in the silver ETF SLV shows.

If you slice up an options probability graph with a +/- 10% threshold, you’ll get the implied probability of such an event happening within a prescribed time frame. Today, SLV options have priced in a 16.5% chance that in 24 days, SLV will be 10% higher. And, unsurprisingly, options have priced in a 16.5% chance that in 24 days that SLV will be 10% lower. Higher, lower, what’s the difference? We’re playing with fair coins here.

If you look back 1,040 trading days, you get a different distribution. How many times has the event happened that SLV closed 10% higher than it did 24 days ago? That would be 81 days. How many times did it close 10% lower than it did 24 days ago? Uh, that’s only 39 days. That doesn’t seem fair to me.

The R code, in 36 double-spaced lines:

lemon_lime <- function(sym="SLV", expiry=24, pct=.1){
ticker <- getSymbols(sym, auto.assign=FALSE)                             
ticker <- ticker[,6]       

win  <- 0   
lose <- 0                                      
for(i in expiry:NROW(ticker))                                                                                
if(as.numeric(ticker[i]) > (as.numeric(ticker[i-(expiry-1)])*pct + as.numeric(ticker[i-(expiry-1)])) )                                            
win <- win + 1                                                              
winners <- win/(NROW(ticker)-expiry)                                                                                                      
for(i in expiry:NROW(ticker))                                                                                
if(as.numeric(ticker[i]) < (as.numeric(ticker[i-(expiry-1)]) - as.numeric(ticker[i-(expiry-1)])*pct) )                                            
lose <- lose + 1                                                              
losers <- lose/(NROW(ticker)-expiry)  

weighted <- win/(win+lose)                
cat(   " Trading Days:               ", NROW(ticker)-expiry, "\n",
       "Winners:                    ", win, "\n",
       "Percentage of winning days: ", round(winners*100, digits=2), "\n",
       "Losers:                     ", lose, "\n",
       "Percentage of losing days:  ", round(losers*100, digits=2), "\n",
       "Weighted Coin Towards Winners? ", round(weighted, digits=2), "\n")                                   

Ah, the perils of quant analysis. I have changed one digit in the code above to account for the obnoxious stock split in 2008. My change was to line 7:
ticker <- ticker[,6]  # previously ticker <- ticker[,4]

It didn't completely change the notion I was exploring so I decided not to change the entire blog text. The new results though show a ratio of 261:97 in favor of the upside excursions of the 10% limit, versus 81:39.

To leave a comment for the author, please follow the link and comment on their blog: Milk Trader. offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)