codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; passover (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 (rosh-hashanah year) (let* ((g (+ (remainder year 19) 1)) (r (remainder (* 12 g) 19)) (n (+ (- (quotient year 100) (quotient year 400) 2) (* 765433 r 1/492480) (/ (remainder year 4) 4) (- (/ (+ (* 313 year) 89081) 98496)))) (d (quotient (numerator n) (denominator n))) (f (- n d)) (j (julian year 9 d))) (case (modulo j 7) ((2 4 6) (+ j 1)) ((0) (if (and (>= f 23269/25920) (> r 11)) (+ j 1) j)) ((1) (if (and (>= f 1367/2160) (> r 6)) (+ j 2) j)) (else j)))) (define (passover year) (let-values (((y m d) (gregorian (rosh-hashanah year)))) (let ((j (julian year 3 21))) (if (= m 9) (+ j d) (+ j d 30))))) (call-with-values (lambda () (gregorian (passover 2010))) (lambda (y m d) (display y) (newline) (display m) (newline) (display d) (newline)))
Private
[
?
]
Run code
Submit