Cleaned up documentation

date-arith.lisp

@@ -28,21 +28,27 @@
 
 ;; Date comparisons - strip off time component
 (defun date= (&rest dates)
+  "Returns true if all dates are the same (times can be different)"
   (every (lambda (a b) (= (jday-number a) (jday-number b))) dates (cdr dates)))
 
 (defun date/= (&rest dates)
+  "Returns true if all dates are not the same (times are ignored)"
   (notevery (lambda (a b) (= (jday-number a) (jday-number b))) dates (cdr dates)))
 
 (defun date> (&rest dates)
+  "Returns true if all dates are in descending order (times are ignored)"
   (every (lambda (a b) (> (jday-number a) (jday-number b))) dates (cdr dates)))
 
 (defun date< (&rest dates)
+  "Returns true if all dates are in ascending order (times are ignored)"
   (every (lambda (a b) (< (jday-number a) (jday-number b))) dates (cdr dates)))
 
 (defun date>= (&rest dates)
+  "Returns true if all dates are in descending order or adjacent dates are the same (times are ignored)"
   (every (lambda (a b) (>= (jday-number a) (jday-number b))) dates (cdr dates)))
 
 (defun date<= (&rest dates)
+  "Returns true if all dates are in ascending order or adjacent dates are the same (times are ignored)"
   (every (lambda (a b) (<= (jday-number a) (jday-number b))) dates (cdr dates)))
 
 ;; Date arithmetic
@@ -50,7 +56,8 @@
 (defun nth-day-of-week (date dow n)
   "Returns the nth day of the week e.g., second Saturday of the month in which date falls.
 If n is large enough to make the date fall in a future month, the last valid day in
-the month is returned."
+the month is returned so setting n to a large value (> 5) will return the last relevant
+weekday in the month."
   (multiple-value-bind (yy mm dd) (date->ymd date)
     (declare (ignore dd))
     (let ((dt (loop for dd = (ymd->date yy mm 1) then (1+ dd)
@@ -67,7 +74,7 @@ the month is returned."
 		    (setf dt next-dt)))))))))
 
 (defun first-of-next-month (date)
-  "Returns date for 1st of the following month"
+  "Returns the 1st of the following month"
   (multiple-value-bind (yy mm dd) (date->ymd date)
     (declare (ignore dd))
     (if (= mm 12)
@@ -75,11 +82,11 @@ the month is returned."
 	(ymd->date yy (1+ mm) 1))))
 
 (defun last-day-of-month (date)
-  "Returns last day in curent month"
+  "Returns the last calendar day in the month in which date falls"
   (1- (first-of-next-month date)))
 
 (defun last-day-of-prev-month (date)
-  "Returns last day of previous month"
+  "Returns the last day of the previous month"
   (multiple-value-bind (yy mm dd) (date->ymd date)
     (declare (ignore dd))
     (1- (ymd->date yy mm 1))))
@@ -140,7 +147,7 @@ latter case, February 28th is considered to be the end of month even in leap yea
 The dates may be in either order and the returned value is always positive.
 
 termination-date is needed only when the day count convention is 30E/360 (ISDA) and
-the later date is the last date of February.
+the end date of the period is the last day of February.
 
 frquency is needed when the Actual/Actual (ISMA) day convention is used. In this case,
 for irregular periods, by default, it is assumed to be the front stub. If the dates are

dates.lisp

@@ -27,22 +27,23 @@
 (in-package :cl-dates)
 
 (defun jday-number (date)
-  "Returns the Julian day number for the given Julian date"
+  "Returns the Julian day number for the given date-time"
   (floor (+ date 1/2)))
 
 (defparameter +days-of-week+ #(:monday :tuesday :wednesday :thursday :friday :saturday :sunday))
 (defun day-of-week (date)
-  "Returns the day of week on which the given Julian date falls"
+  "Returns the day of week on which the given date falls"
   (aref +days-of-week+ (mod (jday-number date) 7)))
 
 (defun ymd->date (yy mm dd &optional (hour 0) (min 0) (sec 0) zone)
-  "Return the Julian date corresponding to the given date and time. No
+  "Return the date-time corresponding to the given date and (optionally) time.
-compensation is made for the Gregorian Calendar introduction.
-Note that the Julian date is an integer when the time is noon so a
-date without time (midnight) will have a fractional part of 0.5.
 
-If timezone is specified, it should be either an alphabetic code e.g., \"IST\"
+No adjustment is made for the Gregorian Calendar introduction. Note that the
-or a numeric offset in fractions of an hour e.g., +5.5"
+Julian date is defined to begin at noon so a date without time (midnight) will
+have a fractional part of 0.5.
+
+If timezone is specified, it should be either an alphabetic code or numeric offset
+from UTC e.g., for Indian Standard time, it should be specified as \"IST\" or +5.5"
   (let* ((a (floor (* 1/12 (- 14 mm))))
 	 (b (- yy a))
 	 (c (floor (/ b 100)))
@@ -58,9 +59,9 @@ or a numeric offset in fractions of an hour e.g., +5.5"
     (- jdate (/ offset 24))))
 
 (defun date->ymd (date &key (want-time nil))
-  "Returns 6 values if :want-time is true: year, month, day, hour, minute, second.
+  "Returns 6 values if want-time is true: year, month, day, hour, minute, second.
-Second may be a floating point value but the first five are aways integers.
+The second may be a floating point value but the first five are aways integers.
-If :want-time is NIL, returns year, month and day as integers."
+If want-time is NIL, only three integer values are returned - year, month and day."
   (let* ((jd (jday-number date))
 	 (e (floor (/ (- jd 1867216.25d0) 36524.25d0)))
 	 (f (+ 1 jd e (- (floor (/ e 4)))))
@@ -84,8 +85,17 @@ If :want-time is NIL, returns year, month and day as integers."
 
 (defun valid-date-p (yy mm dd)
   "Check that year, month and day form a valid calendar date"
-  (multiple-value-bind (y m d) (date->ymd (ymd->date yy mm dd))
+  (cond ((not (and (integerp yy) (> yy -4713)
-    (and (= yy y) (= mm m) (= dd d))))
+		   (integerp mm) (<= 1 mm 12)
+		   (integerp dd) (<= 1 dd 31)))
+	 nil)
+	((and (or (= mm 4) (= mm 6) (= mm 9) (= mm 11)) (> dd 30))
+	 nil)
+	((and (leap-year-p yy) (= mm 2) (> dd 29))
+	 nil)
+	((and (not (leap-year-p yy)) (= mm 2) (> dd 28))
+	 nil)
+	(t t)))
 
 (defun valid-time-p (h m s)
   "Check that hour, minute and second are valid numbers"
@@ -114,8 +124,8 @@ If :want-time is NIL, returns year, month and day as integers."
 (defun easter-day (yy &optional (want-gregorian-date nil))
   "Returns the date for Easter Sunday in the given year.
 Accurate until approx. 4000 CE
-Returns a Julian date if want-gregorian-date is NIL. Otherwise,
+Returns a date if want-gregorian-date is NIL. Otherwise,
-it returns year, month, day, hour, minute and second as 6 values"
+it returns year, month, day as 3 values"
   (let* ((century (floor (/ yy 100)))
 	 (remain-19 (mod yy 19))
 	 (temp (+ (floor (* 1/2 (- century 15)))
@@ -152,22 +162,22 @@ it returns year, month, day, hour, minute and second as 6 values"
 
 (defun vernal-equinox (yy &optional (want-gregorian-date nil))
   "Return UTC date-time of the vernal (spring) equinox for the given year.
-Returns a Julian date if want-gregorian-date is NIL. Otherwise,
+Returns a date-time if want-gregorian-date is NIL. Otherwise,
 it returns year, month, day, hour, minute and second as 6 values"
   (calc-equinox-or-solstice-date 1 yy want-gregorian-date))
 (defun summer-solstice (yy &optional (want-gregorian-date nil))
   "Return UTC date-time of the summer solstice for the given year.
-Returns a Julian date if want-gregorian-date is NIL. Otherwise,
+Returns a date-time if want-gregorian-date is NIL. Otherwise,
 it returns year, month, day, hour, minute and second as 6 values"
   (calc-equinox-or-solstice-date 2 yy want-gregorian-date))
 (defun autumnal-equinox (yy &optional (want-gregorian-date nil))
   "Return UTC date-time of the autumnal equinox for the given year.
-Returns a Julian date if want-gregorian-date is NIL. Otherwise,
+Returns a date-time if want-gregorian-date is NIL. Otherwise,
 it returns year, month, day, hour, minute and second as 6 values"
   (calc-equinox-or-solstice-date 3 yy want-gregorian-date))
 (defun winter-solstice (yy &optional (want-gregorian-date nil))
   "Return UTC date-time of the winter solstice for the given year.
-Returns a Julian date if want-gregorian-date is NIL. Otherwise,
+Returns a date-time if want-gregorian-date is NIL. Otherwise,
 it returns year, month, day, hour, minute and second as 6 values"
   (calc-equinox-or-solstice-date 4 yy want-gregorian-date))
 

packages.lisp

@@ -43,8 +43,8 @@
    :date->local-time			; to local time zone
    :month->string			; full name of month
    :dow->string				; day of week as string
-   :day-count->string
+   :day-count->string			; day-count convention as string
-   :eom-rule->string
+   :eom-rule->string			; end of month rule as string
    ;; Special dates for given year
    :easter-day				; easter day
    :vernal-equinox			; spring equinox date-time

parse-date.lisp

@@ -24,6 +24,18 @@
 ;;; 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
+;;
+
 (in-package :cl-dates)
 
 (defparameter +white-space+ '(#\space #\tab #\return #\linefeed #\newline))
@@ -205,7 +217,48 @@
 
 (defparameter +date-separators+ '("." "/" "-"))
 
-(defun string->date (string &key (reference-date (todays-date)) (precedence :ymd))
+(defparameter +time-suffixes+ '((:hour . ("h" "hr" "hrs" "hour" "hours"))
+				(:minute . ("m" "min" "mins" "minute" "minutes"))
+				(:second . ("s" "sec" "secs" "second" "seconds"))))
+(defun str-to-hms (str)
+  "Interpret string as hour / minute / second"
+  (loop for i from 0 below 3
+	do (let ((list (elt +time-suffixes+ i)))
+	     (when (member str (cdr list) :test #'string-equal)
+	       (return-from str-to-hms (car list))))))
+
+(defun str-to-ampm (str)
+  "Interpret string as AM / PM"
+  (cond ((member str '("a.m." "a.m" "am" "morning") :test #'string-equal) :am)
+	((member str '("p.m." "p.m" "pm" "evening" "afternoon") :test #'string-equal) :pm)
+	(t nil)))
+
+(defun str-is-day-suffix (str)
+  "Return true if string is a suffix for a number"
+  (not (null (member str '("st" "nd" "rd" "th") :test #'string-equal))))
+
+(defun str-to-relative-dow (str)
+  (cond ((member str '("last" "prev" "previous") :test #'string-equal) :prev)
+	((member str '("next" "coming") :test #'string-equal) :next)
+	((string-equal str "this") :closest)
+	(t nil)))
+
+(defparameter +date-words+ '(("today" . 0) ("tomorrow" . 1) ("yesterday" . -1)))
+(defun str-to-relative-date (str)
+  (cdr (find str +date-words+ :test #'string-equal :key #'car)))
+
+(defun string->date (string &key (reference-date (todays-datetime)) (precedence :ymd))
+  "Convert a string to a date-time if possible and return it. If parsing fails, NIL is returned.
+
+If the date and time are not fully specified, the missing components are copied from the
+given reference date (default = current system time). For example, given a string \"24 Feb\",
+the year will be set to the current year and time to the current time.
+
+Given ambiguous dates (month & day cannot be distinguished), 'precedence' is used to
+assign the month/day correctly. For US-style dates, precedence should be specified as :mdy
+and for UK style, it should be :dmy.
+
+Some special strings such as 'today', 'tomorrow', 'next Wednesday' etc are also recognized."
   (setf string (string-downcase (string-trim +white-space+ string)))
   (unless (member precedence '(:ymd :dmy :mdy))
     (error "invalid precedence ~a" precedence))

test-parse-date.lisp

@@ -203,4 +203,4 @@
       ;; The next one works coincidentally because Japanese uses a y/m/d format by default.
       ;; However, it demonstrates that as long as date components are present, the presence
       ;; of extraneous characters does not matter
-      (= (string->date "2004年8月9日") (ymd->date 2004 8 9)))))
+      (= (string->date "2004年8月9日 17:30:22" :reference-date dt) (ymd->date 2004 8 9 17 30 22)))))

util.lisp

@@ -54,9 +54,11 @@
       (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)))
@@ -69,12 +71,15 @@
 			   (: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)
@@ -85,44 +90,21 @@
 			 ("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))))
 
-(defparameter +time-suffixes+ '((:hour . ("h" "hr" "hrs" "hour" "hours"))
-				(:minute . ("m" "min" "mins" "minute" "minutes"))
-				(:second . ("s" "sec" "secs" "second" "seconds"))))
-(defun str-to-hms (str)
-  (loop for i from 0 below 3
-	do (let ((list (elt +time-suffixes+ i)))
-	     (when (member str (cdr list) :test #'string-equal)
-	       (return-from str-to-hms (car list))))))
-
-(defun str-to-ampm (str)
-  (cond ((member str '("a.m." "a.m" "am" "morning") :test #'string-equal) :am)
-	((member str '("p.m." "p.m" "pm" "evening" "afternoon") :test #'string-equal) :pm)
-	(t nil)))
-
-(defun str-is-day-suffix (str)
-  (not (null (member str '("st" "nd" "rd" "th") :test #'string-equal))))
-
-(defun str-to-relative-dow (str)
-  (cond ((member str '("last" "prev" "previous") :test #'string-equal) :prev)
-	((member str '("next" "coming") :test #'string-equal) :next)
-	((string-equal str "this") :closest)
-	(t nil)))
-
-(defparameter +date-words+ '(("today" . 0) ("tomorrow" . 1) ("yesterday" . -1)))
-(defun str-to-relative-date (str)
-  (cdr (find str +date-words+ :test #'string-equal :key #'car)))
-
 (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)")
@@ -140,6 +122,7 @@
   
 
 (defun eom-rule->string (rule)
+  "Return string description of EOM rule"
   (case rule
     (:eom-normal "EOM")
     (:eom-no-leap-day "EOM (No Leap)")