Zeller's congruence for computing weekday from day, month, and year

zeller.rkt

#lang racket/base

;; zeller's congruence
;; http://en.wikipedia.org/wiki/Zeller%27s_congruence

(require (for-syntax racket/base)
         racket/unsafe/ops)


;; Gregorian version of Zeller's congruence is:
(define (h day month year)
  (define q day)
  (define m month)
  (define K (unsafe-fxmodulo year 100))
  (define J (unsafe-fxquotient year 100))
  (modulo (reduce unsafe-fx+
                  q
                  (unsafe-fxquotient (unsafe-fx* 13 (unsafe-fx+ 1 m)) 5)
                  K
                  (unsafe-fxquotient K 4)
                  (unsafe-fxquotient J 4)
                  (unsafe-fx* 5 J))
          7))

(define-syntax (reduce stx)
  (syntax-case stx ()
    [(_ op rand)
     #'rand]
    [(_ op rand1 rand2 rand-rest ...)
     #'(reduce op (op rand1 rand2) rand-rest ...)]))
     

;; day-month-year->weekday: number number number -> string
(define (day-month-year->weekday day month year)
 
  (let-values ([(month year)
                (if (or (= month 1)
                        (= month 2))
                    (values (+ 12 month)
                            (sub1 year))
                    (values month year))])
    (vector-ref #("Saturday"
                  "Sunday" 
                  "Monday"
                  "Tuesday" 
                  "Wednesday" 
                  "Thursday"
                  "Friday")
                (h day month year))))

(module+ test
  (require rackunit)
  (check-equal? (day-month-year->weekday 17 11 2012) "Saturday")
  ;; Apollo 11 Moon landing:
  (check-equal? (day-month-year->weekday 20 7 1969) "Sunday")
  (check-equal? (day-month-year->weekday 1 1 2000) "Saturday"))