ヒープソート

チマチマアルゴリズムのお勉強中。今回はヒープソート

SICPにも二進木が出てきた気がするけど、ヒープも二進木の一種らしい。

ところでヒープってナンダ!!

ヒープ領域とは全く関係ない。


親 > 子

となってるツリー構造。親 < 子としてもオケー。


ま、詳しいことは、こちらをヒープ - Wikipedia

ヒープ構造を作る

親 > 子を保ちながらツリーを構成すればいいんだけど、重要なことがもう一個あって、ツリーは、要素数を持ってる。

新しい要素を追加する時は、要素数に従い、偶数なら左に挿入。奇数なら右に挿入する。子には要素数の半分の値を適用していく。


素数を2進数にすると、ハフマン符号のようになるのが面白い。

素数を5とすると、101。下桁から見て、新しい要素が入る場所は右・左・右となる。


新しい要素が入るところに向かって、親 > 子供となるように再構成していく。

(define (make-heap l)
  (letrec ((make-tree
             (lambda (i n tree)
               (if (null? tree)
                   (list i '() '())
                   (let* ((l (cadr tree))
                          (r (caddr tree))
                          (insert
                            (lambda (parent new)
                              (cons parent
                                    (if (zero? (modulo n 2))
                                        (list (make-tree new (quotient n 2) l) r)
                                        (list l (make-tree new (quotient n 2) r)))))))
                     (if (> i (car tree))
                         (insert i (car tree))
                         (insert (car tree) i))))))
           (iter
             (lambda (n l tree)
               (if (null? l)
                   tree
                   (iter (+ n 1) (cdr l) (make-tree (car l) n tree))))))
    (iter 1 l '())))

(make-heap (iota 20 1))
; (20 (18 (14 (10 (2 () ()) ())
;             (6 () ()))
;         (16 (12 (4 () ()) ())
;             (8 () ())))
;     (19 (15 (11 (3 () ()) ())
;             (7 () ()))
;         (17 (13 (5 () ()) ())
;             (9 () (1 () ())))))

おぉ、木を作るとどうしてもどっちかに偏っちゃったりするんだけど、要素数があればバランスの取れた木を作ることが出来る。スバラシイ。


ツリーのインデックスは1番から始めた方がいい。1番から始めれば、1, 10, 11, 100...となり2進数での一番左の桁が1で必ず終わるので終端がわかりやすい。


ツリーに要素数を付け加えないと挿入・削除の時にバランスが悪くなるけど、面倒なので略。

一個削除

削除する時は、親を削除して、新しい親になった子を再構成していく。

(define (pop-heap tree cont)
  (if (null? tree)
      (cont 'empty '())
      (cont (car tree)
            (let ((l (cadr tree))
                  (r (caddr tree))
                  (select (lambda (tree) (if (null? tree) -1 (car tree)))))
              (if (and (null? l) (null? r))
                  '()
                  (if (> (select l) (select r))
                      (pop-heap l (lambda (p t) (list p t r)))
                      (pop-heap r (lambda (p t) (list p l t)))))))))

(pop-heap (make-heap (iota 10 1)) (lambda (parent tree) parent)) ; 10

一個取り出して再構成してみた。


素数を見てないのでバランスが崩れる可能性アリ。

(make-heap '(2 1 2 1 2 1 2 1)) ; (2 (2 (2 () ()) (2 () ())) (1 (1 () ()) (1 () (1 () ()))))

大きいほうが左側に偏っているので左側の子供だけどんどん消費していく事になるので、バランスが崩れちゃう。


バランスよく削除するためには、要素数に応じたターゲット(最後に挿入した要素)を削除し、親の抜け殻にターゲットを入れる。そしたら再構成していく。

なるべくツリー構成を壊さず再構成するには、この方法がいいみたい。

ヒープソート

一個削除を繰り返せば、ソートできる。

(define (heap-sort l)
  (letrec ((iter
             (lambda (tree acc)
               (if (null? tree)
                   acc
                   (pop-heap tree (lambda (parent t)
                                    (iter t (cons parent acc))))))))
    (iter (make-heap l) '())))


(heap-sort (iota 10 1)) ; (1 2 3 4 5 6 7 8 9 10)
(heap-sort (reverse (iota 10 1))) ; (1 2 3 4 5 6 7 8 9 10)
(heap-sort (list-tabulate 10 (lambda (n) (random 10)))) ; (0 2 2 4 4 4 4 4 5 6)

親 > 子の順で並んでるんだから、ひとつづつ取り出せば当然ソートできる。iter再帰にすれば逆順でもオケー。

まとめ

計算量はO(N log N)だけど、クイックソートより遅いし、安定じゃないので、あんまり活用法が見出せないところですが、バランスの良い木の作り方がわかったので収穫アリでした。

(メモリがヤバイ時やら、安定ソートの時はマージソートだしという意味で活用法が見出せないと書いてみた)

追記

不釣合いな木にならないように修正を加えたバージョン

(require (lib "match.ss" "mzlib"))

(define (make-heap l cont)
  (letrec ((make-tree
             (lambda (i n tree)
               (match tree
                      (() (list i '() '()))
                      ((p l r) (let* ((next (quotient n 2))
                                      (insert (lambda (parent new)
                                                (cons parent
                                                      (if (zero? (modulo n 2))
                                                          (list (make-tree new next l) r)
                                                          (list l (make-tree new next r)))))))
                                 (if (> i (car tree))
                                     (insert i p)
                                     (insert p i)))))))
           (iter
             (lambda (n l tree)
               (if (null? l)
                   (cont tree (- n 1))
                   (iter (+ n 1) (cdr l) (make-tree (car l) n tree))))))
    (iter 1 l '())))

(define (pop-heap tree len cont)
  (letrec ((rm (lambda (tree len cont) ; ターゲットの削除
                 (match tree
                        ((p () ()) (cont '() p)) ; len = 1
                        ((p l r) (let ((next (quotient len 2)))
                                   (if (zero? (modulo len 2))
                                       (rm l next (lambda (t res) (cont (list p t r) res)))
                                       (rm r next (lambda (t res) (cont (list p l t) res)))))))))
           (re (lambda (tree new) ; 再構成
                 (match tree
                        (() '())
                        ((p l r) (let ((value (lambda (tree) (if (null? tree) -1 (car tree))))
                                       (insert (lambda (cmp cont)
                                                 (if (> new cmp)
                                                     (list new l r)
                                                     (cont)))))
                                   (if (> (value l) (value r))
                                       (insert (value l) (lambda () (list (car l) (re l new) r)))
                                       (insert (value r) (lambda () (list (car r) l (re r new)))))))))))
    (if (null? tree)
        (cont 'empty '() 0)
        (cont (car tree)
              (rm tree len re)
              (- len 1)))))

(define (heap-sort l)
  (letrec ((iter
             (lambda (tree len acc)
               (if (null? tree)
                   acc
                   (pop-heap tree len (lambda (parent t l)
                                        (iter t l (cons parent acc))))))))
    (make-heap l (lambda (tree len)
                   (iter tree len '())))))


最初はツリーの分解にapplyを使ってみたけど、

(apply (lambda (p l r) ...) tree)

caddrとか使わなくても親と左の子、右の子に分解できちゃう。


あ、コレってパターンマッチでいけるなと思って修正。

まとめ2

ヒープ構造は挿入も削除もO(log n)。ソートには向いて無いけど、挿入した中から、一番大きなデータを取り出すというスタックっぽい作業をしたいときには絶大なる威力を発揮しそうだ。


例えば、順序付けられたリストだと、削除はO(1)で早いんだけど、挿入にO(n)かかる。O(n)というのが結構なボトルネックで、80*80の最短経路のデータベースを順次入れ替えながらアップデートするという作業を行うと途端に破綻してしまう。


ヒープ構造なら10万件のデータがあっても、削除も挿入もO(log 10万)で16回!!コレはスゲー。ヒープがあれば最短経路のデータベース検索が早くなるかも。やっと次の問題が解けそうだ・・・。


やっぱツリーはスゲーよ。

追記2

Gaucheの組み込みの(Cで実装された)ソートはデフォルトではQuick Sortで始めて、再帰の深さが ceiling(2*log(N)) を越えた時にHeap Sortにスイッチするようにしてる。この技は(もう覚えてないけど、コメントによれば)TAOCPに出ていたようだ。 Quick SortもHeap Sortもin-placeでできるので、既にQuick Sortでソート済みの連続領域がいくつかある状態でそれぞれの領域にそのままHeap Sortを適用できるのは便利。

未知の領域っす・・・。