Purely Functional Data Structures 写経 5.4 Splay Heaps

Purely Functional Data Structures

Haskell写経の続きです。5.3章は3.2章の Binomal Heaps に対する追記なので飛ばします。今回は P46〜P52

まずは Heap の宣言ですね。これも以前と同じです。

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 Tree a = E | T (Tree a) a (Tree a) deriving Show

これまた普通ですね。
最初に特に当り障りの無い empty と isEmpty の実装を書いておきます。

instance Heap Tree where
  empty = E

  isEmpty E = True
  isEmpty _ = False

で、 insert の実装ですが、smaller(後述)とbigger(後述)を使用することで以下の様に書けます。

  insert x t = T (smaller x t) x (bigger x t)

してその smaller と bigger とは？ bigger は以下の様に定義されます。

bigger :: Ord a => a -> Tree a -> Tree a
bigger _ E = E
bigger pivot (T a x b) =
  if x <= pivot then bigger pivot b
  else case a of
         E -> T E x b
         (T a1 y a2) ->
           if y <= pivot then T (bigger pivot a2) x b
                         else T (bigger pivot a1) x (T a2 x b)

smaller も bigger と同様に定義できます。

ただここで smaller と bigger を個別に定義するのではなく、小さい方と大きい方を tuple で返す partition という関数を定義したいとおもいます。

partition :: Ord a => a -> Tree a -> (Tree a, Tree a)
partition _ E = (E, E)
partition pivot t@(T a x b) =
  if x <= pivot then
    case b of
      E -> (t, E)
      (T b1 y b2) ->
        if y <= pivot then
          let (small, big) = partition pivot b2
          in (T (T a x b1) y small, big)
        else
          let (small, big) = partition pivot b1
          in (T a x small, T big y b2)
  else
    case a of
      E -> (E, t)
      (T a1 y a2) ->
        if y <= pivot then
          let (small, big) = partition pivot a2
          in (T a1 y small, T big x b)
        else
          let (small, big) = partition pivot a1
          in (small, T big y (T a2 x b))

この partition を用いて insert は以下の様になります。

  insert x t = let (a, b) = partition x t
               in T a x b

そして findMin と deleteMin が次の様になります。

  findMin (T E x _) = x
  findMin (T a _ _) = findMin a

  deleteMin (T E _ b) = b
  deleteMin (T (T E _ b) y c) = T b y c
  deleteMin (T (T a x b) y c) = T (deleteMin a) x (T b y c)

で最後に merge です。merge も partition を利用します。

  merge E t = t
  merge (T a x b) t = let (ta, tb) = partition x t
                      in T (merge ta a) x (merge tb b)