Date routines for CL? 
Author Message
 Date routines for CL?

I'm just wondering if there is a DATE package floating around anywhere
that handles:

o Parsing of dates
o Formatting of dates
o Date math

I appreciate that CL has the universal time functions, which would be
a fine foundation to build upon, but I'm just looking for something a
little more high level before jaunting off to code my own.

I checked the some of the Lisp archives, and I also checked SLIB
(thinking I could port it rather easily), but it, surprisingly,
doesn't have anything either.

Does EMACS have something in an .el file that could be used?

I haven't checked there yet.

Anyway, any pointers would be appreciated.

Thanx.

--

1990 VFR750 - VFR=Very Red    "Ho, HaHa, Dodge, Parry, Spin, HA! THRUST!"
1993 Explorer - Cage? Hell, it's a prison.                    -D. Duck



Tue, 12 Sep 2000 03:00:00 GMT  
 Date routines for CL?

Quote:

> Does EMACS have something in an .el file that could be used?

> I haven't checked there yet.

I use the following Emacs Lisp code to perform date calculations.

-russ

;;;
;;; $Id: date.el,v 1.1 1998/03/21 15:13:13 mcmanr Exp mcmanr $
;;;
;;; a library of date functions.  the purpose of the library
;;; is to make it convenient to do date arithmetic.  to that
;;; end, the conept of day count is established.  a day count
;;; is a positive integer representing a number of days from
;;; some base date in the past.
;;;
;;; since this library's original use was for financial
;;; calculations, by default the date range supported is between
;;; 1900 and 2200.  these numbers are defvar'ed and can be
;;; changed easily.
;;;

(defvar date-start-year 1900
  "Minimum year handled.  Also, this is the base year for
day counts.  January 1 of this year is defined to be day
count 0.")

(defvar date-end-year 2200
  "Maximum year handled.")

(defvar date-year-vect
  (let ((vect (make-vector (- date-end-year date-start-year) nil))
        (tot 0)
        (year date-start-year))
    (while (< year date-end-year)
      (setf (aref vect (- year date-start-year)) tot)
      (incf tot (date-day-count-in-year year))
      (incf year))
    vect)
  "A vector in which each cell represents the day count for January 1
of a particular year.  the formula to get from a year to an index in
this vector is:
    (- year date-start-year)")

(defvar date-day-count-in-month-vect
  [0 31 28 31 30 31 30 31 31 30 31 30 31]
  "A vector where each cell represents the number of days in a
particular month.  Obviously, additional calculation is required
to handle February.  The array is indexed with January in position
1.")

(defmacro date-day-count-in-month (m y)
  "returns the number of days in a particular MONTH and YEAR.  no
argument checking is performed."
  `(if (= ,m 2)
    (if (date-leap-year-p ,y) 29 28)
    (aref date-day-count-in-month-vect ,m)))

(defmacro date-leap-year-p (y)
  "returns t if the supplied YEAR is a leap year, otherwise nil.
no argument checking is performed."
  `(or (and (= 0 (mod ,y 4))
        (not (= 0 (mod ,y 100))))
    (= 0 (mod ,y 1000))))

(defmacro date-day-count-in-year (y)
  "returns the number of days in the supplied YEAR. no argument checking
is performed."
  `(if (date-leap-year-p ,y) 366 365))

(defun date-string-to-mdy (str)
  "This should match a number of standard date formats.  Instead, for now
it only matches dates in 'MM/DD/YYYY' format."
  (if (string-match "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9][0-9][0-9]\\)"
                    str)
      (date-valid-mdy
       (car (read-from-string (substring str (match-beginning 1) (match-end 1))))
       (car (read-from-string (substring str (match-beginning 2) (match-end 2))))
       (car (read-from-string (substring str (match-beginning 3) (match-end 3)))))))

(defun date-read-mdy (&optional prompt)
  "read a date from the minibuffer, and return a MDY list with
the results, or nil on error."
  (let ((today-str (format-time-string "%m/%d/%Y")))
    (date-string-to-mdy
     (read-from-minibuffer (or prompt "Date: ")
                           (cons today-str (1+ (length today-str)))))))

(defun date-valid-mdy (month day year)
  "Determine whether the supplied MONTH, DAY, and YEAR are valid.
Throws an error if the values are not valid."
  (or (>= year date-start-year) (error "year too early"))
  (or (< year date-end-year) (error "year too late"))
  (or (and (<= 1 month)
           (<= month 12)) (error "bad month"))
  (or (and (<= day (date-day-count-in-month month year))
           (>= day 1))
      (error "bad day"))
  (list month day year))

(defun date-valid-day-count (day-count)
  "Determine whether the supplied DAY-COUNT is valid."
  (or (and (>= day-count 0)
           (<= day-count
               (+ 365 (aref date-year-vect (1- (- date-end-year date-start-year))))))
      (error "day count out of range")))

(defun date-day-count-to-mdy (day-count)
  "Given a DAY-COUNT return a list of three elements that specify that
corresponding month, day, and year.  Month indices start with 1,
corresponding to January.  Day indices start with 1, corresponding to
the first day of the month."
  (date-valid-day-count day-count)
  (flet ((guess-year-index ()
           (let ((n (max (1- (/ day-count 365)) 0)))
             n))
         (year-index-to-year (index)
           (+ index date-start-year)))
    (let* ((nyear (- date-end-year date-start-year))
           (year-index (guess-year-index))
           (before-day-count))
      ;; search for the correct year by choosing a good guess year,
      ;; and then searching forward until you go past the desired
      ;; year.  the desired year is then previous year.
      (while (progn
               (setf before-day-count (aref date-year-vect year-index))
               (<= before-day-count day-count))
        (incf year-index))
      (setf year-index (max 0 (1- year-index)))
      ;; now find the right month in the year.  a similar approach
      ;; is used.  add up the days in each month until the total day
      ;; count is greater than the given day count.  at this point,
      ;; you've gone too far by one month, so back off the last month.
      (let ((year (year-index-to-year year-index))
            (guess-day-count (aref date-year-vect year-index))
            (month 1)
            (day 1)
            (dim nil))
        (while (progn
                 (setf dim (date-day-count-in-month month year))
                 (incf guess-day-count dim)
                 (<= guess-day-count day-count))
          (incf month))
        (incf guess-day-count (* -1 dim))
        ;; now figure the number of days into the month
        (let ((day (1+ (- day-count guess-day-count))))
          (list month day year))))))

(defun date-mdy-to-day-count (month day year)
  "Given a MONTH, a DAY, and a YEAR, return a corresponding
day count.  The day count is defined to be 0 on January 1
of 'date-start-year', and it is incremented by one each day
after that.  The MONTH spec should be between 1 and 12, the
DAY spec should be between 1 and 31, depending on the month,
and the year must be between 'date-start-year' and
'date-end-year'."
  (date-valid-mdy month day year)
  (flet ((day-count-to-start-of-month (month year)
           (let ((start-month 1)
                 (count 0))
             (while (< start-month month)
               (incf count (date-day-count-in-month start-month year))
               (incf start-month))
             count)))
    (+ (1- day)
       (day-count-to-start-of-month month year)
       (aref date-year-vect (- year date-start-year)))))

(defun date-tester (max-day-count)
  "Insert at the end of the current buffer a bunch of lines that
test the functionality of this date library.  MAX-DAY-COUNT is the
final day count to test;  the testing begins at a day count of 0.
The left most column represents the day count being tested.  The
next three columns are the month, day, and year corresponding to
the day count in the first column.  The fifth column is the day
count returned by converting the month, day, and year back into
a day count.  It's value should match the first column."
  (interactive "p")
  (let ((day-count 0)
        (mdy nil))
    (goto-char (point-max))
    (while (< day-count max-day-count)
      (let ((mdy (date-day-count-to-mdy day-count)))
        (insert
         (format "%6d " day-count)
         (format "%2d %2d %4d " (nth 0 mdy) (nth 1 mdy) (nth 2 mdy))
         (format "%6d\n" (apply 'date-mdy-to-day-count mdy)))
        (incf day-count)))))

(provide 'date)



Tue, 12 Sep 2000 03:00:00 GMT  
 Date routines for CL?

Take a look in ftp://ftp.cs.umass.edu/pub/eksl/utils/ .  The last time I took
a look here, utils-5.tgz was the latest, and contains a file day-and-time.lisp
that has what you seek.  I think that the other files are different versions,
but I'm not sure why they would have such widely differing sizes; perhaps some
include binaries.

Quote:

> I'm just wondering if there is a DATE package floating around anywhere
> that handles:

> o Parsing of dates
> o Formatting of dates
> o Date math

> I appreciate that CL has the universal time functions, which would be
> a fine foundation to build upon, but I'm just looking for something a
> little more high level before jaunting off to code my own.

> I checked the some of the Lisp archives, and I also checked SLIB
> (thinking I could port it rather easily), but it, surprisingly,
> doesn't have anything either.

> Does EMACS have something in an .el file that could be used?

> I haven't checked there yet.

> Anyway, any pointers would be appreciated.

> Thanx.

> --

> 1990 VFR750 - VFR=Very Red    "Ho, HaHa, Dodge, Parry, Spin, HA! THRUST!"
> 1993 Explorer - Cage? Hell, it's a prison.                    -D. Duck



Tue, 12 Sep 2000 03:00:00 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. Tcl Date Routines don't handle ISO date formats

2. Calling toolbox routines from Allegro CL

3. routine to convert date format 0CYYDDDF to format DD/MM/YY or DDMMYY

4. Date Routine for PB/cc

5. SQL CLARION DATE CONVERSION ROUTINE

6. Help with Julian Date routine?

7. date routines yyyymmdd format needed

8. Need date routine

9. DATE ROUTINE

10. Need date routine

11. File date routine

12. Date Routines

 

 
Powered by phpBB® Forum Software