Calculate the weekday from a date (M-D-Y)

Question

This Common Lisp exercise is to write a program that can calculate the weekday given a string of the format "M-D-Y." It was more challenging than I expected. If you have suggestions about how to simplify this code, I will be very grateful.

;;  2.7 Day of Week. A program for converting Gregorian dates in the form month-day-year to day of the
;;  week is the following. Let the Gregorian date be represented by M-D-Y where we have the following
;;  definitions:
;;    M is the month of the year. Let m be the month number derived from M by the rule m is M - 2 if M >= 3
;;    and m is M + 10 otherwise.
;;    d is the day of the month.
;;    y is the year of the century.
;;    c is the number of the previous century.
;;  The algorithm is as follows:
;;    (a) A is the integer part of (13m - 1)/5.
;;    (b) B is the integer parg of y/4.
;;    (c) C is the integer part of c/4.
;;    (d) D = A + B + C + d + y - 2c.
;;    (e) Make R equal to the remainder of D/7.
;;    (f ) Interpret R as Sunday if R = 0, Monday if R is 1, etc

(defun read-date () (format t "Enter the gregorian date in the format (M-D-Y): ~%") (read))


(defun flatten (the-list) 
  (cond ((null the-list) nil)
    ((atom the-list) (list the-list))
    (t (concatenate 'list (flatten (car the-list)) (flatten (cdr the-list))))))

(defun split (split-char string-to-split) 
  (let ((next-split-char (position split-char string-to-split)))
    (if next-split-char (flatten (list (safely-read-from-string (subseq string-to-split 0 next-split-char))
                  (split split-char (subseq string-to-split (+ 1 next-split-char)))))
      (list (safely-read-from-string string-to-split)))))

(defun weekday-code (bigM bigD bigY)
    (let* ((m (if (>= bigM 3) (- bigM 2) (+ bigM 10)))
          (y (mod bigY 100))
          (littleC (/ (- bigY y) 100))
          (A (floor (- (* 13 m) 1) 5))
          (B (floor y 4))
          (C (floor littleC 4))
          (D (- (+ A B C bigD y) (* 2 littleC)))
          (R (mod D 7)))
      (format t "m: ~a y: ~a c: ~a A: ~a B: ~a C: ~a D: ~a R: ~a ~%" m y littleC A B C D R)
      R))

(defun check-date-format (bigM bigD bigY)
  (cond ((or (< bigM 1) (> bigM 12)) (error "The month (~a) is not in the range 1-12." bigM))
    ((< bigY 0) (error "The year (~a) is less than 0." bigY))
    ((or (< bigD 1) (> bigD 31)) (error "The day (~a) is not in the range 1-31." bigD))))

(let ((gregorian-date (read-date)))
      (destructuring-bind (bigM bigD bigY) (split #\- gregorian-date)
    (check-date-format bigM bigD bigY)
    (format t "~a was (or will be) a ~[Sunday~;Monday~;Tuesday~;Wednesday~;Thursday~;Friday~;Saturday~]." gregorian-date (weekday-code bigM bigD bigY))))

Answer 1

Typically, you should almost never need to use a flatten function. For example, the split function:

(defun split (split-char string-to-split) 
  (let ((next-split-char (position split-char string-to-split)))
    (if next-split-char (flatten (list (safely-read-from-string (subseq string-to-split 0 next-split-char))
                  (split split-char (subseq string-to-split (+ 1 next-split-char)))))
      (list (safely-read-from-string string-to-split)))))

is equivalent to:

(defun split (split-char string-to-split) 
  (let ((next-split-char (position split-char string-to-split)))
    (if next-split-char 
        (cons (safely-read-from-string (subseq string-to-split 0 next-split-char))
              (split split-char (subseq string-to-split (1+ next-split-char))))
        (list (safely-read-from-string string-to-split)))))

This assumes safely-read-from-string returns the same as read function. The flatten helper function is not necessary.

Answer 2

If you're allowed to use library functions, split already exists as part of cl-ppcre.

---

There's a pretty rich set of date/time functions in the Lisp core that make this trivial. If it's for learning purposes, by all means, go ahead and do it by hand. But if you're thinking "What's the best way to get the day-of-week in Lisp?", that's actually ridiculously simple.

(defun day-of-week (day month year)
   (nth-value 6 (decode-universal-time (encode-universal-time 0 0 0 day month year 0))))

Re-arrange order of argumnents to taste. Monday is 0 by default, so you'd need to re-jig your format directive. If you need to be able to handle dates before 1900, there's a more robust version at the Common Lisp Cookbook.

Answer 3

Split

Here is an alternative implementation of split using the loop facility.

(defun split (split-char string-to-split)
  (loop for start = 0 then (1+ end)
        for end = (position split-char string-to-split :start start)
        collect (parse-integer string-to-split
                               :start start
                               :end end
                               :junk-allowed nil)
        while end))

Because we always parse the original string-to-split, with different start and end indices, we don't allocate memory for substrings. In fact, the time macro reports "0 bytes consed".

Check

• I changed check-date-format so that it also checks that the given values are integers.
• I use assert which is more appropriate than error here: an additional benefit is that assert provides a CONTINUE restart which allows to modify the value of some places.
• I exploit the fact that <= is variadic to check range membership.
• The check is a little more precise regarding the number of days in a months and leap years.

(defun check-date-format (month day year)
  (check-type month integer)
  (check-type day integer)
  (check-type year integer)
  (assert (<= 1 month 12) (month) "The month (~a) is not in the range 1-12." month)
  (assert (< 0 year) (year) "The year (~a) is less than 0." year)
  (let ((n-days (aref #(31 29 31 30 31 30 31 31 30 31 30 31) (1- month))))
    (assert (<= 1 day n-days) (day) "The day (~a) is not in the range 1-~a." day n-days))
  (when (and (= month 2) (= day 29))
    (assert (and
             (zerop (mod year 4))
             (or (not (zerop (mod year 100)))
                 (zerop (mod year 400))))
            (year) 
            "February 29, ~a is not valid because ~:*~a is not a leap year." year)))

Parse and check

The above utilities can be used to define parse-gregorian-date, which is responsible to check that the string actually is valid.

• It returns multiple values instead of a list, which I find more idiomatic.
• It includes the checks done previously by check-date-format: this is a good way to reduce the temporal coupling introduced between parsing and checking user input.

(defun parse-gregorian-date (string)
  (let ((parts (split #\- string)))
    (apply #'check-date-format parts)
    (values-list parts)))

Computing weekday

• The original intermediate variables (littleC,A,bigD, ...) did not respect the conventional way of writing symbols in Common Lisp (a.k.a. dash-separated lowercase words) and did not convey their purpose very well. I removed them so as to inline the mathematical expression.
• (floor 1945 100) returns 19 and 45, which are your c and y variables, respectively.
• The computation of m can be made using the mod operator. That allowed me to simplify some terms, even though the resulting expressions is not necessarly more readable (but the original formula is already cryptic).

(defun weekday-code (month day year)
  (multiple-value-bind (century century-year) (floor year 100)
    (mod (- (+ (floor (+ (* 13 (mod (- month 3) 12)) 12) 5)
               (floor century-year 4)
               (floor century 4)
               day
               century-year) 
            (* 2 century))
         7)))

Main function

There are minor adaptations due to the fact that above functions were redefined.

(defun gregorian-weekday ()
  (let ((input-string (read-date)))
    (multiple-value-bind (m d y) (parse-gregorian-date input-string)
      (format t "~a was (or will be) a ~[Sunday~;Monday~;Tuesday~;Wednesday~;Thursday~;Friday~;Saturday~]."
              input-string
              (weekday-code m d y)))))