01

02

[Haskell] 高さが最小となる二分探索木(binary search tree)を作る

2013.01.02(16:18)

世界で闘うプログラミング力を鍛える150問
http://www.amazon.co.jp/dp/4839942390/
の問題4.3 をHaskellで解いてみた。

問題4.3 昇順にソートされた配列が与えられたとき、 高さが最小となる二分探索木(binary search tree)を作るアルゴリズムを書いてください。

配列がすでにソートされているなら、真ん中の値がルートになるように二分木を作り、左にあるものの中央が左のノードに、右にあるものの中央が右のノードに来るようにして、あとはそれを繰り返せばOK。

Haskellだときれいに短く書けるのでうれしい。今回は問題を解くよりも、テストを書くほうが3倍ぐらい難しかった。

{-# OPTIONS -Wall -Werror #-}

module Tree where
import Test.HUnit
import Test.QuickCheck

-- | ----------------------- 木を植えよう ---------------------------
-- | すごいHaskell 7.7 再帰的なデータ構造
-- | Tree型の定義
data Tree a = Empty | Node a (Tree a) (Tree a)
              deriving Show

-- | 要素がTreeに含まれていればTrue
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem _ Empty = False
treeElem x (Node a left right)
    | x == a    = True
    | x < a     = treeElem x left
    | otherwise = treeElem x right

-- | Treeの高さを求める
getHeight :: Tree a -> Int
getHeight Empty = 0
getHeight (Node _ left right)
    = max (getHeight left) (getHeight right) + 1

-- | ------------- 世界で闘うプログラミング力を鍛える150問 -----------------
-- | 問題 4.3 昇順にソートされた配列が与えられたとき、
-- | 高さが最小となる二分探索木(binary search tree)を作るアルゴリズムを書いてください。

-- | Intを2で割る
div2 :: Int->Int
div2 n = truncate ((fromIntegral n :: Float) / 2.0)

-- | [a]を前半と真ん中と後半の3つの部分に分ける
divArrayIn3 :: [a] -> ([a],a,[a])
divArrayIn3 [] = error "error"
divArrayIn3 [x] = ([],x,[])
divArrayIn3 xs = (first,middle,second)
   where halfLength = div2 $ length xs
         first = take halfLength xs
         middle:second = drop halfLength xs

-- | 高さが最小となる二分探索木を作る
-- | リストの真ん中をノードに、左の二分探索木を左の枝に、右の二分探索木を右の枝に
-- | この処理では、要素の大小比較を行っていないことに注意。(Ord a)のリストではない。
createMinumulBST :: [a] -> Tree a
createMinumulBST [] = Empty
createMinumulBST xs = Node middle left right
    where (first,middle,second) = divArrayIn3 xs
          left = createMinumulBST first
          right = createMinumulBST second

-- | ---------------------- テスト ---------------------------
-- | クイックソート
qsort :: (Ord a) => [a] -> [a]  
qsort []     = []  
qsort (x:xs) = qsort left ++ [x] ++ qsort right
               where left  = filter (< x)  xs  
                     right = filter (>= x) xs  

-- | Treeを巡回してprintする
traverse :: (Show a) => Tree a -> IO ()
traverse Empty = putStr ""
traverse (Node a left right) = do traverse left
                                  putStrLn $ show a
                                  traverse right

-- | [a]を空のTreeに追加する
list2Tree :: (Ord a) => [a] -> Tree a
list2Tree list = createMinumulBST $ qsort list

-- | Treeを巡回して[a]を作る
tree2List :: Tree a -> [a]
tree2List Empty = []
tree2List (Node a left right) = (tree2List left) ++ [a] ++ (tree2List right)

-- | 整数のlog2をとる関数
-- | [0,1,2,3,4,..]と
-- | [2,4,8,16,32,..]から
-- | [(0,2),(1,4),(2,8),(3,16),(4,32),..]を使って
-- | 2,3ならば1を、4,5,6,7ならば2を、8,9,10,11,12,13,14,15ならば3を返す関数
log2 :: Int -> Int
log2 n = head [b|(b,p) <- zip [0..] (iterate (*2) 2), n<=(p-1)]

-- | ユニットテスト
mbstTest :: Test
mbstTest = test [
        (tree2List $ list2Tree ([]::[Int])) ~=? ([]::[Int]),
        (tree2List $ list2Tree ([2]::[Int])) ~=? ([2]::[Int]),
        (tree2List $ list2Tree ([1,2,3,4]::[Int])) ~=? ([1,2,3,4]::[Int]),
        (tree2List $ list2Tree ([1,3,4,2]::[Int])) ~=? ([1,2,3,4]::[Int]),
        (tree2List $ list2Tree ([1..100]::[Int])) ~=? ([1..100]::[Int]),
        (tree2List $ list2Tree ([100,99..1]::[Int])) ~=? ([1..100]::[Int]),
        (tree2List $ list2Tree "2013") ~=? ['0'..'3'],
        (getHeight $ createMinumulBST ([1..7]::[Int])) ~=? 3,
        (getHeight $ createMinumulBST ([1..15]::[Int])) ~=? 4,
        (getHeight $ createMinumulBST ([1..31]::[Int])) ~=? 5,
        (getHeight $ createMinumulBST ([1..63]::[Int])) ~=? 6,
        (getHeight $ createMinumulBST ([1..127]::[Int])) ~=? 7,
        (getHeight $ createMinumulBST ([1..128]::[Int])) ~=? 8,
        (log2 7) ~=? 2,
        (log2 8) ~=? 3,
        (getHeight $ createMinumulBST ([1..7]::[Int])) ~=? (log2 (length ([1..7]::[Int]))+1),
        True ~=? True
    ]

-- | quickCheck
prop_mbst :: [Int]->Property
prop_mbst nums = 
          (length nums > 0) 
          ==> height1 == height2 && list1 == list2
             where 
                   -- ランダムに発生させた[Int]をソートしてlist1を作り
                   list1 = qsort nums
                   -- ソートしたlist1から二分探索木を作り
                   bst = createMinumulBST list1
                   -- その高さを求めると、
                   height1 = getHeight bst
                   -- リストの長さのlog2をとって1を加えたものと一致するはず
                   height2 = log2 (length nums) + 1
                   -- 二分探索木から要素のリストを作り出すとそれは最初に加えたリストと一致するはず
                   list2 = tree2List bst

-- | main
main :: IO ()
main = do 
       traverse $ createMinumulBST ([1..15]::[Int])
       print $ createMinumulBST ([1..15]::[Int])
       _ <- runTestTT mbstTest
       quickCheck prop_mbst
       return ()


実行結果
> :main
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Node 8 (Node 4 (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty)) (Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty))) (Node 12 (Node 10 (Node 9 Empty Empty) (Node 11 Empty Empty)) (Node 14 (Node 13 Empty Empty) (Node 15 Empty Empty)))

Cases: 17  Tried: 0  Errors: 0  Failures: 0
Cases: 17  Tried: 1  Errors: 0  Failures: 0
Cases: 17  Tried: 2  Errors: 0  Failures: 0
Cases: 17  Tried: 3  Errors: 0  Failures: 0
Cases: 17  Tried: 4  Errors: 0  Failures: 0
Cases: 17  Tried: 5  Errors: 0  Failures: 0
Cases: 17  Tried: 6  Errors: 0  Failures: 0
Cases: 17  Tried: 7  Errors: 0  Failures: 0
Cases: 17  Tried: 8  Errors: 0  Failures: 0
Cases: 17  Tried: 9  Errors: 0  Failures: 0
Cases: 17  Tried: 10  Errors: 0  Failures: 0
Cases: 17  Tried: 11  Errors: 0  Failures: 0
Cases: 17  Tried: 12  Errors: 0  Failures: 0
Cases: 17  Tried: 13  Errors: 0  Failures: 0
Cases: 17  Tried: 14  Errors: 0  Failures: 0
Cases: 17  Tried: 15  Errors: 0  Failures: 0
Cases: 17  Tried: 16  Errors: 0  Failures: 0
                                            
Cases: 17  Tried: 17  Errors: 0  Failures: 0
+++ OK, passed 100 tests.
it :: ()
(0.06 secs, 12517572 bytes)

プロフィール

島敏博

Shima Toshihiro 島敏博
信州アルプスハイランド在住。HaskellとElixirが好き。組み込みソフトウェアアーキテクト、C++プログラマ、山歩き、美術館巡り、和食食べ歩き、日本赤十字社救急法指導員、インデックス投資、クラシック音楽、SESSAME会員、状態マシン設計、モデル駆動開発、ソフトウェアプロダクトライン、Rubyist、実践ビジネス英語

■ ツイッター
http://twitter.com/saltheads
■ Facebook
http://www.facebook.com/saltheads
■ Qiita
http://qiita.com/saltheads

印刷する場合は、ブラウザの印刷メニューではなく、このページの上から3cmくらいの青いところにある、「印刷」を押してみてください。少しうまく印刷できます。まだ完全ではないのですが、これで勘弁してください。


カテゴリ
最新記事
月別アーカイブ
最新コメント
検索フォーム
リンク
sessame
RSSリンクの表示