pairing heap
ちょっとヒープ(優先順位付きキュー)を使いたくなったので、実装。
とりあえずは、実装が簡単な(かつ性能が良いらしい)pairing-heapを選択。
一群の関数は、後で他のものに変更しやすいようにpackageにまとめておく。
;;; package (defpackage :pairing-heap (:use :cl) (:shadow :push :pop) (:export :make-heap :push :pop :empty?)) (in-package :pairing-heap) ;;; struct (defstruct heap node (test #'<)) ; 比較関数 (defstruct node element childs) ; nodeのリスト ;;; internal function ;; nodeをマージ (defun merge-node (n1 n2 <) (cond ((null n1) n2) ((null n2) n1) (t (if (funcall < #1=(node-element n1) #2=(node-element n2)) (make-node :element #1# :childs (cons n2 (node-childs n1))) (make-node :element #2# :childs (cons n1 (node-childs n2))))))) ;; nodeのリストをマージ (defun merge-pairs (nodes <) (if (null (cdr nodes)) (car nodes) (destructuring-bind (first second . rest) nodes (merge-node (merge-node first second <) (merge-pairs rest <) <)))) ;;; external function (defun push (element heap) (setf (heap-node heap) (merge-node (make-node :element element) (heap-node heap) (heap-test heap))) heap) (defun pop (heap) (let ((root (heap-node heap))) (when root (prog1 (node-element root) (setf (heap-node heap) (merge-pairs (node-childs root) (heap-test heap))))))) (defun empty? (heap) (null (heap-node heap)))
これで終了。
ついでに、graphviz用の関数も定義しておく。
(defparameter *heap-ppd* (copy-pprint-dispatch)) (set-pprint-dispatch 'heap (lambda (stream heap) (unless (null (heap-node heap)) (princ (heap-node heap) stream))) 0 *heap-ppd*) (set-pprint-dispatch 'node (lambda (stream node) (with-slots (element childs) node (format stream "~:{~A -> ~A;~%~}~{~A~}" (mapcar (lambda (child) `(,element ,(node-element child))) childs) childs))) 0 *heap-ppd*) ;;; この出力をdotコマンドに渡す。 ex. `dot -Tgif -o heap.gif heap.dot` (defun dot-print (heap &optional (stream *standard-output*)) (let ((*print-pretty* t) (*print-pprint-dispatch* *heap-ppd*)) (format stream "digraph pairing_heap {~%~A}" heap)))
試しに、以下のコードを元に、いくつか画像(ヒープ1〜)を作成してみてみる。
;; dotファイルを作成 (with-open-file (out "heap.dot" :direction :output :if-exists :supersede) (let ((heap (make-heap))) ;; 0〜31までの数値をheapに追加 (dotimes (i 32) (push i heap)) ;; (pop heap) ※ ヒープ2以降はこのコメントアウトを外す ;; (pop heap) ※ ヒープ3以降はこのコメントアウトを外す ;; (pop heap) ※ ヒープ4以降はこのコメントアウトを外す (dot-print heap out)))
pairing-heapは、要素の追加(push)時よりも削除(pop)時に多くのことをしているのだが、それが上の画像にも表れていて面白い。
ヒープ1では、要素0の下に残りの要素がつながっているだけだが、要素を削除するごとに2段目(?)の要素群のマージが行われ、その度にヒープ階層が深くなっていっている*1。
ちなみに、この例では、0から順番に要素を追加しているので、このような形となっているが、逆順に追加していった場合は、要素がソートされたただのリストの形となる(削除も先頭から順に行われるだけ)。