73 lines
2.1 KiB
Racket
73 lines
2.1 KiB
Racket
|
#lang racket/base
|
|||
|
|
|
|||
|
|
(require racket/date)
|
|||
|
|
|
|||
|
|
(provide date-values->jd
|
|||
|
|
jd->date-values
|
|||
|
|
dynamical-delta-t)
|
|||
|
|
|
|||
|
|
;; meeus, ch 7
|
|||
|
|
|
|||
|
|
;; counting from 1
|
|||
|
|
(define (date-values->jd year month day)
|
|||
|
|
(define julian? (or (< year 1582)
|
|||
|
|
(and (= year 1582) (< month 10))
|
|||
|
|
(and (= year 1582) (= month 10) (<= day 4))))
|
|||
|
|
|
|||
|
|
;; there's a range of days that doesn't exist due to the julian/gregorian transition
|
|||
|
|
(when (and (= year 1582) (= month 10) (or (> day 4) (< day 15)))
|
|||
|
|
(error "invalid date provided"))
|
|||
|
|
|
|||
|
|
(define-values [year* month*]
|
|||
|
|
(if (> month 2)
|
|||
|
|
(values year month)
|
|||
|
|
(values (sub1 year) (+ 12 month))))
|
|||
|
|
(define a (quotient year* 100))
|
|||
|
|
(define b (if julian? 0 (+ 2 (- a) (quotient a 4))))
|
|||
|
|
(+ (floor (* 365.25 (+ year* 4716))) (floor (* 30.6001 (add1 month*)))
|
|||
|
|
day b -1524.5))
|
|||
|
|
|
|||
|
|
;; (values year month day)
|
|||
|
|
(define (jd->date-values jd)
|
|||
|
|
(define-values [Z F]
|
|||
|
|
(let* ([jd+ (+ 0.5 jd)]
|
|||
|
|
[jdq (floor jd+)])
|
|||
|
|
(values jdq (- jd+ jdq))))
|
|||
|
|
(define A (if (< Z 2299161)
|
|||
|
|
Z
|
|||
|
|
(let ([α (floor (/ (- Z 1867216.25) 36524.25))])
|
|||
|
|
(+ Z 1 α (- (floor (/ α 4)))))))
|
|||
|
|
(define B (+ A 1524))
|
|||
|
|
(define C (floor (/ (- B 122.1) 365.25)))
|
|||
|
|
(define D (floor (* C 365.25)))
|
|||
|
|
(define E (floor (/ (- B D) 30.6001)))
|
|||
|
|
|
|||
|
|
(define day (- B D (floor (* 30.6001 E)) (- F)))
|
|||
|
|
(define month (if (< E 14) (sub1 E) (- E 13)))
|
|||
|
|
(define year (if (> month 2) (- C 4716) (- C 4715)))
|
|||
|
|
(values (inexact->exact year) (inexact->exact month) day))
|
|||
|
|
|
|||
|
|
(define (dynamical-delta-t year)
|
|||
|
|
(define t (/ (- year 2000) 100.))
|
|||
|
|
(+ 102. (* 102. t) (* 25.4 t t)))
|
|||
|
|
|
|||
|
|
(module+ test
|
|||
|
|
(require rackunit)
|
|||
|
|
;; TODO add tests. page 62
|
|||
|
|
;; 7.a
|
|||
|
|
(check-= (date-values->jd 1957 10 4.81) 2436116.31 0.000001)
|
|||
|
|
;; 7.b
|
|||
|
|
(check-= (date-values->jd 333 1 27.5) 1842713.0 0.000001)
|
|||
|
|
;; 7.c
|
|||
|
|
(define-values [y1 m1 d1] (jd->date-values 2436116.31))
|
|||
|
|
(check-equal? y1 1957)
|
|||
|
|
(check-equal? m1 10)
|
|||
|
|
(check-= d1 4.81 0.000001)
|
|||
|
|
;; custom
|
|||
|
|
(define jd2 (date-values->jd 2020 9 2.2236))
|
|||
|
|
(define-values [y2 m2 d2] (jd->date-values jd2))
|
|||
|
|
(check-equal? y2 2020)
|
|||
|
|
(check-equal? m2 9)
|
|||
|
|
(check-= d2 2.2236 0.000001))
|
|||
|
|
|