54. 二分木かどうか

この問題はHaskell だとコンパイルが通るということがある種の証明になるわけですね。
すなわち型がTree a になることを見ればそのデータが二分木であることが保証されます。
そういう意味でこの問題は答えようがあるともないとも言いにくいわけですが、まぁそういうことです。

Prob54.lhs


> module Prob54 where

Check whether a given term represents a binary tree.

> data Tree a
>   = Empty
>   | Branch a (Tree a) (Tree a)
>   deriving (Show, Eq)

> tree1 
>   = Branch 'a' (Branch 'b' (Branch 'd' Empty Empty)
>                            (Branch 'e' Empty Empty))
>                (Branch 'c' Empty
>                            (Branch 'f' (Branch 'g' Empty Empty)
>                                        Empty))
>
> -- leaf :: a -> Tree a
> leaf x = Branch x Empty Empty
>
> tree1'
>   = Branch 'a' (Branch 'b' (leaf 'd')
>                            (leaf 'e'))
>                (Branch 'c' Empty
>                            (Branch 'f' (leaf 'g')
>                                        Empty))

  *Prob54> :t tree1
  tree1 :: Tree Char
  *Prob54> :t tree1'
  tree1' :: Tree Char
  *Prob54> tree1 == tree1'
  True

> tree2 :: Tree Char
> tree2 = Branch 'a' Empty Empty

> tree3 :: Tree a
> tree3 = Empty

> tree4 :: Tree Int
> tree4 = Branch 1 (Branch 2 Empty
>                            (Branch 4 Empty Empty))
>                  (Branch 2 Empty Empty)

55. 平衡木を実装せよ。

Completely balanced binary tree とは二分木で、左右の節の数の差が1 か0 であるようなもの、ということらしい。
従ってボトムアップ的に考えれば、再帰的に左右ひだりみぎと節をつけて行ったら良いのであるが、はてさて。

再帰の終了条件は簡単です、引数がゼロになったらEmpty を置いたら良いわけですが、肝心の再帰の部分が思いつきませんでした。
蓋を開けたら簡単で

quotRem = \x y -> (quot x y, rem x y)

を使って2 で割った商と余りを得た後、偶奇で場合分けしていけばよいのをリスト内包表記ですっきりと書いてしまっています。
すなわち引数が1 より大きければまず最初のBranch にx を植えて、(n-1) が偶数か奇数かを考えるわけです。
(n-1) が偶数ならleft もright も同じ深さのサブツリーになり、奇数ならどっちがが一個”だけ”多いよ、となるわけです。
ちょっと時間があいたので再度読み返してみたのですが、なんとなく左詰めなのが気になったので右詰めバージョンも書いてみました。

Prob55.lhs


> module Prob55 where

Construct completely balanced binary trees.

In a completely balanced binary tree, the following property holds for every node: 
The number of nodes in its left subtree and the number of nodes in its right subtree are almost equal, which means their difference is not greater than one.

Write a function cbal-tree to construct completely balanced binary trees for a given number of nodes. 
The predicate should generate all solutions via backtracking. 
Put the letter 'x' as information into all nodes of the tree.

> import Prob54 (Tree(..))

> cbalTree :: Int -> [Tree Char]
> cbalTree 0 = [Empty]                        -- base case
> cbalTree n = let (q, r) = (n-1) `quotRem` 2 -- n-1 = 2*q + r
>   in [ Branch 'x' left right 
>      | i     <- [q .. q+r]                  -- r is 0 or 1
>      , left  <- cbalTree i                  -- i is q or (q or q+1)
>      , right <- cbalTree (n-1 -i)]

  *Prob55> cbalTree 4
  [Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' Empty (Branch 'x' Empty Empty))
  ,Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' (Branch 'x' Empty Empty) Empty)
  ,Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) 
              (Branch 'x' Empty Empty)
  ,Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) 
              (Branch 'x' Empty Empty)
  ]

  *Prob55> map (length . cbalTree) [1..17]
  [1,2,1,4,4,4,1,8,16,32,16,32,16,8,1,16,64]

For given n>0, first Branch is filled.
Next, by dividing we get 
  (n-1) = 2*q + r
If r=0, then i=q, and both left and right sub-trees has q x's.
Else if r=1, we have two choices for sub-trees: 
  (i,(n-1)-i) = (q, q+1) or (q+1,q)

This is the implementation of "from left":

> cbalTree' :: Int -> [Tree Char]
> cbalTree' 0 = [Empty]
> cbalTree' n = let (q,r) = ((n-1) `quot` 2, (n-1) `rem` 2) in
>   [ Branch 'x' l r
>   | i <- [q .. q+r]
>   , r <- cbalTree' i
>   , l <- cbalTree' (n-i-1)]

  [Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) 
              (Branch 'x' Empty Empty)
  ,Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) 
              (Branch 'x' Empty Empty)
  ,Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' (Branch 'x' Empty Empty) Empty)
  ,Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' Empty (Branch 'x' Empty Empty))
  ]

A slightly more efficient version of this solution, which never creates the same tree twice:

> cbalTree1 :: Int -> [Tree Char]
> cbalTree1 0 = [Empty]
> cbalTree1 n =
>   if (n `mod` 2 == 1) then
>       [Branch 'x' l r | l <- subtree (n-1), r <- subtree (n-1)] 
>   else
>       concat [ [Branch 'x' l r, Branch 'x' r l]
>              | l <- subtree (n-1), r <- subtree n]
>   where 
>     subtree n = cbalTree1 (n `div` 2)

  *Prob55> cbalTree 4 
  [Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty (Branch 'x' Empty Empty)),Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' (Branch 'x' Empty Empty) Empty),Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) (Branch 'x' Empty Empty),Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty Empty)]
  *Prob55> cbalTree1 4
  [Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty (Branch 'x' Empty Empty)),Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) (Branch 'x' Empty Empty),Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' (Branch 'x' Empty Empty) Empty),Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty Empty)]

56. 対称二分木

対称軸で折り曲げた時に同じ”構造”かどうかを判定しろ、とのことです。
ヒントにあるようにまずは２つの木が鏡像になってるかどうかを判定する関数を作って、それを使ったらよいです。
解答とそっくり同じになりました、さらに

isSym t = t `isMir` t

に気がつけばもっと良かったですね。

胸像かどうかは自然に再帰的に書けまして、左の左と右の右、みたいな対応を再帰的に積み上げていくだけです。

Prob56.lhs


> module Prob56 where

Symmetric binary trees

Let us call a binary tree symmetric if you can draw a vertical line through the root node and then the right subtree is the mirror image of the left subtree. 
Write a predicate symmetric/1 to check whether a given binary tree is symmetric. 
Hint: Write a predicate mirror/2 first to check whether one tree is the mirror image of another. 
We are only interested in the structure, not in the contents of the nodes.

> import Prob54 (Tree(..))
>
> isMir :: Tree a -> Tree a -> Bool
> isMir Empty Empty = True
> isMir (Branch _ l1 r1) (Branch _ l2 r2) = (l1 `isMir` r2) && (r1 `isMir` l2)
> isMir _     _     = False

> isSym :: Tree a -> Bool
> isSym Empty = True
> isSym (Branch _ left right) = left `isMir` right
> -- isSym t = t `isMir` t

  *Prob56> isSym (Branch 'x' (Branch 'x' Empty Empty) Empty)
  False
  *Prob56> isSym (Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty Empty))
  True

57. 二分探索木（辞書）

書いてからそういえばlearnyouahaskell.comに同じようなのあったような、、、とおもったらやっぱり有りました。

さて、ここでは素朴に再帰で書きましたが、２分探索木は大小比較していって所定の場所に挿入できる関数を実装すれば畳み込めます、というわけで模範解答からfoldl を使って畳み込む方法も載せました。

高階関数をもっと自由自在に使えるようになりたいですねぇ。

Prob57.lhs


> module Prob57 where

Binary search trees (dictionaries)

Use the predicate add/3, developed in chapter 4 of the course, to write a predicate to construct a binary search tree from a list of integer numbers.

> import Prob54 (Tree(..))
> import Prob56 (isSym)
>
> consTree :: (Ord a) => [a] -> Tree a
> consTree [] = Empty
> consTree (n:ns) = Branch n left right
>   where
>     left  = consTree [m| m <- ns, m < n]
>     right = consTree [m| m <- ns, m > n]

  *Prob57> consTree [3,2,5,7,1]
  Branch 3 (Branch 2 (Branch 1 Empty Empty) Empty) (Branch 5 Empty (Branch 7 Empty Empty))
  *Prob57> isSym it
  True
  *Prob57> consTree [5,3,18,1,4,12,21]
  Branch 5 (Branch 3 (Branch 1 Empty Empty) (Branch 4 Empty Empty)) (Branch 18 (Branch 12 Empty Empty) (Branch 21 Empty Empty))
  *Prob57> isSym it
  True

From the solution,

> add2Tree :: (Ord a) => a -> Tree a -> Tree a
> add2Tree x Empty = Branch x Empty Empty
> add2Tree x t@(Branch y l r)
>   = case x `compare` y of
>       LT -> Branch y (add2Tree x l) r
>       GT -> Branch y l              (add2Tree x r)
>       EQ -> t
> 
> construct :: (Ord a) => [a] -> Tree a
> construct xs = foldl (flip add2Tree) Empty xs

  *Prob57> isSym . consTree $ [5, 3, 18, 1, 4, 12, 21]
  True
  *Prob57> isSym . consTree $ [3, 2, 5, 7, 1]
  True
  *Prob57> consTree [3, 2, 5, 7, 1] == construct [3, 2, 5, 7, 1]
  True

58. 対称平衡木

55.と56. を使って平衡木のリストをフィルターしたら良いだけですね。

Prob58.lhs


> module Prob58 where

Generate-and-test paradigm

Apply the generate-and-test paradigm to construct all symmetric, completely balanced binary trees with a given number of nodes.

> import Prob54(Tree(..))
> import Prob55(cbalTree)
> import Prob56(isSym)
>
> symCbalTrees :: Int -> [Tree Char]
> symCbalTrees n = filter isSym (cbalTree n)

  *Prob58> symCbalTrees 5
  [Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) (Branch 'x' (Branch 'x' Empty Empty) Empty),Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty (Branch 'x' Empty Empty))]

59. 高さ（深さ）平衡木を作れ。

この辺からさっぱり賢い作り方がわからなくなりました。

問題は与えられた高さh になる木をリストで返せ、と言うものです。

一個目は再帰の終端条件を書いておいて、高さが平衡を保つようにサブツリーの高さを与えておいて再帰するというアイディアですね。
天下り的に高さの制限を与えることでサブツリーの高さの差が1 以下になるように抑えています。

二つ目の方法は備え付きの（高階）関数を駆使していてこっちのほうが幾分かっこ良い方法。
ただやっていることとアイディア自体は最初のアルゴリズムと一緒でtail で差分を一個作ってサブツリーの高さの差を一個に抑えています。
要はサブツリーの高さを

[(h-2,h-1),(h-1,h-1),(h-1,h-2)]

で抑えるか、あるいはサブツリー自体を

[(shortts, ts), (ts, ts), (ts, shorts)]

と抑えるかの違いです。

Prob59.lhs


> module Prob59 where

Construct height-balanced binary trees

In a height-balanced binary tree, the following property holds for every node: 
The height of its left subtree and the height of its right subtree are almost equal, which means their difference is not greater than one.

Construct a list of all height-balanced binary trees with the given element and the given maximum height.

> import Prob54(Tree(..))
>
> something :: [Tree Char]
> something =
>   [
>     Branch 'x' (Branch 'x' Empty Empty) 
>                (Branch 'x' Empty (Branch 'x' Empty Empty)),
>     Branch 'x' (Branch 'x' Empty Empty) 
>                (Branch 'x' (Branch 'x' Empty Empty) Empty),
>     Branch 'x' (Branch 'x' Empty Empty) 
>                (Branch 'x' (Branch 'x' Empty Empty) 
>                            (Branch 'x' Empty Empty)),
>     Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) 
>                (Branch 'x' Empty Empty)
>   ]

> hbalTree :: a -> Int -> [Tree a]
> hbalTree x 0 = [Empty]
> hbalTree x 1 = [Branch x Empty Empty]
> hbalTree x h =
>   [ Branch x l r
>   | (hl, hr) <- [(h-2,h-1),(h-1,h-1),(h-1,h-2)] -- this guarantees height-balanced
>   , l <- hbalTree x hl, r <- hbalTree x hr ]

  *Prob59> take 4 $ hbalTree 'x' 3
  [Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' Empty (Branch 'x' Empty Empty))
  ,Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty Empty))
  ,Branch 'x' (Branch 'x' Empty Empty) 
              (Branch 'x' (Branch 'x' Empty Empty) Empty)
  ,Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) 
              (Branch 'x' Empty (Branch 'x' Empty Empty))
  ]

If we want to avoid recomputing lists of trees (at the cost of extra space), we can use a similar structure to the common method for computation of all the Fibonacci numbers:


> hbalTree' x h = trees !! h
>   where
>     trees = [Empty] : [Branch x Empty Empty] :
>             zipWith combine (tail trees) trees -- this tail is safe.
>     combine ts shortts = 
>       [ Branch x l r
>       | (ls, rs) <- [(shortts, ts), (ts, ts), (ts, shortts)]
>       , l <- ls, r <- rs ]

60. ノードの数が与えられたとして、高さ平衡木を作れ。

手間取った奴です、フィボナッチに似た数列が肝です。

高さh の高さ平衡木のうちノードの数が最小なものは、例えば

てっぺんのノード一個
高さ(h-1) の左の（最小）サブツリー
（高さ平衡を保つため、と最小を満たすためには）高さ(h-2) の右の（最小）サブツリー

で作ることが出来ます、これが初見では不可解に思えたフィボナッチに似た数列(minNodes)の成り立ちです、解答ではエレガントに遅延リストで書いてるだけで素朴に書いたらなんのことは無い。

（追記）
ここでは安直に局所的に左右のサブツリーを最小にしておけば全体も最小のツリーになってると信じております。
大域的にそれを超えるような最適解があるかも分かりませんが、考えていません。
二分木だと構造が単純すぎてそういうエキゾチックなことがおこらないような気はしますが、証明などは試みてません。
（追記終わり）

与えられた高さに対する最小ノードが分かれば逆に、与えられたノードの数に対する最大高さが分かります。
すなわち、与えられたノードの数が最小ノード列の”階段”の何段目と何段目の間にいるかで評価できるというわけです。

あとは多少不格好かも分かりませんが（Haskell らしいとも言えるけど）ツリー達からノードの数が与えられたn を満たすかどうかでフィルターしてあげたら良い、となります。
ここでツリー達といったのは、ツリー全体のうち、与えられたノードn で与えられる最小高さから最大高さまでの奴をconcatMap で平らにならしたリストになります。

Prob60.lhs


> module Prob60 where
>
> import Prob54 (Tree(..))
> import Prob59 (hbalTree)
> import Data.Maybe (fromJust) -- :: Maybe a -> a
> import Data.List (findIndex) -- :: (a -> Bool) -> [a] -> Maybe Int

Construct height-balanced binary trees with a given number of nodes.

example in Haskell:
  *Main> length $ hbalTreeNodes 'x' 15
  1553
  *Main> map (hbalTreeNodes 'x') [0..3]
  [ [Empty]                              -- n=0
  , [Branch 'x' Empty Empty]             -- n=1
  , [Branch 'x' Empty                    -- n=2
                (Branch 'x' Empty Empty)
    ,Branch 'x' (Branch 'x' Empty Empty) 
                Empty
    ]
  , [Branch 'x' (Branch 'x' Empty Empty) -- n=3
                (Branch 'x' Empty Empty)
    ]
  ]
  *Main> map length it 
  [1,1,2,1]

Consider a height-balanced binary tree of a given height h.
What is the maximum number of nodes it can contain?
Clearly, 
  maxNodes h = 1+2+4+..+2^(h-1)
             = 2^h -1

However, what is the minimum number (minNodes h)? 
This question is more difficult. 
Try to find a recursive statement and turn it into a function minNodes that returns the minimum number of nodes in a height-balanced binary tree of height h. 
Since the left sub-tree of height h is given by that of (h-1), and the right sub-tree is that of (h-2) to maintain height-balanced, the recursive definition is something like the follwoings:

> minNodesF :: Int -- given hight 
>           -> Int
> minNodesF 0 = 0
> minNodesF 1 = 1
> minNodesF h = 1 + (minNodesF (h-1)) + (minNodesF (h-2))

Or more elegantly (from the solution),

> minNodes :: Int -- given height
>          -> Int
> minNodesSeq = 0:1:zipWith ((+).(1+)) minNodesSeq (tail minNodesSeq) 
> minNodes = (minNodesSeq !!)

They give us the same numbers:

  *Prob60> take 10 minNodesSeq 
  [0,1,2,4,7,12,20,33,54,88]
  *Prob60> take 10 $ map minNodesF [0..]
  [0,1,2,4,7,12,20,33,54,88]

On the other hand, we might ask: what is the maximum height h a height-balanced binary tree with given n nodes can have? 
Write a function maxHeight that computes this.

> maxHeight :: Int -- given nodes 
>           -> Int
> maxHeight n = (fromJust $ findIndex (> n) minNodesSeq) - 1

The minimum height is given by

> minHeight :: Int -- given nodes
>           -> Int
> minHeight n = ceiling $ logBase 2 $ fromIntegral (n+1)

Now, we can attack the main problem: construct all the height-balanced binary trees with a given number of nodes. 
Find out how many height-balanced trees exist for n = 15.

> hbalTreeNodes :: a -> Int -> [Tree a]
> hbalTreeNodes _ 0 = [Empty]
> hbalTreeNodes x n = concatMap toFilteredTrees [(minHeight n) .. (maxHeight n)]
>   where 
>     toFilteredTrees h = filter ((n ==) . countNodes) $ hbalTree x h
>     -- concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
> 
> countNodes :: Tree a -> Int
> countNodes Empty = 0
> countNodes (Branch _ l r) = (countNodes l) + (countNodes r) + 1