[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Oct 6:
; zeller's congruence

(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 (gregorian julian)
  (let* ((j (+ julian 32044))
         (g (quotient j 146097))
         (dg (modulo j 146097))
         (c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
         (dc (- dg (* c 36524)))
         (b (quotient dc 1461))
         (db (modulo dc 1461))
         (a (quotient (* (+ (quotient db 365) 1) 3) 4))
         (da (- db (* a 365)))
         (y (+ (* g 400) (* c 100) (* b 4) a))
         (m (- (quotient (+ (* da 5) 308) 153) 2))
         (d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
         (year (+ y (- 4800) (quotient (+ m 2) 12)))
         (month (+ (modulo (+ m 2) 12) 1))
         (day (+ d 1)))
    (values year month day)))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (zeller 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 '(Sunday Monday Tuesday Wednesday Thursday Friday Saturday)
      (modulo (+ day (quotient (- (* 13 m) 1) 5) d
        (quotient d 4) (quotient c 4) (* -2 c)) 7))))

(do ((i 2361331 (+ i 1))) ((= i 2726573))
  (let-values (((year month day) (gregorian i)))
    (assert (list-ref '(Monday Tuesday Wednesday Thursday Friday Saturday Sunday)
              (modulo (julian year month day) 7))
            (zeller year month day))))

(display (zeller 2010 10 8))


Output:
1
Friday


Create a new paste based on this one


Comments: