date arithmetic / map function_datearithmetic-优快云博客

本文介绍了一种将日期（年、月、日）转换为天数，以及将天数转换回日期的算法实现。此外，还提供了判断闰年的方法，并展示了如何使用Lisp语言中的多种列表处理函数来辅助计算。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

由date转化得到具体的天数

(defconstant month
  #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defconstant yzero 2000)

;;能够被4整除，并且要么是能够被400整除。要么是不能够被100整除。
(defun leap? (y)
  (and (zerop (mod y 4))
       (or (zerop (mod y 400))
           (not (zerop (mod y 100))))))


(defun date->num (d m y)
  (+ (- d 1) (month-num m y) (year-num y)))

(defun month-num (m y)
  (+ (svref month (- m 1))
     (if (and (> m 2) (leap? y)) 1 0))) ;;如果大于二月并且是leap则加1

(defun year-num (y)
  (let ((d 0))
    (if (>= y yzero)
        (dotimes (i (- y yzero) d)
          (incf d (year-days (+ yzero i))))
        (dotimes (i (- yzero y) (- d))   ;;它返回一个负数。比如1998年，他会求出99+98天数，去掉已经度过的就是到2000所需天数。
          (incf d (year-days (+ y i)))))))

(defun year-days (y) (if (leap? y) 366 365))

;;;由天数转化成对应的年月日
(defun num->date (n)
  (multiple-value-bind (y left) (num-year n)  ;;返回两个值，
    (multiple-value-bind (m d) (num-month left y)
      (values d m y))))

(defun num-year (n)
  (if (< n 0)
      (do* ((y (- yzero 1) (- y 1))
            (d (- (year-days y)) (- d (year-days y))))
           ((<= d n) (values y (- n d))))
      (do* ((y yzero (+ y 1))                ;;因为是do*所以前面定义的变量，后面可以使用。
            (prev 0 d)                       ;;prev存起来上一轮的值，为了当前轮减去上一轮的时间。
            (d (year-days y) (+ d (year-days y))))
           ((> d n) (values y (- n prev))))))

(defun num-month (n y)
  (if (leap? y)
      (cond ((= n 59) (values 2 29))
            ((> n 59) (nmon (- n 1)))
            (t        (nmon n)))
      (nmon n)))

(defun nmon (n)
  (let ((m (position n month :test #'<))) 
    (values m (+ 1 (- n (svref month (- m 1)))))))

;;which can add or subtract days from a date
(defun date+ (d m y n)   
  (num->date (+ (date->num d m y) n)))

下面是求每年开始到某有的天数

CL-USER> (setf mon '(31 28 31 30 31 30 31 31 30 31 30 31))
(31 28 31 30 31 30 31 31 30 31 30 31)
CL-USER> (setf nom (reverse mon))
(31 30 31 30 31 31 30 31 30 31 28 31)
CL-USER> (setf sums (maplist #'(lambda (x)
				 (apply #'+ x))
			     nom))
(365 334 304 273 243 212 181 151 120 90 59 31)
CL-USER> (reverse sums)
(31 59 90 120 151 181 212 243 273 304 334 365)

关键是理解maplist的用法，

(maplist function prolist forest prolists)

它后面可以跟多个list形式，首先他会以最短的那个列表为标准，然后所有的列表一起调用function方法。然后每个列表的cdr在接着一起调用function。直到最短的那个列表的值用完。显然这个function是可以接受很多个参数的函数。对于本例它先是对所有的数字调用+，然后它的cdr调用+

(mapc function prolist &rest prolists) If the shortest prolist has n elements, calls function h times: first on the first element of each prolist, and last on the nth element of each prolist. Returns prolist.

(mapcan function prolist &rest prolists) Equivalent to applying nconc to the result of calling mapcar with the same arguments.

(mapcar function prolist &rest prolists) If the shortest prolist has n elements, calls function n times: first on the first element of each prolist, and last on the «th element of each prolist. Returns a list of the values returned by function.

(mapcon function prolist &rest prolists) Equivalent to applying nconc to the result of calling maplist with the same arguments.

(mapl function prolist &rest prolists) If the shortest prolist has n elements, calls function n times: first on each prolist, and last on the (n — l)th cdr of each prolist. Returns prolist.

(maplist function prolist forest prolists) If the shortest prolist has n elements, calls function n times: first on each prolist, and last on the (n — 1) th cdr of each prolist. Returns a list of the values returned by function.

(nconc &rest (lists)) Function Returns a list whose elements are the elements of each list, in order. Works by setting the cdr of the last cons in each list to the succeeding list. The final argument can be an object of any type. Returns n i l if given no arguments.它会返回一个包含list中所有元素的列表。通过使每个列表的最后一个cdr指向下一个列表的方式来实现。

CL-USER> (mapc (lambda (p q)
		 (format t "~a - ~a ~%" p q)) '(9 8 7) '(3 4 5))
9 - 3 
8 - 4 
7 - 5 
(9 8 7)

CL-USER> (mapcar #'+ '(1 2 4) '(1 2 3 4) '(8 7))
(10 11)
202
CL-USER> (mapcan #'list
	  '(a b c)
	  '(1 2 3 4))
(A 1 B 2 C 3)
CL-USER>  (mapcar #'list
	  '(a b c)
	  '(1 2 3 4))
((A 1) (B 2) (C 3))
CL-USER> (maplist #'list
	  '(a b c)
	  '(1 2 3 4))
(((A B C) (1 2 3 4)) ((B C) (2 3 4)) ((C) (3 4)))
CL-USER> (mapcon #'list
	  '(a b c)
	  '(1 2 3 4))
((A B C) (1 2 3 4) (B C) (2 3 4) (C) (3 4))
CL-USER> (nconc '(1 2) '(4 5))
(1 2 4 5)

关键是理解如何实现nconc的。下图是描述((A 1) (B 2) (C 3)) --> (A 1 B 2 C 3)，同理可以得到 (((A B C) (1 2 3 4)) ((B C) (2 3 4)) ((C) (3 4)))-->((A B C) (1 2 3 4) (B C) (2 3 4) (C) (3 4))的原因。其实用一个列表的最后一个cdr连接后面单元，实际上就是减少一层括号。