二分ヒープ in Elisp（かなり妥協）

ヒープソートで使う二分ヒープ（binary heap）。副作用を使わないリスト版を作ろうと思ったが、いいアイデアがない。

結局、よくある配列版のアルゴリズムで妥協した…

;;; すみませんがトップレベルの変数を使いますよ、と
(defvar *heap*)
=> *heap*

(defvar *n*)
=> *n*

;;; 初期化関数
(defun init-heap (N)
  (setf *heap* (make-vector N -1) *n* 0)
  N)
=> init-heap

;;; 追加する関数（最小値が根になるよう並べる）
(defun heap-push (x)
  (let ((i *n*) (i-parent))
    (incf *n*)
    ;; 親と比べながら上へ移動
    (while (and (> i 0)
                (< x (elt *heap* (setf i-parent (/ (- i 1) 2)))))
      (aset *heap* i (elt *heap* i-parent))
      (setf i i-parent))
    (aset *heap* i x)))
=> heap-push

;;; 取り出す関数
(defun heap-pop ()
  (if (zerop *n*)
      nil
    (let ((ret (elt *heap* 0))
          (i 0)
          (i-child nil)
          (v-child nil)
          (v-last (elt *heap* (1- *n*))))
      ;; 子と比べながら下へ移動
      (while (and (setf i-child (select-child-idx i))
                  (< (setf v-child (elt *heap* i-child)) v-last))
        (aset *heap* i v-child)
        (setf i i-child))
      (aset *heap* i v-last)
      (decf *n*)
      ret)))
=> heap-pop

;;; 補助関数（i番目の要素の子を求める。子が2つある場合は値が小さいほうを選ぶ）
(defun select-child-idx (i)
  (let ((cleft (+ (* 2 i) 1))
        (cright (+ (* 2 i) 2)))
    (cond ((and (< cright *n*)
                (< (elt *heap* cright) (elt *heap* cleft)))
           cright)
          ((< cleft *n*) cleft)
          (t nil))))
=> select-child-idx

やっぱりElispで配列を扱うのはめんどくさい。変数のsetf, asetが本当につらい…

続いて動作確認。

;;; 10要素のヒープを作る
(init-heap 10)
=> 10

;; 乱数10個作って push する
(mapcar 'heap-push (loop for i from 1 to 10 collect (random 100)))
=> (29 80 21 8 70 96 19 93 62 86)

;; 10回ぶん pop してみる
(loop for i from 1 to 10 collect (heap-pop))
=> (8 19 21 29 62 70 80 86 93 96)

ちゃんと小さい順に pop されているのでOKだが、もっときれいに書きたい。

Wikipediaの二分ヒープのページを見てたら「スレッド木」というキーワードが載っていたので今度調べる。あるいは "Purely Functional Data Structures" とかか。

参考

• 二分ヒープ - Wikipedia