最大回避ヒープ

参考

FOP - 第１章 二分ヒープ木の楽しみ

data (Ord a) => Tree a = Null | Fork Int a (Tree a) (Tree a)みたいにdata定義で型の制約が出来ないみたいですね。

data Tree a = Null | Fork Int a (Tree a) (Tree a) deriving (Show)

isEmpty :: (Ord a) => Tree a ->  Bool
isEmpty Null           = True
isEmpty (Fork n x a b) = False

minElem ::(Ord a) => Tree a -> a
minElem (Fork n x a b) = x

deleteMin :: (Ord a) => Tree a -> Tree a
deleteMin (Fork n x a b) = merge a b

insert :: (Ord a) => a -> Tree a -> Tree a
insert x a = merge (Fork 1 x Null Null) a

merge :: (Ord a) => Tree a -> Tree a -> Tree a
merge a    Null  = a
merge Null b     = b
merge a    b
  | minElem a <= minElem b = join a b
  | otherwise              = join b a

join :: (Ord a) => Tree a -> Tree a -> Tree a
join (Fork n x a b) c = Fork (n + size c) x aa (merge bb cc)
  where (aa, bb, cc) = orderBySize a b c

orderBySize :: (Ord a) => Tree a -> Tree a -> Tree a -> (Tree a, Tree a, Tree a)
orderBySize a b c
  | size a == biggest = (a, b, c)
  | size b == biggest = (b, c, a)
  | size c == biggest = (c, a, b)
  where biggest = size a `max` size b `max` size c

size :: Tree a -> Int
size Null = 0
size (Fork n x a b) = n

試してみる

*Main> let a = insert 1 Null
*Main> a
Fork 1 1 Null Null
*Main> let b = insert 2 a
*Main> b
Fork 2 1 (Fork 1 2 Null Null) Null
*Main> let c = insert 3 b
*Main> c
Fork 3 1 (Fork 1 2 Null Null) (Fork 1 3 Null Null)
*Main> let d = insert 4 c
*Main> d
Fork 4 1 (Fork 1 2 Null Null) (Fork 2 3 (Fork 1 4 Null Null) Null)
*Main> let e = insert 5 d
*Main> e
Fork 5 1 (Fork 2 3 (Fork 1 4 Null Null) Null) (Fork 2 2 (Fork 1 5 Null Null) Null)
*Main> let f = insert 6 e
*Main> f
Fork 6 1 (Fork 2 3 (Fork 1 4 Null Null) Null) (Fork 3 2 (Fork 1 5 Null Null) (Fork 1 6 Null Null))
*Main> let g = insert 7 f
*Main> g
Fork 7 1 (Fork 3 2 (Fork 1 5 Null Null) (Fork 1 6 Null Null)) (Fork 3 3 (Fork 1 4 Null Null) (Fork 1 7 Null Null))

数値だと要素そのものとサイズの区別が分かりづらいので、文字で試してみる。

*Main> let a = insert 'a' Null
*Main> a
Fork 1 'a' Null Null
*Main> let b = insert 'b' a
*Main> b
Fork 2 'a' (Fork 1 'b' Null Null) Null
*Main> let c = insert 'c' b
*Main> c
Fork 3 'a' (Fork 1 'b' Null Null) (Fork 1 'c' Null Null)
*Main> let d = insert 'd' c
*Main> d
Fork 4 'a' (Fork 1 'b' Null Null) (Fork 2 'c' (Fork 1 'd' Null Null) Null)
*Main> let e = insert 'e' d
*Main> e
Fork 5 'a' (Fork 2 'c' (Fork 1 'd' Null Null) Null) (Fork 2 'b' (Fork 1 'e' Null Null) Null)
*Main> let f = insert 'f' e
*Main> f
Fork 6 'a' (Fork 2 'c' (Fork 1 'd' Null Null) Null) (Fork 3 'b' (Fork 1 'e' Null Null) (Fork 1 'f' Null Null))
*Main> let g = insert 'g' f
*Main> g
Fork 7 'a' (Fork 3 'b' (Fork 1 'e' Null Null) (Fork 1 'f' Null Null)) (Fork 3 'c' (Fork 1 'd' Null Null) (Fork 1 'g' Null Null))
*Main>