From 9d06952341457f9110e4dead60ed1a3969fd4312 Mon Sep 17 00:00:00 2001 From: Sudhir Shenoy Date: Sat, 22 Jul 2017 22:03:53 +0900 Subject: [PATCH] Added comments and documentation strings --- calendar.lisp | 74 +++++++++++++++++++++++++++++++++++++++++++------ date-arith.lisp | 6 ++++ dates.lisp | 4 +++ packages.lisp | 2 ++ parse-date.lisp | 32 ++++++++++----------- print-date.lisp | 3 ++ timezones.lisp | 2 ++ util.lisp | 4 +++ 8 files changed, 103 insertions(+), 24 deletions(-) diff --git a/calendar.lisp b/calendar.lisp index a36f0e7..6c19004 100644 --- a/calendar.lisp +++ b/calendar.lisp @@ -33,7 +33,10 @@ (defparameter +known-centres+ ;; Centre Hol function discriminant - (list :Eurex (list #'german-holidays :Eurex) + (list :Australia (list #'aus-holidays :settlement) + :Sydney (list #'aus-holidays :settlement) + :AUD (list #'aus-holidays :settlement) + :Eurex (list #'german-holidays :Eurex) :Frankfurt (list #'german-holidays :Eurex) :Euwax (list #'german-holidays :Euwax) :Stuttgart (list #'german-holidays :Euwax) @@ -57,25 +60,59 @@ :UST (list #'us-holidays :bonds) :US-Bond (list #'us-holidays :bonds))) -;; base class - no functionality (null calendar) +;; base class - no holidays other than weekends (defclass calendar () ((name :initarg :name :accessor name) (weekend :initarg :weekend :accessor weekend))) -(defclass calendar-single (calendar) - ((centre :initarg :centre :accessor centre) - (holidays :initarg :holidays :accessor holidays) - (holidays-min-year :accessor holidays-min-year) - (holidays-max-year :accessor holidays-max-year))) +(defmethod print-object ((cal calendar) stream) + (print-unreadable-object (cal stream :type t) + (format stream "Name: ~a; Weekend: ~a; No holidays defined" (name cal) (weekend cal)))) +;; The main class - holds holidays corresponding to a single location / trading centre +;; Holidays are lazily loaded as and when required +(defclass calendar-single (calendar) + ((centre :initarg :centre :accessor centre) ; trading centre + (holidays :initarg :holidays :accessor holidays) ; hash table with dates as keys + (holidays-min-year :accessor holidays-min-year) ; earliest year for which hols are loaded + (holidays-max-year :accessor holidays-max-year))) ; last year for which hols are loaded + +(defmethod print-object ((cal calendar-single) stream) + (print-unreadable-object (cal stream :type t) + (format stream "Name: ~a (Centre: ~a); Weekend: ~a; Holidays for ~d-~d" + (name cal) (centre cal) (weekend cal) + (holidays-min-year cal) (holidays-max-year cal)))) + +;; Container for multiple calendars +;; A date is deemed to be a holiday if it is a holiday in any of the contained calendars (defclass calendar-union (calendar) ((calendars :initarg :calendars :accessor calendars))) ; list of calendars +(defmethod print-object ((cal calendar-union) stream) + (print-unreadable-object (cal stream :type t) + (format stream "Name: ~a; ~a" + (name cal) (calendars cal)))) + (defun make-calendar (centres &key (name nil) (weekend (copy-list +default-weekend+)) (holidays nil) (base-year 0)) + "Create a new holiday calendar. Holidays are populated from a holiday computation +function (if available) and holidays explicitly specified (if any). + +The 'centres' parameter may be + a keyword - an object of type calendar-single will be returned + a list of keywords - an object of type calendar-union is returned, each contained calendar + will be of type calendar-single + any other object - an object of type calendar will be returned. +The keyword parameters are: +name - a name used when printing the calendar (not used by any code) +weekend - the days comprising the weekend (Sat/Sun by default) +holidays - a list of dates that are holidays. This is useful when special holidays are declared + or when there is no function available to generate holidays. +base-year - Year around which holidays should be generated initially (current year if not specified). + Holidays are generated from base year - 2 to base year + 3." (typecase centres (keyword (multiple-value-bind (hols from-year to-year) (get-holiday-hash centres base-year) - (let ((cal (make-instance 'calendar-single :name name :centre :centres + (let ((cal (make-instance 'calendar-single :name name :centre centres :weekend weekend :holidays hols))) (setf (holidays-min-year cal) from-year (holidays-max-year cal) to-year) @@ -105,12 +142,16 @@ collect (car x))) (defun get-holidays-for-centre (centre year) + "Return a list of holidays for the given centre and year. NIL is returned if +there is no available function to generate holidays" (let ((spec (getf +known-centres+ centre))) (if spec (funcall (first spec) year :which (second spec)) nil))) (defun get-holiday-hash (centre base-year) + "Return a hash table with holidays as keys. Holidays are generated from base=year - 2 +to base-year + 3." (when (or (not (integerp base-year)) (<= base-year 1950)) (setf base-year (date->ymd (todays-date)))) (let* ((from-year (- base-year 2)) @@ -124,18 +165,24 @@ (values hash from-year to-year))) (defmethod has-holidays-for-year ((cal calendar) (year integer)) + "Have holidays been generated for the current year? Always true since this +class does not store holidays" t) (defmethod has-holidays-for-year ((cal calendar-single) (year integer)) + "Have holidays been generated for the current year?" (<= (holidays-min-year cal) year (holidays-max-year cal))) (defmethod has-holidays-for-year ((cal calendar-union) (year integer)) + "Have holidays been generated for the current year? Check every sub-calendar" (every #'identity (mapcar (lambda(x) (has-holidays-for-year x year)) (calendars cal)))) (defmethod update-calendar ((cal calendar) (year integer)) cal) (defmethod update-calendar ((cal calendar-single) (year integer)) + "Extend generated holidays to include given year. All intervening years +are also generated so that the range of years is continuous" (let ((from-year (min (- year 2) (1+ (holidays-max-year cal)))) (to-year (max (+ year 3) (1- (holidays-min-year cal))))) (loop for yy from from-year upto to-year @@ -149,44 +196,55 @@ cal) (defmethod update-calendar ((cal calendar-union) (year integer)) + "Extend generated holidays to include given year in all sub-calendars" (dolist (c (calendars cal)) (update-calendar c year)) cal) (defmethod weekend-p (date (weekend-days list)) + "Return true if day of week of the given date is on a weekend" (member (day-of-week date) weekend-days)) (defmethod weekend-p (date (cal calendar)) + "Return true if day of week of the given date is on a weekend" (weekend-p date (weekend cal))) (defmethod weekday-p (date (weekend-days list)) + "Return true if day of week of the given date is not on a weekend" (not (weekend-p date weekend-days))) (defmethod weekday-p (date (cal calendar)) + "Return true if day of week of the given date is not on a weekend" (weekday-p date (weekend cal))) (defmethod holiday-p (date (cal calendar)) + "True if date is a holiday in this calendar" (declare (ignore date cal)) nil) (defmethod holiday-p (date (cal calendar-single)) + "True if date is a holiday in this calendar" (let ((year (date->ymd date))) (unless (has-holidays-for-year cal year) (update-calendar cal year))) (not (null (gethash (jday-number date) (holidays cal))))) (defmethod holiday-p (date (cal calendar-union)) + "True if date is a holiday in any contained calendar" (some #'identity (lambda (cal) (holiday-p date cal)) (calendars cal))) (defmethod business-day-p (date (cal calendar)) + "True if date is not a holiday or weekend in the given calendar" (and (weekday-p date cal) (not (holiday-p date cal)))) (defmethod add-holiday ((cal calendar-single) date) + "Mark given date as a holiday in the calendar" (let ((year (date->ymd date))) (unless (<= (holidays-min-year cal) year (holidays-max-year cal)) (update-calendar cal year))) (setf (gethash (jday-number date) (holidays cal)) 2)) (defmethod remove-holiday ((cal calendar-single) date) + "Remove given date from list of holidays in the calendar" (remhash (jday-number date) (holidays cal))) diff --git a/date-arith.lisp b/date-arith.lisp index 0d43d47..0ea49f2 100644 --- a/date-arith.lisp +++ b/date-arith.lisp @@ -24,6 +24,12 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; Date-Arith.lisp - Functions to compare dates, add days or months to dates +;;;; and calculate the number of days or years between two dates. +;;;; The day convention may be specified when calculating date differences or +;;;; advancing dates by months - different results may be returned depending +;;;; on the convention used. + (in-package :cl-dates) ;; Date comparisons - strip off time component diff --git a/dates.lisp b/dates.lisp index 48f13cc..6b8afc6 100644 --- a/dates.lisp +++ b/dates.lisp @@ -24,6 +24,10 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; Dates.lisp - basic date routines to convert from Gregorian dates to Julian dates +;;;; and vice versa. Also contains functions to calculate astronomical dates such as +;;;; Easter, the equinozes, etc. + (in-package :cl-dates) (defun jday-number (date) diff --git a/packages.lisp b/packages.lisp index fa69c11..a319522 100644 --- a/packages.lisp +++ b/packages.lisp @@ -24,6 +24,8 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; Packages.lisp - defines the cl-dates package and all exported symbols + (in-package :cl-user) (defpackage :cl-dates diff --git a/parse-date.lisp b/parse-date.lisp index eadbc76..4706a2c 100644 --- a/parse-date.lisp +++ b/parse-date.lisp @@ -24,17 +24,17 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -;; -;; Contains a string to date-time converter that accurately parses most common -;; ways of writing dates. See test-parse-dates.lisp for examples. -;; -;; Only the string->date function is exported from this file - all other functions -;; are simply supporting functions for string->date and are not meant to be used -;; elsewhere. -;; -;; The code is largely based on the Python dateutils library but there are some -;; differences and optimizations -;; +;;;; Parse-Date.lisp - Contains a string to date-time converter that accurately +;;;; parses most common ways of writing dates. +;;;; +;;;; See test-parse-dates.lisp for examples. +;;;; +;;;; Only the string->date function is exported from this file - all other functions +;;;; are simply supporting functions for string->date and are not meant to be used +;;;; elsewhere. +;;;; +;;;; The code is largely based on the Python dateutils library but there are some +;;;; differences and optimizations (in-package :cl-dates) @@ -64,7 +64,7 @@ ;; separate "23.jun.2017" => "23" "." "jun" "." "2017" ;; any trailing period will be dropped (setf token (nreverse token)) - (loop for tk on (split-list #'(lambda(x) (char= x #\.)) token) + (loop for tk on (split-list (lambda(x) (char= x #\.)) token) do (progn (push (coerce (car tk) 'string) token-list) (unless (null (cdr tk)) @@ -186,18 +186,18 @@ (t (multiple-value-bind (yy mm) (assign-yy-mm list precedence) (values yy mm nil)))) (let (tmp) - (cond ((every #'(lambda(x) (<= x 12)) list) + (cond ((every (lambda(x) (<= x 12)) list) ;; 01/02/03 (cond ((eq precedence :mdy) (values (third list) (first list) (second list))) ((eq precedence :dmy) (values (third list) (second list) (first list))) (t (values (first list) (second list) (third list))))) - ((setf tmp (find-if #'(lambda(x) (> x 31)) list)) + ((setf tmp (find-if (lambda(x) (> x 31)) list)) ;; 12/5/55 (setf list (remove tmp list :count 1)) (multiple-value-bind (mm dd) (assign-mm-dd list precedence) (values tmp mm dd))) - ((= 1 (count-if #'(lambda(x) (<= x 12)) list)) - (setf tmp (find-if #'(lambda(x) (<= x 12)) list) + ((= 1 (count-if (lambda(x) (<= x 12)) list)) + (setf tmp (find-if (lambda(x) (<= x 12)) list) list (remove tmp list :count 1)) (multiple-value-bind (yy dd) (assign-yy-dd list precedence) (values yy tmp dd))) diff --git a/print-date.lisp b/print-date.lisp index 14c22f3..16d3e44 100644 --- a/print-date.lisp +++ b/print-date.lisp @@ -24,6 +24,9 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; Print-Date.lisp - functions to convert a date-time into various string +;;;; formats + (in-package :cl-dates) (defun date->string (date &key (format :human) zone) diff --git a/timezones.lisp b/timezones.lisp index 0f3ffc7..1111bfe 100644 --- a/timezones.lisp +++ b/timezones.lisp @@ -24,6 +24,8 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; TimeZones.lisp - Contains a table mapping timezones to their offsets from GMT + (in-package :cl-dates) ;; hash table containing mappings from time zone abbreviation to GMT offset diff --git a/util.lisp b/util.lisp index 834e909..c2bf8df 100644 --- a/util.lisp +++ b/util.lisp @@ -24,6 +24,10 @@ ;;; 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)