133 lines
5.3 KiB
Common Lisp
133 lines
5.3 KiB
Common Lisp
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
|
|
|
|
;;; Redistribution and use in source and binary forms, with or without
|
|
;;; modification, are permitted provided that the following conditions
|
|
;;; are met:
|
|
|
|
;;; * Redistributions of source code must retain the above copyright
|
|
;;; notice, this list of conditions and the following disclaimer.
|
|
|
|
;;; * Redistributions in binary form must reproduce the above
|
|
;;; copyright notice, this list of conditions and the following
|
|
;;; disclaimer in the documentation and/or other materials
|
|
;;; provided with the distribution.
|
|
|
|
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
|
|
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
|
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
|
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
|
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
;;;; Util.lisp - small utility functions used across the cl-dates package.
|
|
;;;; E.g., functions to convert symbols for day of week, date convention,
|
|
;;;; etc to strings for printing
|
|
|
|
(in-package :cl-dates)
|
|
|
|
(defun parse-number (string)
|
|
"Returns a number if string is numeric (ignoring surrounding white-space) else NIL"
|
|
(handler-case (values (parse-integer string))
|
|
(parse-error ()
|
|
(multiple-value-bind (integer num-chars) (parse-integer string :junk-allowed t)
|
|
(let ((len (length string)))
|
|
(cond ((or (>= num-chars len)
|
|
(and (= num-chars (1- len))
|
|
(char= (char string num-chars) #\.)))
|
|
integer)
|
|
((char/= (char string num-chars) #\.) nil)
|
|
(t (handler-case
|
|
(multiple-value-bind (fraction frac-chars)
|
|
(parse-integer string :start (1+ num-chars))
|
|
(if (zerop fraction)
|
|
integer
|
|
(coerce (+ integer
|
|
(/ fraction (expt 10 (- frac-chars num-chars 1))))
|
|
'double-float)))
|
|
(parse-error () nil)))))))))
|
|
|
|
(defun leap-year-p (year)
|
|
"True if given year is a leap year"
|
|
(if (zerop (mod year 100))
|
|
(zerop (mod year 400))
|
|
(zerop (mod year 4))))
|
|
|
|
(defun hms->day-fraction (hh mm ss)
|
|
"Return fraction of day for given time counting up from midnight"
|
|
(/ (+ (* hh 3600) (* mm 60) ss) 86400))
|
|
|
|
(defun day-fraction->hms (day-frac)
|
|
"Hour, minute, seconds given day fraction (midnight = 0)"
|
|
(let* ((secs (* day-frac 86400))
|
|
(hh (floor (/ secs 3600))))
|
|
(setf secs (- secs (* hh 3600)))
|
|
(let* ((mm (floor (/ secs 60)))
|
|
(ss (- secs (* mm 60))))
|
|
(values hh mm ss))))
|
|
|
|
(defparameter +weekdays+ '((:monday . ("Mon" "Monday")) (:tuesday . ("Tue" "Tuesday" "Tues"))
|
|
(:wednesday . ("Wed" "Wednesday")) (:thursday . ("Thu" "Thursday" "Thurs"))
|
|
(:friday . ("Fri" "Friday")) (:saturday . ("Sat" "Saturday"))
|
|
(:sunday . ("Sun" "Sunday"))))
|
|
(defun dow->string (dow)
|
|
"String representation of day of week"
|
|
(third (assoc dow +weekdays+)))
|
|
|
|
(defun three-letter-dow (dow)
|
|
"Three letter abbreviation of day of week"
|
|
(second (assoc dow +weekdays+)))
|
|
|
|
(defun str-to-weekday (str)
|
|
"Return weekday given string (full spelling or abbreviation"
|
|
(loop for i from 0 below 7
|
|
do (let ((list (elt +weekdays+ i)))
|
|
(when (member str (cdr list) :test #'string-equal)
|
|
(return-from str-to-weekday (car list))))))
|
|
|
|
(defparameter +months+ '((nil) ("Jan" "January") ("Feb" "February") ("Mar" "March") ("Apr" "April")
|
|
("May" "May") ("Jun" "June") ("Jul" "July") ("Aug" "August")
|
|
("Sep" "September" "Sept") ("Oct" "October") ("Nov" "November")
|
|
("Dec" "December")))
|
|
(defun month->string (mm)
|
|
"Month name as string given month number"
|
|
(second (elt +months+ mm)))
|
|
|
|
(defun three-letter-month (mm)
|
|
"Three letter month abbreviation given month number"
|
|
(car (elt +months+ mm)))
|
|
|
|
(defun str-to-month (str)
|
|
"Month number (1-12) given month name or abbreviation"
|
|
(loop for i from 1 to 12
|
|
do (when (member str (elt +months+ i) :test #'string-equal)
|
|
(return-from str-to-month i))))
|
|
|
|
(defun day-count->string (day-count-convention)
|
|
"Return string description of day count convention"
|
|
(case day-count-convention
|
|
((:actual-actual-fixed :act-act-fixed) "Actual/Actual (Fixed)")
|
|
((:actual-actual :act-act :actual-365 :act-365) "Actual/Actual (ISDA)")
|
|
((:actual-actual-isma :act-act-isma) "Actual/Actual (ISMA)")
|
|
((:actual-actual-afb :act-act-afb) "Actual/Actual (AFB)")
|
|
((:actual-365-l :act-365-l) "Actual/365L")
|
|
((:actual-365-nl :act-365-nl :nl-365 :actual-365-jgb :act-365-jgb) "NL/365")
|
|
((:actual-360 :act-360) "Actual/360")
|
|
((:30a-360 :30-360-isda :30-360-muni :bond-basis :360-360) "30A/360")
|
|
((:30e-360 :30-360-isma) "30E/360")
|
|
(:30e+-360 "30E+/360")
|
|
((:30e-360-isda :30-360-german) "30/360 (German)")
|
|
((:30u-360 :30-360-us) "30/360 (US)")
|
|
(otherwise (concatenate 'string "Unknown day count convention: " (string day-count-convention)))))
|
|
|
|
|
|
(defun eom-rule->string (rule)
|
|
"Return string description of EOM rule"
|
|
(case rule
|
|
(:eom-normal "EOM")
|
|
(:eom-no-leap-day "EOM (No Leap)")
|
|
(otherwise "")))
|