Purely Functional Data Structures 写経 3.2 Binomial Heaps

Purely Functional Data Structures

Purely Functional Data Structures の Haskell 写経の続きです。P20〜P24

Heap の型class 定義は前と同じです。付録では Module にして import してますがエントリ単体で完結させるために毎回記載します。

class Heap h where
  empty :: Ord a => h a
  isEmpty :: Ord a => h a -> Bool
  insert :: Ord a => a -> h a -> h a
  merge :: Ord a => h a -> h a -> h a
  findMin :: Ord a => h a -> a
  deleteMin :: Ord a => h a -> h a

まずは data 宣言。rank や root の関数を実装するのが面倒くさかった為、フィールドラベルを使用しました。

data Tree a = Node {rank :: Int, root :: a, branches :: [Tree a]} deriving Show
newtype BinomialHeap a = BH [Tree a] deriving Show

そしてまずここでいきなり躓きました。
Heap の instance が [Tree a] になるのは解ったんですが、[Tree a] を Heap の instance だと宣言する方法がわからずに苦労しました。最初 instance Heap [Tree] where とか書いて怒られ。
結局カンニングして付録の方を見てみると、newtype で BinomialHeap 型を作っていました。こうやって新しい型を作ればよかったんですね。

気を取り直して link の実装

link :: Ord a => Tree a -> Tree a -> Tree a
link t1@(Node r x1 c1) t2@(Node _ x2 c2)
  | x1 <= x2  = Node (r+1) x1 $ t2:c1
  | otherwise = Node (r+1) x2 $ t1:c2

link は唯一 branches の連結を行う関数ですね。

そして insert の実装

insTree :: Ord a => Tree a -> [Tree a] -> [Tree a]
insTree t [] = [t]
insTree t ts@(t':ts') = if rank t < rank t' then t : ts
                                            else insTree (link t t') ts'

instance Heap BinomialHeap where
  empty = BH []
  isEmpty (BH ts) = null ts
  insert x (BH ts) = BH $ insTree (Node 0 x []) ts

この辺から段々ぱっと見で挙動がつかめなくなってきたので、具体値でシミュレートしたいと思います。

a :: BinomialHeap Int
a = insert 6 $ insert 2 $ insert 3 $ insert 8 $ insert 5 $ empty

今この a が作られる過程を追っていきます。

BH [] 　　　　　　  　　　　　　 -- まず empty で空の BinomialHeap が作られる

insert 5 (BH [])                 -- insert 5 $ empty がこうなる。これを変形していくと
BH $ insTree (Node 0 5 []) [] 
BH [(Node 0 5 [])]               -- になる。

insert 8 $ BH [(Node 0 5 [])]                        -- insert 8 $ insert 5 $ empty
BH $ insTree (Node 0 8 []) [(Node 0 5 [])]
BH $ insTree (link (Node 0 8 []) (Node 0 5 [])) []   -- rank は共に 0 なので else 節
BH $ insTree (Node 1 5 [(Node 0 8 [])]) []           -- 8 > 5 なので
BH [(Node 1 5 [(Node 0 8 [])])]

insert 3 $ BH [(Node 1 5 [(Node 0 8 [])])]
BH $ insTree (Node 0 3 []) [(Node 1 5 [(Node 0 8 [])])]
BH $ (Node 0 3 []) : [(Node 1 5 [(Node 0 8 [])])]        -- rank が 0 < 1 なので
BH [(Node 0 3 []), (Node 1 5 [(Node 0 8 [])])]

insert 2 $ BH [(Node 0 3 []), (Node 1 5 [(Node 0 8 [])])]
BH $ insTree (Node 0 2 []) [(Node 0 3 []), (Node 1 5 [(Node 0 8 [])])]
BH $ insTree (link (Node 0 2 []) (Node 0 3 [])) [(Node 1 5 [(Node 0 8 [])])]  -- rank が 0 == 0
BH $ insTree (Node 1 2 [(Node 0 3 [])]) [(Node 1 5 [(Node 0 8 [])])]
BH $ insTree (link (Node 1 2 [(Node 0 3 [])]) (Node 1 5 [(Node 0 8 [])])) []  -- rank が 1 == 1
BH $ insTree (Node 2 2 (Node 1 5 [(Node 0 8 [])]):[(Node 0 3 [])]) []
BH $ insTree (Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])]) []
BH [(Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]

insert 6 $ BH [(Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]
BH $ insTree (Node 0 6 []) [(Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]
BH $ (Node 0 6 []):[(Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]  -- rank が 0 < 2
BH [(Node 0 6 []), (Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]

a = BH [(Node 0 6 []), (Node 2 2 [(Node 1 5 [(Node 0 8 [])]), (Node 0 3 [])])]

となる訳ですね。

そして merge。merge の実装前に mergeTree を実装しておきます。

mergeTree :: Ord a => [Tree a] -> [Tree a] -> [Tree a]
mergeTree ts [] = ts
mergeTree [] ts = ts
mergeTree ts1@(t1:ts1') ts2@(t2:ts2')
  | rank t1 < rank t2 = t1 : mergeTree ts1' ts2
  | rank t1 > rank t2 = t2 : mergeTree ts1 ts2'
  | otherwise         = insTree (link t1 t2) $ mergeTree ts1' ts2'

instance Heap BinomialHeap where
  merge (BH ts1) (BH ts2) = BH $ mergeTree ts1 ts2

これまた結構な構造ですね。rank が違っていれば rank の低い方を前に連結して残りを再帰。そうでなければ先頭同士をlink して残り同士を再帰。

それから findMin と deleteMin を実装するために removeMinTree を実装します。

removeMinTree :: Ord a => [Tree a] -> (Tree a, [Tree a])
removeMinTree [] = error "Empty"
removeMinTree [t] = (t, [])
removeMinTree (t:ts) = let (t', ts') = removeMinTree ts
                       in if root t <= root t' then (t, ts) else (t', t:ts')

instance Heap BinomialHeap where
  findMin (BH ts) = root $ fst $ removeMinTree ts
  
  deleteMin (BH ts) = let (t, ts2) = removeMinTree ts
                      in BH $ mergeTree ts2 $ reverse $ branches t

removeMinTree は最小値と最小値を取り除いた残りのタプルを返す関数です。これは素直な感じですね。

findMin はそのまんまですが、deleteMin は reverse が若干解りづらかったです。

巻末の付録とつき合わせてみると、removeMinTree や deleteMin で let を使わずに where を使ってますね。

removeMinTree (t:ts) = if root t <= root t' then (t, ts) else (t', t:ts')
  where (t', ts') = removeMinTree ts

instance Heap BinomialHeap where
  deleteMin (BH ts) = BH (mergeTree (reverse ts1) ts2)
    where (Node _ _ ts1, ts2) = removeMinTree ts

なんとなく変数定義は let、関数定義は where って意識がありましたけど、変数定義でも where 使った方が見やすい気がしますね。

ひとます Binomial Heaps は以上です。完璧な理解には程遠いですが Binomial の意味はなんとなく掴めた気がします。ただこれ自前で書けって言われても無理ですね……。