R/optionsExp.R

In joshuaulrich/greeks: Financial Option Pricing And Manipulation Tools

# constant holding all last day of trading Dates for OCC
# option contracts.  
#
# optionsExp() returns the Saturday of exiration as Date
# nextExp(n=1) returns the nearest 'n' expirations 'from' as Date

.OCC <- structure(c(7323, 7351, 7379, 7414, 7442, 7470, 7505, 7533, 7568, 
7596, 7624, 7659, 7687, 7715, 7743, 7778, 7806, 7841, 7869, 7897, 
7932, 7960, 7988, 8023, 8051, 8086, 8114, 8142, 8170, 8205, 8233, 
8268, 8296, 8324, 8359, 8387, 8415, 8450, 8478, 8506, 8541, 8569, 
8597, 8632, 8660, 8688, 8723, 8751, 8786, 8814, 8842, 8870, 8905, 
8933, 8961, 8996, 9024, 9059, 9087, 9115, 9150, 9178, 9206, 9241, 
9269, 9297, 9332, 9360, 9388, 9423, 9451, 9479, 9514, 9542, 9570, 
9605, 9633, 9668, 9696, 9724, 9759, 9787, 9815, 9850, 9878, 9913, 
9941, 9969, 9997, 10032, 10060, 10088, 10123, 10151, 10186, 10214, 
10242, 10277, 10305, 10333, 10361, 10396, 10424, 10459, 10487, 
10515, 10550, 10578, 10606, 10641, 10669, 10697, 10732, 10760, 
10788, 10823, 10851, 10879, 10914, 10942, 10977, 11005, 11033, 
11068, 11096, 11124, 11159, 11187, 11215, 11250, 11278, 11306, 
11341, 11369, 11397, 11432, 11460, 11488, 11523, 11551, 11586, 
11614, 11642, 11677, 11705, 11733, 11761, 11796, 11824, 11859, 
11887, 11915, 11950, 11978, 12006, 12041, 12069, 12104, 12132, 
12159, 12188, 12223, 12251, 12279, 12314, 12342, 12377, 12405, 
12433, 12468, 12496, 12524, 12559, 12587, 12615, 12650, 12678, 
12706, 12741, 12769, 12804, 12832, 12860, 12888, 12923, 12951, 
12979, 13014, 13042, 13077, 13105, 13133, 13168, 13196, 13224, 
13259, 13287, 13315, 13350, 13378, 13406, 13441, 13469, 13497, 
13532, 13560, 13588, 13623, 13651, 13679, 13714, 13742, 13777, 
13805, 13833, 13868, 13896, 13924, 13958, 13987, 14015, 14050, 
14078, 14106, 14141, 14169, 14204, 14232, 14260, 14295, 14323, 
14351, 14379, 14414, 14442, 14477, 14505, 14533, 14568, 14596, 
14624, 14659, 14687, 14715, 14750, 14778, 14806, 14841, 14869, 
14897, 14932, 14960, 14995, 15023, 15051, 15079, 15114, 15142, 
15170, 15205, 15233, 15268, 15296, 15324, 
#2012
15359, 15387, 15415, 15450, 15478, 15506, 15541, 15569, 15604, 15632, 15660, 15695,
#2013
15723,15751,15779,15814,15842,15877,15905,15933,15968,15996,16024,16059,
#2014
16087,16122,16150,16178,16206,16241,16269,16297,16332,16360,16395,16423,
#2015
16451,16486,16514,16542,16570,16605,16633,16668,16696,16724,16759,16787,
#2016
16815,16850,16878,16906,16941,16969,16997,17032,17060,17095,17123,17151,
#2017
17186,17214,17242,17277,17305,17333,17368,17396,17424,17459,17487,17515,
#2018
17550,17578,17606,17641,17669,17697,17732,17760,17795,17823,17851,17886,
#2019
17914,17942,17970,18005,18033,18068,18096,18124,18159,18187,18215,18250,
#2020
18278,18313,18341,18369,18397,18432,18460,18495,18523,18551,18586,18614,
#2021
18642,18677,18705,18733,18768,18796,18824,18859,18887,18915,18950,18978
), 
class = "Date")

optionsExp <- function(expiration=TRUE, cycle="monthly", calendar=.OCC) {
  if( cycle != "monthly")
    stop("unsupported 'cycle'")

  if( expiration)
    calendar + 1 # expiration date (as opposed to last trading)
  else calendar
}

nextExp <- function (n = 1, 
                     mindays=0, 
                     from = Sys.Date(), 
                     cycle = "monthly",
                     #calendar = "options",
                     calendar = .OCC,
                     expiration = TRUE) 
{
    #exp <- switch(calendar,
    #              "options"=optionsExp(expiration, cycle)
    #             )
#    if( calendar == "options")
#      exp <- optionsExp(expiration)
#    else stop("only calendar='options' supported")

    #exp[which((as.Date(exp) - as.Date(from)) > mindays)[n]]
    calendar[which((as.Date(calendar) - as.Date(from)) > mindays)[n]]
}