day of week

gistfile1.lisp

; https://github.com/d4gg4d/it-factors/blob/master/day-of-the-week.lisp

(defvar *month-to-code*
  '(nil 1 4 4 0 2 5 0 3 6 1 4 6))

(defun fetch-month-code (month)
  (nth month *month-to-code*))

(defvar *code-to-day*
  '("Saturday" "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday"))

(defun fetch-day (code)
  (nth code *code-to-day*))

(defun resolve-year-code (year)
  (flet ((century-code (century)
           (- 6 (* 2 (mod century 4))))
         (last-two-digits (year)
           (rem year 100)))
    (let ((century-value (century-code (floor year 100)))
          (last-digits   (last-two-digits year)))
      (mod (+ century-value last-digits (floor last-digits 4)) 7))))

(defun resolve-leap-year-code (year month)
  (if (and (zerop (mod year 4)) (<= month 2)) -1 0))

(defun resolve-day-code (year-code leap-year-code month-code day)
  (mod (+ year-code leap-year-code month-code day) 7))

(defun day-of-the-week (year month day)
  "returns the day of the week for given date by human calculatable rules"
  (let* ((year-code (resolve-year-code year))
	 (month-code (fetch-month-code month))
	 (leap-year-code (resolve-leap-year-code year month))
	 (day-code (resolve-day-code year-code leap-year-code month-code day)))
    (fetch-day day-code)))

(day-of-the-week 2014 12 24)