03

20

[Haskell] 第8回 演習問題と解答例

2013.03.20(09:50)

関数型プログラミング言語 社内学習会 第8回 型や型クラスを自分で作ろう 演習問題と解答例

平衡二分木かどうかの判定をする問題。
これが最良とはいえないような気がするが、よりベターな解にはなっていると思う。

{-# OPTIONS -Wall -Werror #-}

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

-- | 要素をTreeに追加する
-- | すでに存在していたら、そのNodeをそのまま返すタイプの二分木
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x Empty = Node x Empty Empty
treeInsert x (Node a left right)
    | x == a    = (Node a left right)
    | x < a     = (Node a (treeInsert x left) right)
    | otherwise = (Node a left (treeInsert x right))

-- | 要素が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

-- | [a]を空のTreeに追加する
list2Tree :: (Ord a) => [a] -> Tree a
list2Tree []   = Empty
list2Tree list = foldr treeInsert Empty list

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

{-
-- | 上の定義を使って、
-- | 上の関数を使って、(または改良して使って、または使わずに)、次の問題を解いてください。

-- | 問題 7.7.1 Treeの高さを求める関数getHeightを作ってください。
getHeight :: Tree a -> Int

-- | 問題 7.7.2 Treeが平衡木のときにTrueを返す関数を実装してください。
-- | 平衡木とは、どのノードの2つの部分木も、その高さの差が1以下である
-- | ような木であると定義します。
isBalanced :: Tree a -> Bool

-- | 余裕のある人は次の問題も解いてみてください。
-- | 問題 7.7.3 isBalancedをさらに改良してください
-- | 左か右の子のいずれかが平衡木でなければ、もうそれ以外の木を判定する必要はありません。
-- | その場合は探索を打ち切ってただちにFalseを返すような関数を作ってください。
isBalanced' :: Tree a -> Bool
-}

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

-- | Treeが平衡だったらTrue
isBalanced :: Tree a -> Bool
isBalanced Empty = True
isBalanced (Node _ left right)
    = if heightDiff > 1 then False
                        else isBalanced left && isBalanced right
         where heightDiff = abs $ getHeight left - getHeight right
-- | ----------------------- アルゴリズム2 ---------------------------
-- | leftとrightのどちらかが平衡でなければ-1を返す
-- | そうでなければ 1 + leftとrightの高い方を返す
shortCut :: Int -> Int -> Int
shortCut leftHeight rightHeight
    | leftHeight  == (-1) = (-1)
    | rightHeight == (-1) = (-1)
    | (abs $ leftHeight - rightHeight) > 1 = (-1)
    | otherwise           = 1 + max leftHeight rightHeight

-- | Treeの高さを求める
-- | 自分から孫の範囲で平衡でなければ-1を返す
checkHeight :: Tree a -> Int
checkHeight Empty = 0
checkHeight (Node _ Empty (Node _ _ (Node _ _ _))) = (-1)
checkHeight (Node _ Empty (Node _ (Node _ _ _) _)) = (-1)
checkHeight (Node _ (Node _ (Node _ _ _) _) Empty) = (-1)
checkHeight (Node _ (Node _ _ (Node _ _ _)) Empty) = (-1)
checkHeight (Node _ left right) 
            = shortCut leftHeight rightHeight
                       where leftHeight = checkHeight left
                             rightHeight = checkHeight right

-- | Treeが平衡だったらTrue
isBalanced' :: Tree a -> Bool
isBalanced' t = checkHeight t /= (-1)
-- | ---------------------- テスト ---------------------------
-- | Treeを巡回してprintする
traverse :: (Show a) => Tree a -> IO ()
traverse Empty = putStr ""
traverse (Node a left right) = do traverse left
                                  putStrLn $ show a
                                  traverse right

-- | ユニットテスト
balanceTest :: Test
balanceTest = test [
        (tree2List $ list2Tree "2013") ~=? ['0'..'3'],

        (getHeight Empty) ~=? 0,
        (getHeight (Node 'a' Empty Empty)) ~=? 1,
        (getHeight (Node 'a' (Node 'b' Empty Empty) Empty)) ~=? 2,
        (getHeight (Node 'a' (Node 'b' (Node 'c' Empty Empty) Empty) Empty)) ~=? 3,
        (getHeight (Node 'a' (Node 'b' Empty Empty) (Node 'c' Empty Empty))) ~=? 2,

        (getHeight $ list2Tree ([]::[Int])) ~=? 0,
        (getHeight $ list2Tree ([1]::[Int])) ~=? 1,
        (getHeight $ list2Tree ([1,2]::[Int])) ~=? 2,
        (getHeight $ list2Tree ([1,3,2]::[Int])) ~=? 2,
        (getHeight $ list2Tree ([1,2,3]::[Int])) ~=? 3,
        (getHeight $ list2Tree ([1,3,5,7,9,11,13,15,2,6,10,14,4,12,8]::[Int])) ~=? 4,
        (getHeight $ list2Tree ([5,9,2,6,10,14,4,12,8]::[Int])) ~=? 4,
        (getHeight $ list2Tree ([5,9,6,10,14,4,12,8]::[Int])) ~=? 4,
        (getHeight $ list2Tree ([1..10]::[Int])) ~=? 10,

        (isBalanced Empty) ~=? True,
        (isBalanced (Node 'a' Empty Empty)) ~=? True,
        (isBalanced (Node 'a' (Node 'b' Empty Empty) Empty)) ~=? True,
        (isBalanced (Node 'a' (Node 'b' (Node 'c' Empty Empty) Empty) Empty)) ~=? False,
        (isBalanced (Node 'a' (Node 'b' Empty Empty) (Node 'c' Empty Empty))) ~=? True,

        (isBalanced $ list2Tree ([]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([1]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([1,2]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([1,3,2]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([1,2,3]::[Int])) ~=? False,
        (isBalanced $ list2Tree ([1,3,5,7,9,11,13,15,2,6,10,14,4,12,8]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([5,9,2,6,10,14,4,12,8]::[Int])) ~=? True,
        (isBalanced $ list2Tree ([5,9,6,10,14,4,12,8]::[Int])) ~=? False,
        (isBalanced $ list2Tree ([1..10]::[Int])) ~=? False,


        (isBalanced' $ list2Tree ([1..10]::[Int])) ~=? False,
        (isBalanced' $ list2Tree ([1..10000]::[Int])) ~=? False,

        isBalanced myTree1 ~=? True,
        isBalanced myTree2 ~=? False,
        isBalanced myTree3 ~=? False,
        isBalanced myTree4 ~=? False,
        isBalanced' myTree1 ~=? True,
        isBalanced' myTree2 ~=? False,
        isBalanced' myTree3 ~=? False,
        isBalanced' myTree4 ~=? False,
        True ~=? True
    ] where myTree1 = list2Tree ([5,10,3,12,8]::[Int])  -- balanced
            myTree2 = list2Tree ([4,3,1]::[Int])
            myTree3 = list2Tree ([2,5,3,4,0,1]::[Int])
            myTree4 = list2Tree ([1,3,2,5,4,7,6]::[Int])

-- | quickCheck
prop_balance :: [Int]->Bool
prop_balance nums = (isBalanced myTree == isBalanced' myTree)
                     where myTree = list2Tree nums

-- | main
main :: IO ()
main = do
       -- let nums = [5,10,3,12,8]
       -- let nums = [8,6,4,1,7,3,5] -- balanced
       let nums = ([8,7,6,5,4,3,1]::[Int]) -- un-balanced
       let t = foldr treeInsert Empty nums
       print t
       print $ treeElem 3 t
       print $ treeElem 2 t
       print $ getHeight t
       print $ isBalanced t
       print $ isBalanced' t
       traverse t
       mapM_ (putStrLn.show) $ scanr treeInsert Empty nums 
       putStrLn . tree2List $ list2Tree "Hello,World! 2013"
       let nums2 = ([1000,999..1]::[Int]) -- un-balanced
       print $ isBalanced' $ foldr treeInsert Empty nums2
       _ <- runTestTT balanceTest
       quickCheck prop_balance
       return ()

プロフィール

島敏博

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リンクの表示