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))) (let ((year (date->ymd date)))
(loop for dt = (ymd->date year 1 1) then (1+ dt) (loop for dt = (ymd->date year 1 1) then (1+ dt)
until (date> dt date) 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) (defun add-days-return-bus-day (date calendar days)
"Add days to date and if the result is not a business day, "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" "Return the business day immediately before date"
(add-days-return-bus-day date calendar -1)) (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))) (let ((fn (if (< days 0) #'prev-workday #'next-workday)))
(loop for i from 1 upto (abs days) (loop for i from 1 upto (abs days)
do (setf date (funcall fn date calendar)) 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)) (defun adjust-date (date calendar &optional (roll-convention :modified-following))
"Move date if it falls on a holiday or weekend according to roll convention. "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 :preceding - date is moved to the previous business day
:following - date is moved to the next 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 :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" 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 :preceding) (prev-workday date calendar))
((eq roll-convention :following) (next-workday date calendar)) ((eq roll-convention :following) (next-workday date calendar))
((eq roll-convention :modified-following) ((eq roll-convention :modified-following)
@ -110,3 +111,167 @@ the next month in which case it is moved to the previous day"
dt dt
(prev-workday date calendar)))))) (prev-workday date calendar))))))
(t (error "Unknown roll convention ~s" roll-convention)))) (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)))