compact-number-list

ここに書かれているcompact-number-listという関数をcommon lispで実装してみた。

(defun compact-number-list (list &aux (beg (car list)))
  (labels ((get-end (num list &optional (sole? t))
             (if (eql (1+ num) (car list)) ; XXX: 数値の比較とlistのnilチェックをまとめて行っているので、(行数は節約できるが)若干非効率
                 (get-end (car list) (cdr list) nil)
               (values num list sole?))))
    (when (consp list)
      (multiple-value-bind (end rest sole?) (get-end beg (cdr list))
        (cons (if sole? beg `(,beg . ,end))
              (compact-number-list rest))))))

;;
> (compact-number-list '(1 2 3 4 5 10 20 21))
--> ((1 . 5) 10 (20 . 21))

追記: iterate版

iterateを使ったバージョンを追加。
実質的にはほとんど変わっていないが、ループ(マップ)部分が、iterateによって抽象化(?)されている。

実行部分:

(require :iterate)
(use-package :iterate)

;; compact-number-list
> (iter (for (beg end) on-number-list '(1 2 3 4 10 11 20))
        (collect (if (= beg end) beg `(,beg . ,end))))
--> ((1 . 4) (10 . 11) 20)

準備部分:

(defun gen-compact-number-fn (list)
  (lambda (&aux (beg (car list)))
    (labels ((get-end (num list)
               (if (eql (1+ num) (car list))
                   (get-end (car list) (cdr list))
                 (values num list))))
      (when (consp list)
        (multiple-value-bind (end rest) (get-end beg (cdr list))
          (setf list rest)
          (list beg end))))))

(defmacro-driver (FOR var ON-NUMBER-LIST list)
  (declare (ignorable generate))
  `(progn
     (if (first-time-p) (for #1=#:next-fn = (gen-compact-number-fn ,list)))
     (for ,var next (or (funcall #1#) (terminate)))))