Common Lisp Programming

queue

「待ち行列 (queue)」のライブラリです。リストで実装した queue と配列で実装した ring-buffer が用意されています。詳しい説明は拙作のページ Common Lisp 入門: 構造体 をお読みくださいませ。

●インストール

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

• queue.lisp
• queue.asd
• queue_tst.lisp
• queue_tst.asd

●仕様

• パッケージ名 :queue
• データ型: queue, ring-buffer
• make-queue => q
  空のキューを作る。
• make-ring-buffer n => q
  大きさ n の空のキュー (ring-buffer) を作る。
• queue-p q => t or nil
  引数 q が queue ならば真を返す
• ring-buffer-p q => t or nil
  引数 q が ring-buffer ならば真を返す

• 共通の操作メソッド
• enqueue q x => x
  キュー q にデータ x を挿入する。
• dequeue q => x
  キュー q からデータ x を取り出す。キューが空の場合は nil を返す。
• queue-peek q => x
  キュー q の先頭要素を返す。データは取り出さない。キューが空の場合は nil を返す。
• queue-emptyp q => t or nil
  キュー q が空ならば真を返す。
• queue-fullp q => t or nil
  キュー q が満杯ならば真を返す。queue の場合は常に nil を返す。
• queue-count q => integer
  キューの要素数を返す
• queue-clear q => 0
  キューを空にする

●簡単なテスト

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

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

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

(RING-BUFFER-P Q)
=> NIL OK

(QUEUE-EMPTYP Q)
=> T OK

(QUEUE-COUNT Q)
=> 0 OK

(DOTIMES (X 8 (QUEUE-COUNT Q)) (ENQUEUE Q X))
=> 8 OK

(QUEUE-EMPTYP Q)
=> NIL OK

(QUEUE-FULLP Q)
=> NIL OK

(QUEUE-PEEK Q)
=> 0 OK

(LET ((A NIL))
  (DOTIMES (X 4 (REVERSE A)) (PUSH (DEQUEUE Q) A)))
=> (0 1 2 3) OK

(QUEUE-EMPTYP Q)
=> NIL OK

(QUEUE-COUNT Q)
=> 4 OK

(QUEUE-PEEK Q)
=> 4 OK

(QUEUE-CLEAR Q)
=> 0 OK

(QUEUE-EMPTYP Q)
=> T OK

(QUEUE-COUNT Q)
=> 0 OK

(QUEUE-PEEK Q)
=> NIL OK

(RING-BUFFER-P (SETQ Q (MAKE-RING-BUFFER 8)))
=> T OK

(QUEUE-P Q)
=> NIL OK

(QUEUE-EMPTYP Q)
=> T OK

(QUEUE-COUNT Q)
=> 0 OK

(DOTIMES (X 8 (QUEUE-COUNT Q)) (ENQUEUE Q X))
=> 8 OK

(QUEUE-EMPTYP Q)
=> NIL OK

(QUEUE-FULLP Q)
=> T OK

(QUEUE-PEEK Q)
=> 0 OK

(LET ((A NIL))
  (DOTIMES (X 4 (REVERSE A)) (PUSH (DEQUEUE Q) A)))
=> (0 1 2 3) OK

(QUEUE-EMPTYP Q)
=> NIL OK

(QUEUE-COUNT Q)
=> 4 OK

(QUEUE-PEEK Q)
=> 4 OK

(QUEUE-CLEAR Q)
=> 0 OK

(QUEUE-EMPTYP Q)
=> T OK

(QUEUE-FULLP Q)
=> NIL OK

(QUEUE-COUNT Q)
=> 0 OK

(QUEUE-PEEK Q)
=> NIL OK

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

●サンプルプログラム

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

;;;
;;; 経路の探索
;;;

;;; 隣接リスト
(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 breadth-first-search (start goal)
  (let ((q (make-queue)))
    (enqueue q (list start))
    (do ()
        ((queue-emptyp q))
        (let ((path (dequeue q)))
          (if (eq (car path) goal)
              (print (reverse path))
            (dolist (x (cdr (assoc (car path) *adjacent*)))
              (unless (member x path)
                (enqueue q (cons x path)))))))))

;;;
;;; 5 パズル
;;;

;;; 盤面
;;; 0 1 2
;;; 3 4 5

;;; 隣接リスト
(defvar *adjacent5*
  #((1 3) (0 2 4) (1 5)
    (0 4) (1 3 5) (2 4)))

;;; 駒の移動
(defun move-piece (board x s)
  (let ((new-board (copy-seq board)))
    (setf (aref new-board s) (aref new-board x)
          (aref new-board x) 0)
    new-board))

;;; 解の表示
(defun print-answer (state)
  (when state
    (print-answer (third state))
    (print (first state))))

(defun five-puz (start goal)
  (let ((que (make-ring-buffer (* 6 5 4 3)))
        (chk nil))
    (enqueue que (list start (position 0 start) nil))
    (push start chk)
    (do ()
        ((queue-emptyp que))
        (let* ((state (dequeue que))
               (board (first state))
               (space (second state)))
          (when
              (equalp board goal)
            (print-answer state)
            (return t))
          (dolist (x (aref *adjacent5* space))
            (let ((new-board (move-piece board x space)))
              (unless (member new-board chk :test #'equalp)
                (push new-board chk)
                (enqueue que (list new-board x state)))))))))

;;; 最長手数の局面を探す
(defun five-puz-max ()
  (let ((que (make-ring-buffer (* 6 5 4 3)))
        (chk nil)
        (start (list #(1 2 3 4 5 0) 5 0)))
    (enqueue que start)
    (push start chk)
    (do ()
        ((queue-emptyp que))
        (let* ((state (dequeue que))
               (board (first state))
               (space (second state))
               (move (third state)))
          (dolist (x (aref *adjacent5* space))
            (let* ((new-board (move-piece board x space))
                   (new-state (list new-board x (1+ move))))
              (unless (member new-board chk :key #'car :test #'equalp)
                (push new-state chk)
                (enqueue que new-state))))))
    (dolist (state (utils:take-while (lambda (xs) (= (third xs) (third (first chk)))) chk))
      (format t "~d: ~s~%" (third state) (first state)))))

* (load "sample_queue.lisp")
T

* (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

* (five-puz #(4 5 0 1 2 3) #(1 2 3 4 5 0))

#(4 5 0 1 2 3)
#(4 0 5 1 2 3)
#(0 4 5 1 2 3)
#(1 4 5 0 2 3)
#(1 4 5 2 0 3)
#(1 0 5 2 4 3)
#(1 5 0 2 4 3)
#(1 5 3 2 4 0)
#(1 5 3 2 0 4)
#(1 5 3 0 2 4)
#(0 5 3 1 2 4)
#(5 0 3 1 2 4)
#(5 2 3 1 0 4)
#(5 2 3 1 4 0)
#(5 2 0 1 4 3)
#(5 0 2 1 4 3)
#(0 5 2 1 4 3)
#(1 5 2 0 4 3)
#(1 5 2 4 0 3)
#(1 0 2 4 5 3)
#(1 2 0 4 5 3)
#(1 2 3 4 5 0)
T

* (five-puz-max)
21: #(4 5 0 1 2 3)
NIL

●プログラムリスト

;;;
;;; queue.lsp : キュー
;;;
;;; Copyright (c) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :queue)
(defpackage :queue (:use :cl))
(in-package :queue)
(export '(make-queue
          make-ring-buffer
          queue-p
          ring-buffer-p
          enqueue
          dequeue
          queue-peek
          queue-emptyp
          queue-fullp
          queue-count
          queue-clear))

;;; メソッドの定義
(defgeneric enqueue (q x))
(defgeneric deenque (q))
(defgeneric queue-peek (q))
(defgeneric queue-emptyp (q))
(defgeneric queue-fullp (q))
(defgeneric queue-count (q))
(defgeneric queue-clear (q))

;;; キューの定義
(defstruct queue
  (front nil) (rear nil) (size 0))

;;; キューは空か？
(defmethod queue-emptyp ((q queue))
  (zerop (queue-size q)))

;;; キューは満杯か？
(defmethod queue-fullp ((q queue)) nil)

;;; 要素数を返す
(defmethod queue-count ((q queue)) (queue-size q))

;;; キューを空にする
(defmethod queue-clear ((q queue))
  (setf (queue-front q) nil
        (queue-rear  q) nil
        (queue-size  q) 0))

;;; データの挿入
(defmethod enqueue ((q queue) item)
  (let ((new-cell (list item)))
    (if (queue-emptyp q)
        ;; キューは空の状態
        (setf (queue-front q) new-cell)
      ;; 最終セルを書き換える
      (setf (cdr (queue-rear q)) new-cell))
    (setf (queue-rear q) new-cell))
  (incf (queue-size q))
  ;; item を返す
  item)

;;; データを取得
(defmethod dequeue ((q queue))
  (unless (queue-emptyp q)
    (prog1
        (pop (queue-front q))
      (decf (queue-size q))
      (when (queue-emptyp q)
        ;; キューは空になった
        (setf (queue-rear q) nil)))))

;;; 先頭の要素を返す
(defmethod queue-peek ((q queue))
  (unless (queue-emptyp q)
    (car (queue-front q))))

;;;
;;; リングバッファ
;;;

;;; リングバッファの定義
(defstruct (ring-buffer
            (:constructor make-ring-buffer (size &aux (buffer (make-array size)))))
  (front 0) (rear 0) (count 0) size buffer)

;;; キューは空か？
(defmethod queue-emptyp ((q ring-buffer))
  (zerop (ring-buffer-count q)))

;;; キューは満杯か？
(defmethod queue-fullp ((q ring-buffer))
  (= (ring-buffer-count q) (ring-buffer-size q)))

;;; 要素数を返す
(defmethod queue-count ((q ring-buffer))
  (ring-buffer-count q))

;;; 先頭データの参照
(defmethod queue-peek ((q ring-buffer))
  (unless (queue-emptyp q)
    (aref (ring-buffer-buffer q) (ring-buffer-front q))))

;;; キューを空にする
(defmethod queue-clear ((q ring-buffer))
  (setf (ring-buffer-rear  q) 0
        (ring-buffer-front q) 0
        (ring-buffer-count q) 0))

;;; データの挿入
(defmethod enqueue ((q ring-buffer) item)
  (unless (queue-fullp q)
    (setf (aref (ring-buffer-buffer q) (ring-buffer-rear q)) item)
    (incf (ring-buffer-count q))
    (incf (ring-buffer-rear q))
    (when (= (ring-buffer-rear q) (ring-buffer-size q))
      (setf (ring-buffer-rear q) 0))
    item))

;;; データの取り出し
(defmethod dequeue ((q ring-buffer))
  (unless (queue-emptyp q)
    (prog1
        (aref (ring-buffer-buffer q) (ring-buffer-front q))
      (decf (ring-buffer-count q))
      (incf (ring-buffer-front q))
      (when (= (ring-buffer-front q) (ring-buffer-size q))
        (setf (ring-buffer-front q) 0)))))

リスト : queue.asd

(defsystem :queue
  :description "待ち行列 (queue, ring-buffer)"
  :version "0.1.0"
  :author "Makoto Hiroi"
  :license "MIT"
  :depends-on ()
  :in-order-to ((test-op (test-op :queue_tst)))
  :components ((:file "queue")))

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

(defvar q nil)

(defun test ()
  (initial)
  (run (queue-p (setq q (make-queue))) t)
  (run (ring-buffer-p q) nil)
  (run (queue-emptyp q) t)
  (run (queue-count q) 0)
  (run (dotimes (x 8 (queue-count q)) (enqueue q x)) 8)
  (run (queue-emptyp q) nil)
  (run (queue-fullp q) nil)
  (run (queue-peek q) 0)
  (run (let ((a nil))
         (dotimes (x 4 (reverse a)) (push (dequeue q) a)))
       '(0 1 2 3))
  (run (queue-emptyp q) nil)
  (run (queue-count q) 4)
  (run (queue-peek q) 4)
  (run (queue-clear q) 0)
  (run (queue-emptyp q) t)
  (run (queue-count q) 0)
  (run (queue-peek q) nil)

  ;; ring-buffer
  (run (ring-buffer-p (setq q (make-ring-buffer 8))) t)
  (run (queue-p q) nil)
  (run (queue-emptyp q) t)
  (run (queue-count q) 0)
  (run (dotimes (x 8 (queue-count q)) (enqueue q x)) 8)
  (run (queue-emptyp q) nil)
  (run (queue-fullp q) t)
  (run (queue-peek q) 0)
  (run (let ((a nil))
         (dotimes (x 4 (reverse a)) (push (dequeue q) a)))
       '(0 1 2 3))
  (run (queue-emptyp q) nil)
  (run (queue-count q) 4)
  (run (queue-peek q) 4)
  (run (queue-clear q) 0)
  (run (queue-emptyp q) t)
  (run (queue-fullp q) nil)
  (run (queue-count q) 0)
  (run (queue-peek q) nil)
  (final))

リスト : queue_tst.asd

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