2012年1月15日日曜日

Red-Black Tree の balance 処理の最適化 (をしても速くならない・・・)

Purely Functional Data Structures の Chapter 3.3 では Red-Black trees を扱っている。
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 で実装するとなにか違いが出るのだろうか・・・?

2012年1月8日日曜日

Criterionを使ったHaskellコードのパフォーマンス計測

LeftistHeapは、要素を挿入するときや削除するときに、右か左の部分木に対して再帰的な操作を行う。この時、左右どちらで再帰しても正しく動作するが、パフォーマンスに影響を与える。という話。

Haskell にはパフォーマンス計測用のフレームワーク Criterion があるので、これを使って調べてみた。

まず、計測対象のプログラムを準備する。デフォルトの実装では右の子供に対して再帰しているので、比較用に、左に再帰する関数 insertL と deleteMinL を実装する。(計測用に使うだけなので、LeftistHeapモジュールの外で実装したかったが、データコンストラクタでパターンマッチしないといけない、つまり、LeftistHeapの内部構造を知らないといけないので、LeftistHeap内で実装するしかない。)コードは github にアップした。

次に、計測用のコードを書く。
main = defaultMain [ bench "Left"  $ whnf (findMax insertL deleteMinL) ns,
                     bench "Right" $ whnf (findMax insert deleteMin) ns ]
whnf は、計測対象の関数(を 1 引数にカリー化したもの)とその関数への引数を取って、Weak Head Normal Form に簡約する。同様に Head Normal Form まで簡約する nf もある。

計測用のコード全体は以下の通り。
import Criterion.Main
import LeftistHeap
import System.Random

type Rand a = StdGen -> (a, StdGen)

randomInts :: Int -> Rand [Int]
randomInts 0 rng = ([], rng)
randomInts n rng = let (x, rng') = next rng
                       (xs, rng'') = randomInts (n - 1) rng'
                    in (x:xs, rng'')

findMax :: (Int -> LeftistHeap Int -> LeftistHeap Int) ->
(LeftistHeap Int -> LeftistHeap Int) -> [Int] -> Int
findMax ins del ns = findMax' $ foldr ins empty ns
  where
    findMax' :: LeftistHeap Int -> Int
    findMax' h = let e  = findMin h
                     h' = del h
                  in if isEmpty h' then e else findMax' h'

main :: IO ()
main = do stdGen <- newStdGen
          let (ns, _) = randomInts 1000 stdGen
           in defaultMain [ bench "Left"  $ whnf (findMax insertL deleteMinL) ns,
                            bench "Right" $ whnf (findMax insert deleteMin) ns
                          ]  
これを ghc でコンパイルして実行する。当然だが、パフォーマンスの計測なので、ghciで実行しても意味ない。
> ghc -O --make PerfLHeap.hs && ./PerfLHeap
warming up
estimating clock resolution...
mean is 4.512760 us (160001 iterations)
found 3996 outliers among 159999 samples (2.5%)
3234 (2.0%) high severe
estimating cost of a clock call...
mean is 81.74308 ns (34 iterations)
found 6 outliers among 34 samples (17.6%)
1 (2.9%) high mild
5 (14.7%) high severe

benchmarking Left
mean: 18.68245 ms, lb 18.60457 ms, ub 18.83024 ms, ci 0.950
std dev: 532.2852 us, lb 332.5989 us, ub 909.0032 us, ci 0.950
found 14 outliers among 100 samples (14.0%)
2 (2.0%) high mild
12 (12.0%) high severe
variance introduced by outliers: 22.891%
variance is moderately inflated by outliers

benchmarking Right
mean: 1.579322 ms, lb 1.574251 ms, ub 1.589812 ms, ci 0.950
std dev: 35.82818 us, lb 20.36439 us, ub 58.87072 us, ci 0.950
found 6 outliers among 100 samples (6.0%)
6 (6.0%) high severe
variance introduced by outliers: 16.123%
variance is moderately inflated by outliers
赤字のとおり Right の方が速いことがわかった。
Leftist Heap は、左の子の rank (一番右末端までの深さ) を、右の子より長く保とうとするので、左の部分木の方が高くなる。insertL, deleteMinL は、右の子に対して再帰的な操作 (merge) を行うことで、木をバランスさせる方向に働くため、Right の方が速い、と直感的には理解した。

Criterion は、単にプログラムの経過時間を測るだけではなく、もっと賢いことをしてくれるようだ。
最初にクロックの分解能や、クロックの値を取得するコストを調べ、これらの測定誤差に影響されないようにするには、測定対象の関数を何回実行すれば良いかを計算し、その回数実行する。
上記の結果は、Thinkpad X121e Core i3 2367M 1.4GHz + Fedora 16 での計測結果だが、分解能が 4.5us で、呼び出しコストが 81ns だった(青字の部分)。Left については、計測 1 回ごとに計測対象 "whnf (findMax insertL deleteMinL) ns" を 1 回呼び出し、これを 100 回ループする。
Right については、計測 1 回ごとに計測対象 "whnf (findMax insert deleteMin) ns" を 3 回呼び出し、これを 100 回ループする。

平均値と標準偏差、そしてそれぞれの信頼度 95% での上限値と下限値(統計素人なので用語がおかしいかも)を表示する。外れ値が標準偏差にどのくらい影響しているかも表示する。

time コマンドを使って、プロセス開始から終了までの経過時間を測定するのと比べると、だいぶ賢く計測するので、「ちゃんと計測したぜ」感が出せる。

ただし、計測対象のコードを正しく書くことが当然必要。今回の場合、Leftist Heap に突っ込む乱数データの生成が測定対象に入っているのかいないのかよくわからない(遅延評価なので)。どっちにしろ Right が優位なのは変わらないが。

シーシェパードという愉快犯型テロリストの傾向と対策 - 第1版

9.11が起こったあと、「テロとの戦争」という言葉を聞くようになった。従来の国と国との戦争は、代表者(政府)と交渉したり、代表者を殲滅すれば解決したけど、テロリストはどういう団体かわからないし、わからないから殲滅することもできない。だからそもそもテロリストが生まれないようにしよう、という話があった。

従来のテロリストの傾向と対策

いわゆる「テロリスト」、日本人にとっての典型的な「テロリスト」は「某宗教から派生した過激派たちの集まり」だと思うが、はなぜ生まれるのか。

職・収入がない人たちがいて、その国には社会保障もない。このままだと死んでしまう、というときに「食べ物あげるよ」といって、ある団体が助けてくれる。普段は中央政府から不合理な差別を受けているが、その団体の中ではそんなことはない(あったとしても普段よりましだ)。

・・・というのが想像できるストーリーだ。

なので、テロリストが生まれないようにするには、公正な中央政府を作り、すべての国民に最低限の生活を保証することが重要だ。貧しい人々・国をほっとくと、単に貧困で死んでいくのではなく、テロリストになって豊かな人たちの害にもなるから、みんなで豊かになりましょう、ということだ。

これは従来型の戦争の根本的対策(共産化の防止とか)とほとんど同じだけど、国という大きな単位で豊かなだけでは十分じゃなくて、地方団体や個人のレベルでも豊かにならないと戦争は防げないという点で、さらに対策が難しくなったと思う。


愉快犯型テロリストの傾向と対策は?

今や珍しくもないが、またシーシェパードが拘束された。彼らは、不法行為を意図的に繰り返しているので、テロリストであることは間違いない。しかし、従来型テロリストとは違うようだ。

シーシェパードの活動拠点のアメリカ(とオーストラリア?)は典型的な先進国で、公正な政府があり、職も社会保障も充実している。シーシェパードで「働いて」いる人たちは、おそらく普通の社会でも職を見つけて生活できるだろう。この人たちは、死なないためにテロ活動をしているのではなく、生きがいのためにテロ活動をしているのではないか。「クジラと地球を守ってるオレかっこいい」ということだ。

都合が悪いことに(彼らにとっては都合が良いことに)、この「生きがい」は有名人や大企業の支援によって、正当なものになりつつある(と、彼らが錯覚できるような環境が整いつつある)。

従来型テロリストと同様に考えると、政府が「生きがい」を提供する、という対策に行き着くが、これは難しい。
生きがいとはある程度主観的なもので、政府が画一的に提供できるものではない。それに、よくある市民団体や左翼運動と同じで、「政府・マジョリティに反発するのがかっこいい」からだ。

シーシェパードは元は、「クジラかわいい♡」人たちの市民団体だったと思う。それが今や馬鹿なハリウッドスターが支援し、「環境にやさしい」(笑)大企業が資金援助するテロリストになってしまった。多くの人が支援していて自国に害がないので、無責任なオーストラリア政府は黙認状態だし、公式に支持している政治家すらいる。

誰がいつ何をしていれば、このテロリストはここまでひどくならなかったのか、まだわからない。でも、こういう愉快犯型テロリストは今後もでてきそうだ。


追記
もっとうまくまとめられそうだけど、時間が無いので第1版としておく。