Emacs Lisp 计算数九天和伏天

第一个用 Emacs Lisp 实现的小功能。

Lisp 诞生于 1958 年，发明人是 John McCarthy，是目前仍在使用的第二古老的高级语言(最早的是 Fortran，诞生于 1957 年)。

Lisp 来源于 LISt Processing(有调侃说是 Lots of Isolated Stupid Parentheses)，这个古老的语言和目前主流语言例如 C++，Python 和 Java 等有显著区别，下面是一段代码示例：

1
2
3
4
5
6
7
8
9
(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)，整个代码如下：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
(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天。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
(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 自带的计算。

留言

2018-07-18
▲