Emacs Lisp 计算数九天和伏天
第一个用 Emacs Lisp 实现的小功能。
Lisp 诞生于 1958 年,发明人是 John McCarthy,是目前仍在使用的第二古老的高级语言(最早的是 Fortran,诞生于 1957 年)。
Lisp 来源于 LISt Processing
(有调侃说是 Lots of Isolated Stupid Parentheses
),这个古老的语言和目前主流语言例如 C++,Python 和 Java 等有显著区别,下面是一段代码示例:
(defun cal-china-x-winter-solstice-date (date)
"Return winter solstice(冬至) date in Gregorian form.
If MONTH = 12, return current year's date
Else return last year's date"
(let* ((cyear (if (= (calendar-extract-month date) 12)
(calendar-extract-year date)
(1- (calendar-extract-year date)))))
(car (rassoc '"冬至" (cal-china-x-solar-term-alist-new cyear)))))
Emacs
也许是用 Lisp 编写的最著名的软件了。Emacs
自带了日历功能,cal-china-x
扩展实现了阴历、节气、生肖等的计算,但没有实现数九天和伏天的计算功能。正好借这个机会实现下功能,练练手。
数九天计算
数九天的计算相对比较简单。从冬至当天开始算一九第一天,每过九天加一九,一直到九九第九天。
思路也比较清楚,对于某一个 date
,先计算其与冬至的天数差。由于冬至始终在阳历的十二月,因此可以分情况讨论:
- 阳历非十二月,计算与去年冬至的天数差。
- 阳历为十二月,计算与今年冬至的天数差。此时若
date
在冬至前则差为负数,但负数情况可以不管,因为不属于数九天。
如果天数差在 0~80 天内,则需要显示数九天,具体显示格式为一九(1)
,整个代码如下:
(defconst cal-china-x-nine-characters ; 数九天 array
["一九" "二九" "三九" "四九" "五九" "六九" "七九" "八九" "九九"])
(defun cal-china-x-winter-solstice-date (date) ; 计算冬至日期(1-11月为去年,12月为今年)
"Return winter solstice(冬至) date in Gregorian form.
If MONTH = 12, return current year's date
Else return last year's date"
(let* ((cyear (if (= (calendar-extract-month date) 12)
(calendar-extract-year date)
(1- (calendar-extract-year date)))))
(car (rassoc '"冬至" (cal-china-x-solar-term-alist-new cyear)))))
(defun winter-solstice-day-diff (date) ; 计算与指定冬至的天数差
(cal-china-x-days-diff date (cal-china-x-winter-solstice-date date)))
(defun cal-china-x-get-several-nines-string (date) ; 生成数九天的 string
(let ((daygap (winter-solstice-day-diff date)))
(if (or (< daygap 0) (> daygap 80))
""
(concat (aref cal-china-x-nine-characters (/ daygap 9))
"("
(number-to-string (1+ (% daygap 9)))
")"
))))
伏天计算
民间有“头伏饺子二伏面,三伏烙饼摊鸡蛋”的习俗,看到这么多面食可以判断这基本是华北、黄淮一带的风俗。伏天计算比较复杂,原因是涉及到两个节气(夏至和立秋),以及每日的干支。具体计算方法是:
从夏至开始,依照干支纪日的排列,第3个庚日出现时,为初伏第一天(夏至三庚数头伏),第4个庚日为中伏第一天,立秋后第1个庚日为末伏第一天。当夏至与立秋之间出现4个庚日时中伏为10天,出现5个庚日则为20天。
(defun cal-china-x-solar-term-date (date solar-term)
"Return solar-term date in Gregorian form."
(let* ((cyear (calendar-extract-year date)))
(car (rassoc solar-term (cal-china-x-solar-term-alist-new cyear)))))
(defun cal-china-x-chinese-day-celestial-stem-number (date)
"String of Chinese date of Gregorian DATE.
Defaults to today's date if DATE is not given."
(let* ((a-date (calendar-absolute-from-gregorian date)))
(% (+ a-date 15) 10)))
(defun cal-china-x-solar-term-celestical-stem (date solar-term)
(cal-china-x-chinese-day-celestial-stem-number
(cal-china-x-solar-term-date date solar-term)))
(defun cal-china-x-day-diff-from-solar-term (date solar-term) ; 庚日
(let ((ss-stem (- 7 (cal-china-x-solar-term-celestical-stem date solar-term))))
(if (< ss-stem 0) (+ ss-stem 10)
ss-stem)))
(defun cal-china-x-chufu-date (date)
(let* ((ss-date (cal-china-x-solar-term-date date "夏至"))
(ss-year (calendar-extract-year ss-date))
(ss-day (calendar-extract-day ss-date))
(day-diff (+ 20 (cal-china-x-day-diff-from-solar-term date "夏至")))
(chufu-day (- day-diff (- 30 ss-day))))
(list 7 chufu-day ss-year)))
(defun cal-china-x-zhongfu-date (date)
(list 7 (+ (calendar-extract-day (cal-china-x-chufu-date date)) 10)
(calendar-extract-year date)))
(defun cal-china-x-mofu-date (date)
(let* ((ss-date (cal-china-x-solar-term-date date "立秋"))
(ss-year (calendar-extract-year ss-date))
(ss-day (calendar-extract-day ss-date))
(day-diff (cal-china-x-day-diff-from-solar-term date "立秋"))
(mofu-day (+ day-diff ss-day)))
(list 8 mofu-day ss-year)))
(defun cal-china-x-get-futian-string (date)
(let* ((chufu (cal-china-x-chufu-date date))
(zhongfu (cal-china-x-zhongfu-date date))
(mofu (cal-china-x-mofu-date date))
(chufu-gap (cal-china-x-days-diff date chufu))
(zhongfu-gap (cal-china-x-days-diff date zhongfu))
(mofu-gap (cal-china-x-days-diff date mofu))
)
(if (or (< chufu-gap 0) (> mofu-gap 9))
""
(if (and (>= chufu-gap 0) (< zhongfu-gap 0))
(concat "初伏("
(number-to-string (1+ chufu-gap))
")")
(if (and (>= zhongfu-gap 0) (< mofu-gap 0))
(concat "中伏("
(number-to-string (1+ zhongfu-gap))
")")
(concat "末伏("
(number-to-string (1+ mofu-gap))
")"))))))
注意如果夏至当天是庚日,则算第一个庚日,相当于初伏在夏至20天之后。
另外,cal-china-x
中月和日的天干地支计算有点问题,需要用 Emacs
自带的计算。