お気楽 Common Lisp プログラミング入門

deque

「双方向リスト (doubly-linked list)」と、それを使って実装した「両端キュー (deque)」を操作するライブラリです。双方向リストの説明は拙作のページ CLOS 入門: 双方向リストをお読みください。

●インストール

アーカイブファイル minlib.tar.gz をインストールする、またはプログラムリストにある以下の 4 つのファイルを、~/common-lisp/ 以下の適当なサブディレクトリ (たとえば deque など) に配置してください。

deque.lisp
deque.asd
deque_tst.lisp
deque_tst.asd

●仕様

パッケージ名 :deque

双方向リスト
データ型: dlist
基本的な操作
make-dlist => dlist
dlist の生成
dlist-p d => t or nil
引数 d が dlist 型ならば真を返す
dlist-count d => integer
dlist の要素数を返す
dlist-emptyp d => t or nil
dlist が空ならば真を返す
dlist-clear d => 0
dlist を空にする
dlist-insert-at d n x &key from-end => x
n 番目にデータ x を挿入する
dlist-nth d n &key from-end => x
n 番目のデータを参照する
dlist-set d n x &key from-end => x
n 番目のデータを x に書き換える
dlist-delete-at d n &key from-end => deleted-data
n 番目のデータを削除する
list->dlist xs => dlist
リスト xs を dlist に変換する
dlist->list d => list
dlist を list に変換する

データの探索
dlist-exists d x &key key test => t or nil
双方向リスト d に x と等しい (デフォルトは eql) 要素があれば真を返す
dlist-find d x &key key test from-end => item
双方向リスト d に x と等しい要素 item があれば、最初に見つけたものを返す
dlist-find-if d pred &key key from-end => item
双方向リスト d に述語 pred が真を返す要素 item があれば、最初に見つけたものを返す
dlist-find-if-not d pred &key key from-end => item
双方向リスト d に述語 pred が偽を返す要素 item があれば、最初に見つけたものを返す

データの削除
dlist-delete d x &key key test from-end count => dlist
双方向リスト d から x と等しい要素を削除する
dlist-delete-if d pred &key key from-end count => dlist
双方向リスト d から述語 pred が真を返す要素を削除する
dlist-find-if-not d pred &key key from-end count => dlist
双方向リスト d から述語 pred が偽を返す要素を削除する
:count に正整数を渡すと、その個数だけ削除する

高階関数
dlist-mapc d fn => nil
dlist の要素に関数 fn を適用する
dlist-fold d func init &key from-end => value
dlist の要素を関数 fn で畳み込む
dlist-iterator d => iter
イテレータを生成する

両端キュー
データ型: deque
deque-p d => t or nil
引数 d が deque 型ならば真を返す
push-front d x => x
ディーキュー d の先頭にデータ x を追加する
push-back d x => x
ディーキュー d の末尾にデータ x を追加する
pop-front d => x
ディーキュー d の先頭からデータ x を取り出す
pop-back d => x
ディーキュー d の末尾からデータ x を取り出す
peek-front d => x
ディーキュー d の先頭にあるデータ x を返す
peek-back d => x
ディーキュー d の末尾にあるデータ x を返す
deque-clear d => 0
ディーキュー d を空にする
deque-count d => integer
ディーキュー d に格納されている要素数を返す
deque-emptyp d => t or nil
ディーキュー d が空ならば t を返す

●簡単なテスト

* (asdf:test-system :deque)
; compiling file ... 略 ...

----- test start -----

(DLIST-P (SETQ D (MAKE-DLIST)))
=> T OK

(DLIST-EMPTYP D)
=> T OK

(DLIST-COUNT D)
=> 0 OK

(DLIST-INSERT-AT D 0 1)
=> 1 OK

(DLIST-EMPTYP D)
=> NIL OK

(DLIST-COUNT D)
=> 1 OK

(DLIST-NTH D 0)
=> 1 OK

(DLIST-NTH D 0 FROM-END T)
=> 1 OK

(DOLIST (X '(2 3 4) (DLIST-COUNT D)) (DLIST-INSERT-AT D 0 X FROM-END T))
=> 4 OK

(DOLIST (X '(5 6 7 8) (DLIST-COUNT D)) (DLIST-INSERT-AT D 0 X))
=> 8 OK

(LET ((A NIL))
  (DOTIMES (X (DLIST-COUNT D) A) (PUSH (DLIST-NTH D X) A)))
=> (4 3 2 1 5 6 7 8) OK

(LET ((A NIL))
  (DOTIMES (X (DLIST-COUNT D) A) (PUSH (DLIST-NTH D X FROM-END T) A)))
=> (8 7 6 5 1 2 3 4) OK

(LET ((A NIL))
  (DLIST-MAPC D (LAMBDA (X) (PUSH X A)))
  A)
=> (4 3 2 1 5 6 7 8) OK

(LET ((A NIL))
  (DLIST-MAPC D (LAMBDA (X) (PUSH X A)) FROM-END T)
  A)
=> (8 7 6 5 1 2 3 4) OK

(DLIST-DELETE-AT D 0)
=> 8 OK

(DLIST-DELETE-AT D 0 FROM-END T)
=> 4 OK

(DLIST-DELETE-AT D 2)
=> 5 OK

(DLIST-DELETE-AT D 2 FROM-END T)
=> 1 OK

(DLIST->LIST D)
=> (7 6 2 3) OK

(DLIST-COUNT D)
=> 4 OK

(DLIST-FOLD D (LAMBDA (A X) (CONS X A)) NIL)
=> (3 2 6 7) OK

(DLIST-FOLD D #'CONS NIL FROM-END T)
=> (7 6 2 3) OK

(DOTIMES (X (DLIST-COUNT D) (DLIST->LIST D)) (DLIST-SET D X X))
=> (0 1 2 3) OK

(DOTIMES (X (DLIST-COUNT D) (DLIST->LIST D)) (DLIST-SET D X X FROM-END T))
=> (3 2 1 0) OK

(DLIST-CLEAR D)
=> 0 OK

(DLIST-EMPTYP D)
=> T OK

(DLIST-COUNT D)
=> 0 OK

(DLIST-COUNT (SETQ D (LIST->DLIST '((1 2) (3 4) (5 6)))))
=> 3 OK

(DLIST-EXISTS D 3)
=> NIL OK

(DLIST-EXISTS D (LIST 3 4))
=> NIL OK

(DLIST-EXISTS D (LIST 3 4) TEST #'EQUAL)
=> T OK

(DLIST-FIND D 4 KEY #'CAR)
=> NIL OK

(DLIST-FIND D 4 KEY #'SECOND)
=> (3 4) OK

(DLIST-FIND-IF D #'EVENP KEY #'CAR)
=> NIL OK

(DLIST-FIND-IF D #'EVENP KEY #'SECOND)
=> (1 2) OK

(DLIST-FIND-IF D #'EVENP KEY #'SECOND FROM-END T)
=> (5 6) OK

(DLIST-FIND-IF-NOT D #'EVENP KEY #'CAR)
=> (1 2) OK

(DLIST-FIND-IF-NOT D #'EVENP KEY #'SECOND)
=> NIL OK

(DLIST-FIND-IF-NOT D #'EVENP KEY #'CAR FROM-END T)
=> (5 6) OK

(DLIST-COUNT (SETQ D (LIST->DLIST '(1 2 3 1 2 3 1 2 3))))
=> 9 OK

(DLIST->LIST (DLIST-DELETE D 1))
=> (2 3 2 3 2 3) OK

(DLIST-COUNT D)
=> 6 OK

(DLIST->LIST (DLIST-DELETE D 2 COUNT 1))
=> (3 2 3 2 3) OK

(DLIST-COUNT D)
=> 5 OK

(DLIST->LIST (DLIST-DELETE D 2 COUNT 1 FROM-END T))
=> (3 2 3 3) OK

(DLIST-COUNT D)
=> 4 OK

(DLIST-COUNT (SETQ D (LIST->DLIST '(1 2 3 4 5 6))))
=> 6 OK

(DLIST->LIST (DLIST-DELETE-IF D #'EVENP))
=> (1 3 5) OK

(DLIST-COUNT D)
=> 3 OK

(DLIST-COUNT (SETQ D (LIST->DLIST '(1 2 3 4 5 6))))
=> 6 OK

(DLIST->LIST (DLIST-DELETE-IF-NOT D #'EVENP))
=> (2 4 6) OK

(DLIST-COUNT D)
=> 3 OK

(DOLIST (X '(2 4 6) (DLIST-EMPTYP D)) (DLIST-DELETE D X))
=> T OK

(DEQUE-P (SETQ Q (MAKE-DEQUE)))
=> T OK

(DEQUE-EMPTYP Q)
=> T OK

(DEQUE-COUNT Q)
=> 0 OK

(PUSH-FRONT Q 1)
=> 1 OK

(DEQUE-EMPTYP Q)
=> NIL OK

(DEQUE-COUNT Q)
=> 1 OK

(PUSH-BACK Q 10)
=> 10 OK

(DEQUE-EMPTYP Q)
=> NIL OK

(DEQUE-COUNT Q)
=> 2 OK

(PEEK-FRONT Q)
=> 1 OK

(PEEK-BACK Q)
=> 10 OK

(DOLIST (X '(2 3 4) (DEQUE-COUNT Q)) (PUSH-FRONT Q X))
=> 5 OK

(DOLIST (X '(20 30 40) (DEQUE-COUNT Q)) (PUSH-BACK Q X))
=> 8 OK

(PEEK-FRONT Q)
=> 4 OK

(PEEK-BACK Q)
=> 40 OK

(LET ((A NIL))
  (DOTIMES (X 4 A) (PUSH (POP-FRONT Q) A)))
=> (1 2 3 4) OK

(LET ((A NIL))
  (DOTIMES (X 4 A) (PUSH (POP-BACK Q) A)))
=> (10 20 30 40) OK

(DEQUE-EMPTYP Q)
=> T OK

(DEQUE-COUNT Q)
=> 0 OK

(PUSH-FRONT Q 10)
=> 10 OK

(DEQUE-CLEAR Q)
=> 0 OK

(DEQUE-COUNT Q)
=> 0 OK

(DEQUE-EMPTYP Q)
=> T OK

----- test end -----
TEST: 76
OK: 76
NG: 0
ERR: 0
T

●サンプルプログラム

;;;
;;; sample_deque.lisp : deque のサンプルプログラム
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(require :deque)
(use-package :deque)

;;;
;;; 経路の探索
;;; リストのほうが簡単だが、あえて dlist を使ってみた
;;;

;;; 隣接リスト
(defvar *adjacent*
  '((A B C)
    (B A C D)
    (C A B E)
    (D B E F)
    (E C D G)
    (F D)
    (G E)))

;;; パスの表示
(defun print-path (path)
  (format t "~S~%" (dlist->list path)))

;;; 深さ優先探索
(defun depth-first-search (goal path)
  (let ((p (dlist-nth path 0 :from-end t)))
    (if (eq p goal)
        (print-path path)
      (dolist (x (cdr (assoc p *adjacent*)))
        (unless (dlist-exists path x)
          (dlist-insert-at path 0 x :from-end t)
          (depth-first-search goal path)
          (dlist-delete-at path 0 :from-end t))))))

;;; 幅優先探索
(defun breadth-first-search (start goal)
  (let ((q (make-deque)))
    (push-back q (list start))
    (loop
     (if (deque-emptyp q) (return))
     (let ((path (pop-front q)))
       (if (eq (car path) goal)
           (print (reverse path))
         (dolist (x (cdr (assoc (car path) *adjacent*)))
           (unless (member x path)
             (push-back q (cons x path)))))))))

;;; 反復深化用深さ優先探索
(defun dfs (limit goal path)
  (let ((p (dlist-nth path 0 :from-end t)))
    (if (= (dlist-count path) limit)
        (when (eq p goal)
          (print-path path))
      (dolist (x (cdr (assoc p *adjacent*)))
        (unless (dlist-exists path x)
          (dlist-insert-at path 0 x :from-end t)
          (dfs limit goal path)
          (dlist-delete-at path 0 :from-end t))))))

;;; 反復深化
(defun id-search (start goal)
  (do ((i 2 (1+ i)))
      ((> i 7))
      (format t "----- ~d -----~%" i)
      (dfs i goal (list->dlist (list start)))))

* (load "sample_deque.lisp")
T

* (depth-first-search 'g (list->dlist '(a)))
(A B C E G)
(A B D E G)
(A C B D E G)
(A C E G)
NIL

* (breadth-first-search 'a 'g)

(A C E G)
(A B C E G)
(A B D E G)
(A C B D E G)
NIL

* (id-search 'a 'g)
----- 2 -----
----- 3 -----
----- 4 -----
(A C E G)
----- 5 -----
(A B C E G)
(A B D E G)
----- 6 -----
(A C B D E G)
----- 7 -----
NIL

●プログラムリスト

;;;
;;; deque.lisp : 両端キューと双方向リスト
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :deque)
(defpackage :deque (:use :cl))
(in-package :deque)
(export '(dlist dlist-p make-dlist dlist-emptyp dlist-count dlist-clear
          dlist-nth dlist-set dlist-insert-at dlist-delete-at
          dlist-exists dlist-find dlist-find-if dlist-find-if-not
          dlist-delete dlist-delete-if dlist-delete-if-not
          dlist-fold list->dlist dlist->list
          dlist-mapc dlist-iterator
          deque deque-p make-deque
          push-front push-back
          pop-front pop-back
          peek-front peek-back
          deque-count deque-clear deque-emptyp))

;;; セルの定義
(defstruct cell (item nil) (next nil) (prev nil))

;;; 空リストの生成
(defun make-empty ()
  (let ((cp (make-cell)))
    (setf (cell-next cp) cp
          (cell-prev cp) cp)
    cp))

;;; 双方向リストクラスの定義
(defstruct dlist (top (make-empty)) (size 0))

;;; n 番目のセルを求める (操作用関数)
(defun cell-nth (d n iter)
  (do ((i -1 (1+ i))
       (cp (dlist-top d) (funcall iter cp)))
      ((= i n) cp)
    (if (and (<= 0 i) (eq (dlist-top d) cp))
        (error "cell-nth --- oops!"))))

;;; 参照
(defun dlist-nth (d n &key (from-end nil))
  (cell-item (cell-nth d n (if from-end #'cell-prev #'cell-next))))

;;; 書き換え
(defun dlist-set (d n value &key (from-end nil))
  (setf (cell-item (cell-nth d n (if from-end #'cell-prev #'cell-next)))
        value))

;;;
;;; 探索
;;;
(defun dlist-exists (d x &key (key #'identity) (test #'eql))
  (do ((cp (cell-next (dlist-top d)) (cell-next cp)))
      ((eq (dlist-top d) cp))
      (when (funcall test (funcall key (cell-item cp)) x)
        (return t))))

(defun dlist-find (d x &key (key #'identity) (test #'eql) (from-end nil))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp))
        (when (funcall test (funcall key (cell-item cp)) x)
          (return (cell-item cp))))))

(defun dlist-find-if (d pred &key (key #'identity) (from-end nil))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp))
        (when (funcall pred (funcall key (cell-item cp)))
          (return (cell-item cp))))))

(defun dlist-find-if-not (d pred &key (key #'identity) (from-end nil))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp))
        (unless (funcall pred (funcall key (cell-item cp)))
          (return (cell-item cp))))))


;;; セルの挿入
;;; p - next -> cp - next -> q
(defun cell-insert (p cp q)
  (setf (cell-next cp) q
        (cell-prev cp) p
        (cell-prev q) cp
        (cell-next p) cp))

;;; 挿入
(defun dlist-insert-at (d n value &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (p (cell-nth d (1- n) iter))
         (q (funcall iter p))
         (cp (make-cell :item value)))
    (if from-end
        (cell-insert q cp p)
      (cell-insert p cp q))
    (incf (dlist-size d))
    value))

;;; セルの削除
;;; p - next -> [cp] - next -> q
(defun cell-delete (p q)
  (setf (cell-next p) q
        (cell-prev q) p))

;;; 削除
(defun dlist-delete-at (d n &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (p  (cell-nth d (1- n) iter))
         (cp (funcall iter p))
         (q  (funcall iter cp)))
    (if from-end (cell-delete q p) (cell-delete p q))
    (decf (dlist-size d))
    (cell-item cp)))

(defun dlist-delete (d x &key (key #'identity) (test #'eql) (from-end nil) (count 0))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp) d)
        (when (funcall test (funcall key (cell-item cp)) x)
          (cell-delete (cell-prev cp) (cell-next cp))
          (decf (dlist-size d))
          (decf count)
          (when (zerop count)
            (return d))))))

(defun dlist-delete-if (d pred &key (key #'identity) (from-end nil) (count 0))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp) d)
        (when (funcall pred (funcall key (cell-item cp)))
          (cell-delete (cell-prev cp) (cell-next cp))
          (decf (dlist-size d))
          (decf count)
          (when (zerop count)
            (return d))))))

(defun dlist-delete-if-not (d pred &key (key #'identity) (from-end nil) (count 0))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp) d)
        (unless (funcall pred (funcall key (cell-item cp)))
          (cell-delete (cell-prev cp) (cell-next cp))
          (decf (dlist-size d))
          (decf count)
          (when (zerop count)
            (return d))))))

;;; 畳み込み
(defun dlist-fold (d func init &key from-end)
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp))
         (a init))
        ((eq cp (dlist-top d)) a)
      (setq a (if from-end
                  (funcall func (cell-item cp) a)
                (funcall func a (cell-item cp)))))))

;;; サイズ
(defun dlist-count (d) (dlist-size d))

;;; クリア
(defun dlist-clear (d)
  (let ((cp (dlist-top d)))
    (setf (cell-next cp) cp
          (cell-prev cp) cp
          (dlist-size d) 0)))

;;; 空リストか？
(defun dlist-emptyp (d)
  (let ((cp (dlist-top d)))
    (eq cp (cell-next cp))))

;;; リストを双方向リストに変換
(defun list->dlist (xs)
  (let ((d (make-dlist)))
    (dolist (x xs d)
      (dlist-insert-at d 0 x :from-end t))))

;;; 双方向リストをリストに変換
(defun dlist->list (d)
  (dlist-fold d (lambda (x y) (cons x y)) nil :from-end t))

;;; 巡回
(defun dlist-mapc (d func &key (from-end nil))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp))
        (funcall func (cell-item cp)))))

;;; イテレータの生成
(defun dlist-iterator (d &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (cp   (funcall iter (dlist-top d))))
    (lambda ()
      (if (eq (dlist-top d) cp)
          (values nil nil)
        (multiple-value-prog1
            (values (cell-item cp) t)
          (setq cp (funcall iter cp)))))))

;;; 表示
(defmethod print-object ((x dlist) stream)
  (format stream "#<dlist: ~S>" (dlist->list x)))

;;;
;;; 両端キュー
;;;

;;; 定義
(defstruct deque (top (make-dlist)))

;;; データの追加
(defun push-front (d value)
  (dlist-insert-at (deque-top d) 0 value))

(defun push-back (d value)
  (dlist-insert-at (deque-top d) 0 value :from-end t))

;;; データの取り出し
(defun pop-front (d)
  (dlist-delete-at (deque-top d) 0))

(defun pop-back (d)
  (dlist-delete-at (deque-top d) 0 :from-end t))

;;; データの参照
(defun peek-front (d)
  (dlist-nth (deque-top d) 0))

(defun peek-back (d)
  (dlist-nth (deque-top d) 0 :from-end t))

;;; 要素数を求める
(defun deque-count (q) (dlist-count (deque-top q)))

;;; ディーキューを空にする
(defun deque-clear (q) (dlist-clear (deque-top q)))

;;; ディーキューは空か？
(defun deque-emptyp (q) (dlist-emptyp (deque-top q)))

リスト : deque.asd

(defsystem :deque
  :description "両端キューと双方向リスト"
  :version "0.1.0"
  :author "Makoto Hiroi>"
  :license "MIT"
  :depends-on ()
  :in-order-to ((test-op (test-op :deque_tst)))
  :components ((:file "deque")))

;;;
;;; deque_tst.lisp : deque のテスト
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :deque_tst)
(defpackage :deque_tst (:use :cl :deque :mintst))
(in-package :deque_tst)
(export '(test))

(defvar d nil)
(defvar q nil)

(defun test ()
  (initial)
  (run (dlist-p (setq d (make-dlist))) t)
  (run (dlist-emptyp d) t)
  (run (dlist-count d) 0)
  (run (dlist-insert-at d 0 1) 1)
  (run (dlist-emptyp d) nil)
  (run (dlist-count d) 1)
  (run (dlist-nth d 0) 1)
  (run (dlist-nth d 0 :from-end t) 1)
  (run (dolist (x '(2 3 4) (dlist-count d)) (dlist-insert-at d 0 x :from-end t)) 4)
  (run (dolist (x '(5 6 7 8) (dlist-count d)) (dlist-insert-at d 0 x)) 8)
  (run (let ((a nil))
         (dotimes (x (dlist-count d) a) (push (dlist-nth d x) a)))
       '(4 3 2 1 5 6 7 8))
  (run (let ((a nil))
         (dotimes (x (dlist-count d) a) (push (dlist-nth d x :from-end t) a)))
       '(8 7 6 5 1 2 3 4))
  (run (let ((a nil))
         (dlist-mapc d (lambda (x) (push x a)))
         a)
       '(4 3 2 1 5 6 7 8))
  (run (let ((a nil))
         (dlist-mapc d (lambda (x) (push x a)) :from-end t)
         a)
       '(8 7 6 5 1 2 3 4))
  (run (dlist-delete-at d 0) 8)
  ;; 7 6 5 1 2 3 4
  (run (dlist-delete-at d 0 :from-end t) 4)
  ;; 7 6 5 1 2 3
  (run (dlist-delete-at d 2) 5)
  ;; 7 6 1 2 3
  (run (dlist-delete-at d 2 :from-end t) 1)
  (run (dlist->list d) '(7 6 2 3))
  (run (dlist-count d) 4)
  (run (dlist-fold d (lambda (a x) (cons x a)) nil) '(3 2 6 7))
  (run (dlist-fold d #'cons nil :from-end t) '(7 6 2 3))
  (run (dotimes (x (dlist-count d) (dlist->list d)) (dlist-set d x x))
       '(0 1 2 3))
  (run (dotimes (x (dlist-count d) (dlist->list d)) (dlist-set d x x :from-end t))
       '(3 2 1 0))
  (run (dlist-clear d) 0)
  (run (dlist-emptyp d) t)
  (run (dlist-count d) 0)

  ;; 探索
  (run (dlist-count (setq d (list->dlist '((1 2) (3 4) (5 6))))) 3)
  (run (dlist-exists d 3) nil)
  (run (dlist-exists d (list 3 4)) nil)
  (run (dlist-exists d (list 3 4) :test #'equal) t)
  (run (dlist-find d 4 :key #'car) nil)
  (run (dlist-find d 4 :key #'second) '(3 4))
  (run (dlist-find-if d #'evenp :key #'car) nil)
  (run (dlist-find-if d #'evenp :key #'second) '(1 2))
  (run (dlist-find-if d #'evenp :key #'second :from-end t) '(5 6))
  (run (dlist-find-if-not d #'evenp :key #'car) '(1 2))
  (run (dlist-find-if-not d #'evenp :key #'second) nil)
  (run (dlist-find-if-not d #'evenp :key #'car :from-end t) '(5 6))

  ;; 削除
  (run (dlist-count (setq d (list->dlist '(1 2 3 1 2 3 1 2 3)))) 9)
  (run (dlist->list (dlist-delete d 1)) '(2 3 2 3 2 3))
  (run (dlist-count d) 6)
  (run (dlist->list (dlist-delete d 2 :count 1)) '(3 2 3 2 3))
  (run (dlist-count d) 5)
  (run (dlist->list (dlist-delete d 2 :count 1 :from-end t)) '(3 2 3 3))
  (run (dlist-count d) 4)
  (run (dlist-count (setq d (list->dlist '(1 2 3 4 5 6)))) 6)
  (run (dlist->list (dlist-delete-if d #'evenp)) '(1 3 5))
  (run (dlist-count d) 3)
  (run (dlist-count (setq d (list->dlist '(1 2 3 4 5 6)))) 6)
  (run (dlist->list (dlist-delete-if-not d #'evenp)) '(2 4 6))
  (run (dlist-count d) 3)
  (run (dolist (x '(2 4 6) (dlist-emptyp d)) (dlist-delete d x)) t)

  ;; 両端キュー
  (run (deque-p (setq q (make-deque))) t)
  (run (deque-emptyp q) t)
  (run (deque-count q) 0)
  (run (push-front q 1) 1)
  (run (deque-emptyp q) nil)
  (run (deque-count q) 1)
  (run (push-back q 10) 10)
  (run (deque-emptyp q) nil)
  (run (deque-count q) 2)
  (run (peek-front q) 1)
  (run (peek-back q) 10)
  (run (dolist (x '(2 3 4) (deque-count q)) (push-front q x)) 5)
  (run (dolist (x '(20 30 40) (deque-count q)) (push-back q x)) 8)
  (run (peek-front q) 4)
  (run (peek-back q) 40)
  (run (let ((a nil)) (dotimes (x 4 a) (push (pop-front q) a)))
       '(1 2 3 4))
  (run (let ((a nil)) (dotimes (x 4 a) (push (pop-back q) a)))
       '(10 20 30 40))
  (run (deque-emptyp q) t)
  (run (deque-count q) 0)
  (run (push-front q 10) 10)
  (run (deque-clear q) 0)
  (run (deque-count q) 0)
  (run (deque-emptyp q) t)
  (final))

リスト : deque_tst.asd

(defsystem :deque_tst
  :description "test for deque"
  :version "0.1.0"
  :author "Makoto Hiroi"
  :license "MIT"
  :depends-on (:mintst :deque)
  :components ((:file "deque_tst"))
  :perform (test-op (o s) (symbol-call :deque_tst :test)))

Common Lisp Programming

お気楽 Common Lisp プログラミング入門 : 自作ライブラリ編

deque

●インストール

●仕様

●簡単なテスト

●サンプルプログラム

●プログラムリスト