Commit 8a45b040 authored by Edward M. Reingold's avatar Edward M. Reingold
Browse files

Added code to support Chinese calendar.

parent 32933edb
;;; lunar.el --- calendar functions for phases of the moon.
;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar
......@@ -28,7 +28,8 @@
;; diary.el.
;; Based on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
;; Willmann-Bell, Inc., 1985.
;; Willmann-Bell, Inc., 1985 and ``Astronomical Algorithms'' by Jean Meeus,
;; Willmann-Bell, Inc., 1991.
;;
;; WARNING: The calculations will be accurate only to within a few minutes.
......@@ -167,7 +168,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
60.0 24.0)))
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (solar-adj-time-for-dst date time)))
(adj (dst-adjust-time date time)))
(list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
(defun lunar-phase-name (phase)
......@@ -247,6 +248,143 @@ This function is suitable for execution in a .emacs file."
(concat (lunar-phase-name (car (cdr (cdr phase)))) " "
(car (cdr phase))))))
;; For the Chinese calendar the calculations for the new moon need to be more
;; accurate than those above, so we use more terms in the approximation.
(defun lunar-new-moon-time (k)
"Astronomical (Julian) day number of K th new moon."
(let* ((T (/ k 1236.85))
(T2 (* T T))
(T3 (* T T T))
(T4 (* T2 T2))
(JDE (+ 2451550.09765
(* 29.530588853 k)
(* 0.0001337 T2)
(* -0.000000150 T3)
(* 0.00000000073 T4)))
(E (- 1 (* 0.002516 T) (* 0.0000074 T2)))
(sun-anomaly (+ 2.5534
(* 29.10535669 k)
(* -0.0000218 T2)
(* -0.00000011 T3)))
(moon-anomaly (+ 201.5643
(* 385.81693528 k)
(* 0.0107438 T2)
(* 0.00001239 T3)
(* -0.000000058 T4)))
(moon-argument (+ 160.7108
(* 390.67050274 k)
(* -0.0016341 T2)
(* -0.00000227 T3)
(* 0.000000011 T4)))
(omega (+ 124.7746
(* -1.56375580 k)
(* 0.0020691 T2)
(* 0.00000215 T3)))
(A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2)))
(A2 (+ 251.88 (* 0.016321 k)))
(A3 (+ 251.83 (* 26.641886 k)))
(A4 (+ 349.42 (* 36.412478 k)))
(A5 (+ 84.66 (* 18.206239 k)))
(A6 (+ 141.74 (* 53.303771 k)))
(A7 (+ 207.14 (* 2.453732 k)))
(A8 (+ 154.84 (* 7.306860 k)))
(A9 (+ 34.52 (* 27.261239 k)))
(A10 (+ 207.19 (* 0.121824 k)))
(A11 (+ 291.34 (* 1.844379 k)))
(A12 (+ 161.72 (* 24.198154 k)))
(A13 (+ 239.56 (* 25.513099 k)))
(A14 (+ 331.55 (* 3.592518 k)))
(correction
(+ (* -0.40720 (solar-sin-degrees moon-anomaly))
(* 0.17241 E (solar-sin-degrees sun-anomaly))
(* 0.01608 (solar-sin-degrees (* 2 moon-anomaly)))
(* 0.01039 (solar-sin-degrees (* 2 moon-argument)))
(* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly)))
(* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly)))
(* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly)))
(* -0.00111 (solar-sin-degrees
(- moon-anomaly (* 2 moon-argument))))
(* -0.00057 (solar-sin-degrees
(+ moon-anomaly (* 2 moon-argument))))
(* 0.00056 E (solar-sin-degrees
(+ (* 2 moon-anomaly) sun-anomaly)))
(* -0.00042 (solar-sin-degrees (* 3 moon-anomaly)))
(* 0.00042 E (solar-sin-degrees
(+ sun-anomaly (* 2 moon-argument))))
(* 0.00038 E (solar-sin-degrees
(- sun-anomaly (* 2 moon-argument))))
(* -0.00024 E (solar-sin-degrees
(- (* 2 moon-anomaly) sun-anomaly)))
(* -0.00017 (solar-sin-degrees omega))
(* -0.00007 (solar-sin-degrees
(+ moon-anomaly (* 2 sun-anomaly))))
(* 0.00004 (solar-sin-degrees
(- (* 2 moon-anomaly) (* 2 moon-argument))))
(* 0.00004 (solar-sin-degrees (* 3 sun-anomaly)))
(* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly
(* -2 moon-argument))))
(* 0.00003 (solar-sin-degrees
(+ (* 2 moon-anomaly) (* 2 moon-argument))))
(* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly
(* 2 moon-argument))))
(* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly
(* -2 moon-argument))))
(* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly
(* 2 moon-argument))))
(* -0.00002 (solar-sin-degrees
(+ (* 3 moon-anomaly) sun-anomaly)))
(* 0.00002 (solar-sin-degrees (* 4 moon-anomaly)))))
(additional
(+ (* 0.000325 (solar-sin-degrees A1))
(* 0.000165 (solar-sin-degrees A2))
(* 0.000164 (solar-sin-degrees A3))
(* 0.000126 (solar-sin-degrees A4))
(* 0.000110 (solar-sin-degrees A5))
(* 0.000062 (solar-sin-degrees A6))
(* 0.000060 (solar-sin-degrees A7))
(* 0.000056 (solar-sin-degrees A8))
(* 0.000047 (solar-sin-degrees A9))
(* 0.000042 (solar-sin-degrees A10))
(* 0.000040 (solar-sin-degrees A11))
(* 0.000037 (solar-sin-degrees A12))
(* 0.000035 (solar-sin-degrees A13))
(* 0.000023 (solar-sin-degrees A14))))
(newJDE (+ JDE correction additional)))
(+ newJDE
(- (solar-ephemeris-correction
(extract-calendar-year
(calendar-gregorian-from-absolute
(floor (calendar-absolute-from-astro newJDE))))))
(/ calendar-time-zone 60.0 24.0))))
(defun lunar-new-moon-on-or-after (d)
"Astronomical (Julian) day number of first new moon on or after astronomical
(Julian) day number d. The fractional part is the time of day.
The date and time are local time, including any daylight savings rules,
as governed by the values of calendar-daylight-savings-starts,
calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
calendar-time-zone."
(let* ((date (calendar-gregorian-from-absolute
(floor (calendar-absolute-from-astro d))))
(year (+ (extract-calendar-year date)
(/ (calendar-day-number date) 365.25)))
(k (floor (* (- year 2000.0) 12.3685)))
(date (lunar-new-moon-time k)))
(while (< date d)
(setq k (1+ k))
(setq date (lunar-new-moon-time k)))
(let* ((a-date (calendar-absolute-from-astro date))
(time (* 24 (- a-date (truncate a-date))))
(date (calendar-gregorian-from-absolute (truncate a-date)))
(adj (dst-adjust-time date time)))
(calendar-astro-from-absolute
(+ (calendar-absolute-from-gregorian (car adj))
(/ (car (cdr adj)) 24.0))))))
(provide 'lunar)
;;; lunar.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment