; thank god it's friday
; standard prelude
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
(m (+ month (* 12 a) -3)))
(+ day
(quotient (+ (* 153 m) 2) 5)
(* 365 y)
(quotient y 4)
(- (quotient y 100))
(quotient y 400)
(- 32045))))
(define (day-of-week year month day)
(list-ref '(mon tue wed thu fri sat sun)
(modulo (julian year month day) 7)))
(display (day-of-week 2011 6 24)) (newline)
; zeller's congruence
(define (day-of-week year month day)
(let* ((m (if (< month 3) (+ month 10) (- month 2)))
(yr (if (< month 3) (- year 1) year))
(d (modulo yr 100)) (c (quotient yr 100)))
(list-ref '(sun mon tue wed thu fri sat)
(modulo (+ day (quotient (- (* 13 m) 1) 5) d
(quotient d 4) (quotient c 4) (* -2 c)) 7))))
(display (day-of-week 2011 6 24)) (newline)
; gauss' method
(define (day-of-week year month day)
(let* ((yr (if (< month 3) (- year 1) year))
(m (if (< month 3) (+ month 10) (- month 2)))
(y (modulo yr 100)) (c (quotient yr 100)))
(list-ref '(sun mon tue wed thu fri sat)
(modulo (+ day (floor (- (* 13/5 m) 1/5)) y
(quotient y 4) (quotient c 4) (- (* 2 c))) 7))))
(display (day-of-week 2011 6 24)) (newline)
; sakamoto's method
(define (day-of-week year month day)
(let ((t (vector 0 3 2 5 0 3 5 1 4 6 2 4))
(y (if (< month 3) (- year 1) year)))
(list-ref '(sun mon tue wed thu fri sat)
(modulo (+ day y (quotient y 4) (- (quotient y 100))
(quotient y 400) (vector-ref t (- month 1))) 7))))
(display (day-of-week 2011 6 24)) (newline)
; conway's doomsday
(define (anchor year)
(let ((c (+ (quotient year 100) 1)))
(list-ref '(sun mon tue wed thu fri sat)
(modulo (+ (* 5 c) (quotient (- c 1) 4) 4) 7))))
(display (anchor 2011)) (newline)
(define (doomsday year)
(let* ((days '(sun mon tue wed thu fri sat))
(y (modulo year 100))
(q (quotient y 12))
(r (remainder y 12))
(x (quotient r 4))
(c (+ (quotient year 100) 1))
(anchor (+ (* 5 c) (quotient (- c 1) 4) 4)))
(list-ref days (modulo (+ q r x anchor) 7))))
(display (doomsday 2011)) (newline)
(define (doomsday year)
(list-ref '(sun mon tue wed thu fri sat)
(modulo (+ 2 year (quotient year 4)
(- (quotient year 100)) (quotient year 400)) 7)))
(display (doomsday 2011)) (newline)