aland/cl-dates
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added schedule generation function

Browse source
This commit is contained in:
Sudhir Shenoy 2017-08-03 22:59:14 +09:00
parent 00c15c7fd1
commit 3dedec1798
1 changed files with 169 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

173
bus-date-arith.lisp
View file

@ -37,7 +37,7 @@ that date is returned"
(let ((year (date->ymd date)))
(loop for dt = (ymd->date year 1 1) then (1+ dt)
until (date> dt date)
counting (business-day-p date calendar))))
counting (business-day-p dt calendar))))
(defun add-days-return-bus-day (date calendar days)
"Add days to date and if the result is not a business day,
@ -55,7 +55,7 @@ advance the date to a business day in the same direction"
"Return the business day immediately before date"
(add-days-return-bus-day date calendar -1))
(defun add-business-days (date calendar days)
(defun add-workdays (date calendar days)
(let ((fn (if (< days 0) #'prev-workday #'next-workday)))
(loop for i from 1 upto (abs days)
do (setf date (funcall fn date calendar))
@ -92,12 +92,13 @@ is included only when it is a business day"
(defun adjust-date (date calendar &optional (roll-convention :modified-following))
"Move date if it falls on a holiday or weekend according to roll convention.
Roll convention can be one of-
If the roll convention is NIL or the date is a business day, the date is returned.
Otherwise, the date is moved as per the roll convention:
:preceding - date is moved to the previous business day
:following - date is moved to the next business day
:modified-following - date is moved to the next business day unless that falls in
the next month in which case it is moved to the previous day"
(cond ((business-day-p date calendar) date)
(cond ((or (null roll-convention) (business-day-p date calendar)) date)
((eq roll-convention :preceding) (prev-workday date calendar))
((eq roll-convention :following) (next-workday date calendar))
((eq roll-convention :modified-following)
@ -110,3 +111,167 @@ the next month in which case it is moved to the previous day"
dt
(prev-workday date calendar))))))
(t (error "Unknown roll convention ~s" roll-convention))))
(defun generate-schedule (start-date maturity period calendar
&key (rule :normal-back)
(roll-convention :modified-following)
(maturity-roll :following)
(eom-rule :nil)
(first-coupon-date nil)
(penultimate-coupon-date nil))
"Generate a list of coupon dates between start-date and maturity (both inclusive).
If paramters supplied are invalid, NIL and an error string are returned as two values.
Parameters:
start-date - Effective date (may be passed as nil if rule is :normal-back)
maturity - Termination date
period - Coupon period in months. If period is 0, no intermediate coupon dates are generated.
rule - The date generation rule (by default, this is backwards from maturity date)
:normal-back - Roll on maturity or penultimate coupon backawards (default)
:normal-front - Roll on start date or first coupon forwards
:imm-dates - All coupon dates will fall on IMM dates (3rd Wednesday of month)
:cds-dates - Coupons are generated on CDS dates (20th of Mar/Jun/Sep/Dec). If start
date or maturity are not CDS dates, the CDS date before/after is included.
:zero - Zero coupon (only start date and maturity are returned)
roll-convention - Convention for adjusting coupon dates that fall on non-business days
(:modified-following by default)
maturity-roll - Roll convention for maturity date specifically (NIL by default)
eom-rule - Whether dates should fall on month-ends when roll date is on a month-end (NIL by default)
first-coupon-date - Date of first coupon (for specifying stubs at front)
penultimate-coupon-date - Date of next to last coupon (for specifying stubs at the end)"
;; Interpolate start date if not specified and generating dates backward
(when (null start-date)
(unless (and (null first-coupon-date) (eq rule :normal-back))
(return-from generate-schedule
(values nil "Start date cannot be null unless normal backward geeneration with no first coupon date")))
(let ((term-date (or penultimate-coupon-date maturity)))
(add-years term-date (- (1+ (/ (date- term-date (todays-date)) 366))))))
;; Check all parameters for sanity
(unless (member rule '(:normal-front :normal-back :imm-dates :cds-dates :zero))
(return-from generate-schedule (values nil (format nil "Unknown rule ~s" rule))))
(unless (and (date< start-date maturity) (integerp period) (>= period 0))
(return-from generate-schedule
(values nil "Maturity must be after start date; Period must be an integer >=0")))
(cond ((eq rule :cds-dates)
(unless (and (null first-coupon-date) (null penultimate-coupon-date) (null eom-rule))
(return-from generate-schedule
(values nil "Cannot have first/last coupon dates or EOM rule for CDS schedule"))))
((eq rule :imm-dates)
(unless (or (null first-coupon-date) (imm-date-p first-coupon-date))
(values nil "First coupon date must be an IMM date for IMM schedule"))
(unless (or (null penultimate-coupon-date) (imm-date-p penultimate-coupon-date))
(values nil "Last coupon date must be an IMM date for IMM schedule"))
(unless (null eom-rule)
(values nil "IMM schedule cannot have EOM rule")))
((or (eq rule :normal-front) (eq rule :normal-back))
(unless (or (null first-coupon-date)
(date< start-date first-coupon-date maturity))
(values nil "First coupon date must be between start date and maturity"))
(unless (or (null penultimate-coupon-date)
(date< start-date penultimate-coupon-date maturity))
(values nil "Last coupon date must be between start date and maturity"))
(when (and first-coupon-date penultimate-coupon-date)
(unless (date< first-coupon-date penultimate-coupon-date)
(values nil "Last coupon date must be after first coupon date")))))
;; Generate a series of unadjusted dates
(let (cpn-dates)
(cond ((or (eq rule :zero) (= period 0)) (setf cpn-dates (list start-date maturity)))
((or (eq rule :normal-front) (eq rule :normal-back))
;; Normal swaps / bond schedule - usually backwards from maturity
(let ((first-date (if (eq rule :normal-back) maturity start-date))
(roll-date (if (eq rule :normal-back)
(or penultimate-coupon-date maturity)
(or first-coupon-date start-date)))
(last-cpn-date (if (eq rule :normal-back)
(or first-coupon-date start-date)
(or penultimate-coupon-date maturity)))
(last-date (if (eq rule :normal-back) start-date maturity))
(sign-fn (if (eq rule :normal-back) #'- #'identity))
(term-cond (if (eq rule :normal-back) #'date< #'date>)))
(push first-date cpn-dates)
(when (date/= first-date roll-date)
(push roll-date cpn-dates))
(loop for i = 1 then (1+ i)
for dt = (add-months roll-date (* i (funcall sign-fn period))
:eom-rule eom-rule)
until (funcall term-cond dt last-cpn-date)
do (push dt cpn-dates))
(unless (date= (adjust-date (car cpn-dates) calendar roll-convention)
(adjust-date last-cpn-date calendar roll-convention))
(push last-cpn-date cpn-dates))
(unless (date= (adjust-date (car cpn-dates) calendar roll-convention)
(adjust-date last-date calendar roll-convention))
(push last-date cpn-dates))
;; dates should be in ascending order
(when (eq rule :normal-front)
(setf cpn-dates (nreverse cpn-dates)))
(when (and eom-rule (date>= roll-date (last-workday-of-month roll-date calendar)))
;; Month-end rolls - move all dates to month end except start date
;; Maturtity date is moved only if maturity-roll is specified as non-null
(setf cpn-dates (mapcar (lambda(dt) (cond ((date= dt start-date) dt)
((date= dt maturity)
(if (null maturity-roll)
dt
(last-workday-of-month dt calendar)))
((null roll-convention)
(last-day-of-month dt))
(t (last-workday-of-month dt calendar))))
cpn-dates))
;; Remove any dates that are outside start-date to maturity range after EOM adj
(let ((last-date (car (last cpn-dates))))
(setf cpn-dates (remove-if (lambda(dt) (date> dt last-date)) cpn-dates
:from-end t :count 1)))
(when (and (>= (length cpn-dates) 2) (date< (second cpn-dates) (car cpn-dates)))
(setf (second cpn-dates) (car cpn-dates)
cpn-dates (cdr cpn-dates))))))
((eq rule :cds-dates)
(labels ((cds-date (date dir)
"Return previous/next CDS date depending on sign of dir"
(multiple-value-bind (yy mm dd) (date->ymd date)
(declare (ignore dd))
(let ((result-date (ymd->date yy mm 20)))
(if (and (minusp dir) (date> result-date date))
(setf result-date (add-months result-date -1))
(if (and (plusp dir) (date< result-date date))
(setf result-date (add-months result-date +1))))
(multiple-value-bind (yy mm dd) (date->ymd result-date)
(declare (ignore yy dd))
(when (/= 0 (mod mm 3))
(let ((mths-incr (if (minusp dir) (- (mod mm 3)) (- 3 (mod mm 3)))))
(setf result-date (add-months result-date mths-incr)))))
result-date))))
;; Closest CDS date prior to start date if it isn't one
(push (cds-date start-date -1) cpn-dates)
;; roll on the CDS dates to maturity
(loop for dt = (cds-date (car cpn-dates) +1) then (cds-date (1+ dt) +1)
until (date> dt maturity)
do (push dt cpn-dates))
(unless (date= (adjust-date (car cpn-dates) calendar roll-convention)
(adjust-date maturity calendar roll-convention))
;; maturity was not a CDS date - include next CDS date
(push (cds-date maturity +1) cpn-dates))
(setf cpn-dates (nreverse cpn-dates))))
((eq rule :imm-dates)
(let ((roll-date (or first-coupon-date start-date))
(max-date (or penultimate-coupon-date maturity)))
(push start-date cpn-dates)
(when first-coupon-date
(push first-coupon-date cpn-dates))
(loop for i = 1 then (1+ i)
for dt = (add-months roll-date (* i period))
until (date> dt max-date)
do (push (nth-day-of-week dt :wednesday 3) cpn-dates))
(unless (date= (car cpn-dates) max-date)
(push max-date cpn-dates))
(push maturity cpn-dates) ; Possibly duplicate date
(setf cpn-dates (nreverse cpn-dates)))))
;; Ensure all dates fall on business days
(setf cpn-dates (mapcar (lambda(dt) (if (date= dt maturity)
(adjust-date dt calendar maturity-roll)
(adjust-date dt calendar roll-convention)))
cpn-dates))
;; Remove any duplicate dates and return (list is in ascending order of dates)
(remove-duplicates cpn-dates)))