Purely Functional Data Structures 写経 3.3 Red-Black Trees

Purely Functional Data Structures

Haskell 写経の続きです。P24〜P29

赤黒木です。赤黒木は C での実装を知ってるんで心に余裕がありますね。

とりあえず型クラス宣言から。赤黒木は Set として実装してますね。

class Set s where
  empty :: Ord a => s a
  insert :: Ord a => a -> s a -> s a
  member :: Ord a => a -> s a -> Bool

Set の宣言は以前と同じです。

data Color = R | B deriving Show
data Tree a = E | T Color (Tree a) a (Tree a) deriving Show

次はデータ宣言。ここは特に難しいところはないですね。

instance Set Tree where
  empty = E

  member _ E = False
  member x (T _ a y b)
    | x < y     = member x a
    | x > y     = member x b
    | otherwise = True

empty と member の実装。これも特に難しくなく楽勝モードですね。

balance :: Ord a => Color -> Tree a -> a -> Tree a -> Tree a
balance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
balance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
balance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
balance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
balance color a x b = T color a x b

そして回転。なんともまぁ。赤→赤と続いたノードを赤→黒にしてバランスを取っています。見た目は非常に整然として美しいですね。読めば理解できますが、自力で思いつけるでしょうか。

そしてinsert

  insert x s = let T _ a y b = ins s
               in T B a y b
                  where
                    ins E = T R E x E
                    ins s@(T color a y b)
                      | x < y     = balance color (ins a) y b
                      | x > y     = balance color a y (ins b)
                      | otherwise = s

ins の型を宣言しようとして

                    ins :: Ord a => Tree a -> Tree a

としたのですが、コンパイルに失敗します。

  insert x s = let T _ a y b = ins x s
               in T B a y b
                  where
                    ins :: Ord a => a -> Tree a -> Tree a
                    ins x E = T R E x E
                    ins x s@(T color a y b)
                      | x < y     = balance color (ins x a) y b
                      | x > y     = balance color a y (ins x b)
                      | otherwise = s

こうすれば上手くコンパイルが通るのですが、せっかく x を上手く使ってたのが勿体無いですね。最初のコードで型宣言する方法は無いものでしょうかね？

ちなみに巻末の付録では insert は以下の様になっていました。

  insert x s = T B a y b
    where
      ins E = T R E x E
      ins s@(T color a y b)
        | x < y     = balance color (ins a) y b
        | x > y     = balance color a y (ins b)
        | otherwise = s
      T _ a y b = ins s

やっぱり変数宣言も where で上手に行っていますね。