[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/BeTpy03N    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jun 22:
; 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)


Output:
1
2
3
4
5
6
7
fri
fri
fri
fri
tue
mon
mon


Create a new paste based on this one


Comments: