Red-Black tree は、各ノードを赤色と黒色に塗り分けて、それが適当な条件を守るように木を変形させることで balanced tree を実現するアルゴリズム。（ここでは、insert （木に要素を追加する）と member （木に要素が含まれているかチェックする）しか扱っていない。）
Exercise 3.10 はバランス処理の最適化に関する問題のようだが、試してみても速くならなかった、というエントリ。ソースコードは github にアップした。
insert は、木を下りながら要素を追加すべき場所を求め、木を上りながら red-black をチェックし、木をバランスさせていく、という処理を行う。本に載っている実装はこんな感じ。ins 関数が、x と v との大小比較をして挿入する場所を求め、最後に balance 関数を呼んで木をバランスさせている。
data Color = R | B deriving Show
data RedBlackSet a = E0 | T0 Color (RedBlackSet a) a (RedBlackSet a) deriving Show
balance :: Color -> RedBlackSet a -> a -> RedBlackSet a -> RedBlackSet a
balance B (T0 R (T0 R a x b) y c) z d = T0 R (T0 B a x b) y (T0 B c z d)
balance B (T0 R a x (T0 R b y c)) z d = T0 R (T0 B a x b) y (T0 B c z d)
balance B a x (T0 R (T0 R b y c) z d) = T0 R (T0 B a x b) y (T0 B c z d)
balance B a x (T0 R b y (T0 R c z d)) = T0 R (T0 B a x b) y (T0 B c z d)
balance color a x b = T0 color a x b
instance Ord a => Set RedBlackSet a where
empty = E0
member _ E0 = False
member x (T0 _ a y b)
| x < y = member x a
| x > y = member x b
| otherwise = True
insert x s = T0 B a y b
where
ins E0 = T0 R E0 x E0
ins n@(T0 color l v r)
| x < v = balance color (ins l) v r
| x > v = balance color l v (ins r)
| otherwise = n
T0 _ a y b = ins s
Exercise 3.10 の主旨は「balance 関数の無駄なチェックを無くせ」というもの。
例えば、左の子に新要素を挿入したなら、右の子は全く変化しないので、右の子の色をチェックする必要はない。Ex. 3.10 (a) の回答が次のコード。balance が lbalance と rbalance とに分かれている。
balance に含まれるパターンマッチの数が 5 で、lbalance, rbalance は 3 なので、分岐の数が減り、速くなると思われる。
data RedBlackSet1 a = E1 | T1 Color (RedBlackSet1 a) a (RedBlackSet1 a) deriving Show
lbalance :: Color -> RedBlackSet1 a -> a -> RedBlackSet1 a -> RedBlackSet1 a
lbalance B (T1 R (T1 R a x b) y c) z d = T1 R (T1 B a x b) y (T1 B c z d)
lbalance B (T1 R a x (T1 R b y c)) z d = T1 R (T1 B a x b) y (T1 B c z d)
lbalance color a x b = T1 color a x b
rbalance :: Color -> RedBlackSet1 a -> a -> RedBlackSet1 a -> RedBlackSet1 a
rbalance B a x (T1 R (T1 R b y c) z d) = T1 R (T1 B a x b) y (T1 B c z d)
rbalance B a x (T1 R b y (T1 R c z d)) = T1 R (T1 B a x b) y (T1 B c z d)
rbalance color a x b = T1 color a x b
instance Ord a => Set RedBlackSet1 a where
empty = E1
member _ E1 = False
member x (T1 _ a y b)
| x < y = member x a
| x > y = member x b
| otherwise = True
insert x s = T1 B a y b
where
ins E1 = T1 R E1 x E1
ins n@(T1 color l v r)
| x < v = lbalance color (ins l) v r
| x > v = rbalance color l v (ins r)
| otherwise = n
T1 _ a y b = ins s
Exercise 3.10 (b) は、
この考え方をもう一段拡張して、孫のチェックも無くせ。変更していないパスの色をチェックするな。といっている。
ins v の再帰呼び出しが終わった時点で、v の左右の子どちらが変更されたのかわかるので、[lr]balance の内部で孫を 2 人チェックするのは確かに無駄だ。ins が、左右どちらを変更したかという情報も返してやれば、それを使うことで孫のパターンマッチを省けるだろう、と思ってこういう実装をしてみた。data RedBlackSet2 a = E2 | T2 Color (RedBlackSet2 a) a (RedBlackSet2 a) deriving Show
llbalance :: Color -> RedBlackSet2 a -> a -> RedBlackSet2 a -> RedBlackSet2 a
llbalance B (T2 R (T2 R a x b) y c) z d = T2 R (T2 B a x b) y (T2 B c z d)
llbalance color a x b = T2 color a x b
lrbalance :: Color -> RedBlackSet2 a -> a -> RedBlackSet2 a -> RedBlackSet2 a
lrbalance B (T2 R a x (T2 R b y c)) z d = T2 R (T2 B a x b) y (T2 B c z d)
lrbalance color a x b = T2 color a x b
rlbalance :: Color -> RedBlackSet2 a -> a -> RedBlackSet2 a -> RedBlackSet2 a
rlbalance B a x (T2 R (T2 R b y c) z d) = T2 R (T2 B a x b) y (T2 B c z d)
rlbalance color a x b = T2 color a x b
rrbalance :: Color -> RedBlackSet2 a -> a -> RedBlackSet2 a -> RedBlackSet2 a
rrbalance B a x (T2 R b y (T2 R c z d)) = T2 R (T2 B a x b) y (T2 B c z d)
rrbalance color a x b = T2 color a x b
data Modified = LChild | RChild | NoChild
instance Ord a => Set RedBlackSet2 a where
empty = E2
member _ E2 = False
member x (T2 _ a y b)
| x < y = member x a
| x > y = member x b
| otherwise = True
insert x s = T2 B a' y b'
where
ins E2 = (T2 R E2 x E2, NoChild)
ins n@(T2 c l v r)
| x < v = case ins l of
(insl, LChild) -> (llbalance c insl v r, LChild)
(insl, RChild) -> (lrbalance c insl v r, LChild)
(insl, NoChild) -> (T2 c insl v r, LChild)
| x > v = case ins r of
(insr, LChild) -> (rlbalance c l v insr, RChild)
(insr, RChild) -> (rrbalance c l v insr, RChild)
(insr, NoChild) -> (T2 c l v insr, RChild)
| otherwise = (n, NoChild)
(T2 _ a' y b', _) = ins s
・・・が、たしかに {ll,lr,rl,rr}balance 内のパターンマッチは減るが、ins 内にもう一段パターンマッチが増えてしまっている。これでは速くならん気がする。
別のやり方も考えてみた。そもそも ins のパターンマッチで孫まで見てしまえば、どのパスが変更されるのかわかるはず。
data RedBlackSet3 a = E3 | T3 Color (RedBlackSet3 a) a (RedBlackSet3 a) deriving Show
llbalance3 :: Color -> RedBlackSet3 a -> a -> RedBlackSet3 a -> RedBlackSet3 a
llbalance3 B (T3 R (T3 R a x b) y c) z d = T3 R (T3 B a x b) y (T3 B c z d)
llbalance3 color a x b = T3 color a x b
lrbalance3 :: Color -> RedBlackSet3 a -> a -> RedBlackSet3 a -> RedBlackSet3 a
lrbalance3 B (T3 R a x (T3 R b y c)) z d = T3 R (T3 B a x b) y (T3 B c z d)
lrbalance3 color a x b = T3 color a x b
rlbalance3 :: Color -> RedBlackSet3 a -> a -> RedBlackSet3 a -> RedBlackSet3 a
rlbalance3 B a x (T3 R (T3 R b y c) z d) = T3 R (T3 B a x b) y (T3 B c z d)
rlbalance3 color a x b = T3 color a x b
rrbalance3 :: Color -> RedBlackSet3 a -> a -> RedBlackSet3 a -> RedBlackSet3 a
rrbalance3 B a x (T3 R b y (T3 R c z d)) = T3 R (T3 B a x b) y (T3 B c z d)
rrbalance3 color a x b = T3 color a x b
instance Ord a => Set RedBlackSet3 a where
empty = E3
member _ E3 = False
member x (T3 _ a y b)
| x < y = member x a
| x > y = member x b
| otherwise = True
insert x s = T3 B a' y b'
where
ins E3 = T3 R E3 x E3
ins n@(T3 c E3 v E3)
| x < v = T3 c (ins E3) v E3
| x > v = T3 c E3 v (ins E3)
| otherwise = n
ins n@(T3 c l@(T3 _ _ lv _) v E3)
| x < lv = llbalance3 c (ins l) v E3
| x < v = lrbalance3 c (ins l) v E3
| x > v = T3 c l v (ins E3)
| otherwise = n
ins n@(T3 c E3 v r@(T3 _ _ rv _))
| x < v = T3 c (ins E3) v r
| x < rv = rlbalance3 c E3 v (ins r)
| x > rv = rrbalance3 c E3 v (ins r)
| otherwise = n
ins n@(T3 c l@(T3 _ _ lv _) v r@(T3 _ _ rv _))
| x < lv = llbalance3 c (ins l) v r
| x < v = lrbalance3 c (ins l) v r
| x < rv = rlbalance3 c l v (ins r)
| x > rv = rrbalance3 c l v (ins r)
| otherwise = n
T3 _ a' y b' = ins s
・・・しかしこうすると、ins のパターンマッチの場合分けが増えてしまう。当たり前だが。これも速くなりそうにないなぁ。
ということで、実測してみた。1 から 1000 のソート済みリストとランダムなリストを作り、それを RedBlackSet{,1,2,3} に挿入したあと、0 が含まれているかどうかをチェックする。（このチェックがないと遅延評価のために木の生成処理が最後まで評価されない気がしたが、自信はない。）
結果は以下の通りで、全然速くなってないことがわかった。予想どおりだけど。ソート済みリストに対して RedBlackSet1 が RedBlackSet より遅くなるのは予想外。そしてやはり理解できない。
| ソート済みリスト | ランダムなリスト | |
|---|---|---|
| RedBlackSet （オリジナルの実装） | 2.44 | 2.23 |
| RedBlackSet1 （3.10 (a) の回答） | 2.75 | 1.62 |
| RedBlackSet2 | 2.53 | 2.43 |
| RedBlackSet3 | 3.47 | 2.59 |
この問題の数ページ前に、「Exercise 3.10 の最適化でこの Red-Black tree の実装は飛ぶように速くなる」と書いてあるのだけど、何か見落としてるのだろうか・・・。それとも、Standard ML で実装するとなにか違いが出るのだろうか・・・?
0 件のコメント:
コメントを投稿