From 67d801733c477e0601bb06d566db1edfacae932f Mon Sep 17 00:00:00 2001 From: "Edward M. Reingold" Date: Tue, 24 Oct 1995 15:44:12 +0000 Subject: [PATCH] Various fixes and simplifications. --- lisp/calendar/cal-china.el | 136 +++++++++++++++---------------------- 1 file changed, 53 insertions(+), 83 deletions(-) diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 59c6d061a18..df6c19534a0 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -29,12 +29,12 @@ ;; used for the Chinese calendar are those of Baolin Liu (see L. E. Doggett's ;; article "Calendars" in the Explanatory Supplement to the Astronomical ;; Almanac, second edition, 1992) for the calendar as revised at the beginning -;; of the Qing dynasty in 1644. Liu's rules produce a calendar for 2033 which -;; is not accepted by all authorities. Furthermore, the nature of the -;; astronomical calculations is such that precise calculations cannot be made -;; without great expense in time, so that the calendars produced may not agree -;; perfectly with published tables--but no two pairs of published tables agree -;; perfectly either! +;; of the Qing dynasty in 1644. The nature of the astronomical calculations +;; is such that precise calculations cannot be made without great expense in +;; time, so that the calendars produced may not agree perfectly with published +;; tables--but no two pairs of published tables agree perfectly either! Liu's +;; rules produce a calendar for 2033 which is not accepted by all authorities. +;; The date of Chinese New Year is correct from 1644-2051. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science @@ -64,10 +64,7 @@ UT+7:45:40 to UT+8.") (defvar chinese-calendar-location-name "Beijing" "*Name of location used for calculation of Chinese calendar.") -(defvar chinese-calendar-daylight-time-offset 0 -; The correct value is as follows, but I don't believe the Chinese calendrical -; authorities would use DST in determining astronomical events: -; 60 +(defvar chinese-calendar-daylight-time-offset 60 "*Number of minutes difference between daylight savings and standard time for Chinese calendar. Default is for no daylight savings time.") @@ -80,20 +77,16 @@ for Chinese calendar. Default is for no daylight savings time.") (defvar chinese-calendar-daylight-time-zone-name "CDT" "*Abbreviated name of daylight-savings time zone used for Chinese calendar.") -(defvar chinese-calendar-daylight-savings-starts nil -; The correct value is as follows, but I don't believe the Chinese calendrical -; authorities would use DST in determining astronomical events: -; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) -; ((= 1986 year) '(5 4 1986)) -; (t nil)) +(defvar chinese-calendar-daylight-savings-starts + '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) + ((= 1986 year) '(5 4 1986)) + (t nil)) "*Sexp giving the date on which daylight savings time starts for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-starts'.") -(defvar chinese-calendar-daylight-savings-ends nil -; The correct value is as follows, but I don't believe the Chinese calendrical -; authorities would use DST in determining astronomical events: -; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) +(defvar chinese-calendar-daylight-savings-ends + '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) "*Sexp giving the date on which daylight savings time ends for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-ends'.") @@ -159,7 +152,7 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees." (defvar chinese-year-cache '((1989 (12 . 726110) (1 . 726139) (2 . 726169) (3 . 726198) (4 . 726227) (5 . 726257) (6 . 726286) (7 . 726316) (8 . 726345) (9 . 726375) - (10 . 726404) (11 . 726434)) + (10 . 726404) (11 . 726434)) (1990 (12 . 726464) (1 . 726494) (2 . 726523) (3 . 726553) (4 . 726582) (5 . 726611) (5.5 . 726641) (6 . 726670) (7 . 726699) (8 . 726729) (9 . 726758) (10 . 726788) (11 . 726818)) @@ -214,30 +207,31 @@ The list is cached for further use." (append chinese-year-cache (list (cons y list)))))) list)) -(defun number-chinese-months (list start &optional no-leap-months) +(defun number-chinese-months (list start) "Assign month numbers to the lunar months in LIST, starting with START. +Numbers are assigned sequentially, START, START+1, ..., 11, with half +numbers used for leap months. If optional parameter NO-LEAP-MONTHS is true, just number the months sequentially, ignoring the usual leap month rule. -First month of list will never be a leap month, nor will the last. - -Numbers are assigned sequentially mod 12 (but using 12 instead of 0)." +First month of list will never be a leap month, nor will the last." (if list - (if no-leap-months - (cons (cons (calendar-mod start 12) (car list)) - (number-chinese-months (cdr list) (1+ start) t)) + (if (zerop (- 12 start (length list))) + ;; List is too short for a leap month + (cons (cons start (car list)) + (number-chinese-months (cdr list) (1+ start))) (cons - ;; first month - (cons (calendar-mod start 12) (car list)) - ;; remaining months + ;; First month + (cons start (car list)) + ;; Remaining months (if (and (cdr (cdr list));; at least two more months... - ;; ... and next one is a leap month (<= (car (cdr (cdr list))) (chinese-zodiac-sign-on-or-after (car (cdr list))))) - (cons (cons (+ (calendar-mod start 12) 0.5) (car (cdr list))) - (number-chinese-months (cdr (cdr list)) (1+ start) t)) - ;; Otherwise, just number the months + ;; Next month is a leap month + (cons (cons (+ start 0.5) (car (cdr list))) + (number-chinese-months (cdr (cdr list)) (1+ start))) + ;; Next month is not a leap month (number-chinese-months (cdr list) (1+ start))))))) (defun chinese-month-list (start end) @@ -248,18 +242,6 @@ Numbers are assigned sequentially mod 12 (but using 12 instead of 0)." (append (list new-moon) (chinese-month-list (1+ new-moon) end)))))) -(defun chinese-leap-months (list low high) - "Return list of leap months in LIST with indices in range LOW to HIGH. - -A leap month has a non-integer index." - (if list - (let ((index (car (car list)))) - (if (and (/= index (floor index)) - (<= low index) - (<= index high)) - (cons index (chinese-leap-months (cdr list) low high)) - (chinese-leap-months (cdr list) low high))))) - (defun compute-chinese-year (y) "Compute the structure of the Chinese year for Gregorian year Y. The result is a list of pairs (i . d), where month i begins on absolute date d, @@ -271,43 +253,28 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after (calendar-absolute-from-gregorian (list 12 15 (1- y))))) - next-solstice))) + next-solstice)) + (next-sign (chinese-zodiac-sign-on-or-after (car list)))) (if (= (length list) 12) ;; No room for a leap month, just number them 12, 1, 2, ..., 11 - (number-chinese-months list 0 t) - (let* ((had-leap-month (chinese-leap-months (chinese-year (1- y)) 1 10)) - (numbered-list) - (next-sign;; On or after first month on list - (chinese-zodiac-sign-on-or-after (car list)))) - ;; Now we can assign numbers to the list for y - ;; The first month or two are special - (if (and (<= (car list) next-sign) (< next-sign (car (cdr list)))) - (progn;; First month on list is not a leap month - (setq numbered-list (list (cons 12 (car list)))) - (setq list (cdr list)) - (setq next-sign (chinese-zodiac-sign-on-or-after (car list)))) - ;; First month on list might be a leap month... - (if (not had-leap-month);; ... it is a leap month - (progn;; First month on list is a leap month, so second is not - (setq numbered-list (list (cons 11.5 (car list)) - (cons 12 (car (cdr list))))) - (setq list (cdr (cdr list))) - (setq had-leap-month t)))) - (if (and (>= next-sign (car (cdr list))) - (not had-leap-month)) - (progn;; Second month on list is a leap month - (setq numbered-list - (append numbered-list (list (cons 12.5 (car list))))) - (setq list (cdr list)))) - ;; At this point we have a list of new moons for months 1 to 11 for y. - ;; We need to see which are leap months. - (if (= (length list) 11) - ;; There can be no leap months, just number them 1..11 - (append numbered-list (number-chinese-months list 1 t)) - ;; There is a leap month, but it can't be the first one because that - ;; would be 12.5 which we already considered. It also can't be the - ;; last one because that has the solstice in it. - (append numbered-list (number-chinese-months list 1))))))) + (cons (cons 12 (car list)) + (number-chinese-months (cdr list) 1)) + ;; Now we can assign numbers to the list for y + ;; The first month or two are special + (if (or (> (car list) next-sign) (>= next-sign (car (cdr list)))) + ;; First month on list is a leap month, second is not + (append (list (cons 11.5 (car list)) + (cons 12 (car (cdr list)))) + (number-chinese-months (cdr (cdr list)) 1)) + ;; First month on list is not a leap month + (append (list (cons 12 (car list))) + (if (>= (chinese-zodiac-sign-on-or-after (car (cdr list))) + (car (cdr (cdr list)))) + ;; Second month on list is a leap month + (list (cons 12.5 (car (cdr list))) + (number-chinese-months (cdr (cdr list)) 1)) + ;; Second month on list is not a leap month + (number-chinese-months (cdr list) 1))))))) (defun calendar-absolute-from-chinese (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. @@ -374,7 +341,10 @@ Defaults to today's date if DATE is not given." (this-month (calendar-absolute-from-chinese (list cycle year month 1))) (next-month (calendar-absolute-from-chinese - (list cycle year (1+ (floor month)) 1))) + (list (if (= year 60) (1+ cycle) cycle) + (if (= (floor month) 12) (1+ year) year) + (calendar-mod (1+ (floor month)) 12) + 1))) (m-cycle (% (+ (* year 5) (floor month)) 60))) (format "Cycle %s, year %s (%s-%s), %smonth %s, day %s (%s-%s)" cycle -- 2.39.2