第10章 型とクラスの定義 #6

10.8 練習問題

1. 再帰と関数addを用いて、自然数の乗算関数 mult :: Nat -> Nat -> Nat を定義せよ。

これは楽勝。（10.3で定義したNatはゼロも自然数だったことを思い出して）

module TenEightOne where

import TenThree

mult :: Nat -> Nat -> Nat
mult Zero     _    = Zero
mult _        Zero = Zero
mult (Succ m) n    = add n (mult m n)

2. 付録Aには掲載されていないが、標準ライブラリでは以下のクラスとメソッドが定義されている。
   

   data Ordering = LT | EQ | GT
   compare :: Ord a => a -> a -> Ordering
   

   このメソッドは、順序クラスのある値が他の値と比較して、小さい（LT）か、等しい（EQ）か、大きい（GT）かを判断する。このメソッドを用いて、探索木用の関数 occures :: Int -> Tree -> Bool を再定義せよ。また、新しい実装が本の実装よりも効率的である理由を述べよ。

こんなのでどうかな。cpで比較した結果をもとにパターンマッチするから、比較が1回しか実行されない。

module TenEightTwo where

import TenThree

occurs'' :: Int -> Tree -> Bool
occurs'' m (Leaf n) = m == n
occurs'' m t        = f (cp m t) m t
  where
    cp m (Node _ n _)   = compare m n
    f LT m (Node l _ _) = occurs'' m l
    f EQ _ _            = True
    f GT m (Node _ _ r) = occurs'' m r

3. 以下の二分木を考えよう。
   

   data Tree = Leaf Int | Node Tree Tree

   
   全ての節に対して、右と左の部分木にある葉の数が、高々一つだけ異なるとき、木は平衡していると表現する。葉は平衡していると考える。木が平衡しているか調べる関数 balanced :: Tree -> Bool を定義せよ。
   ヒント：最初に木の中の葉の数を返す関数を実装せよ。

ヒント通りに実装。

module TenEightThree where

data Tree = Leaf Int | Node Tree Tree

leaves            :: Tree -> Int
leaves (Leaf _)   =  1
leaves (Node l r) =  leaves l + leaves r

balanced            :: Tree -> Bool
balanced (Leaf _)   =  True
balanced (Node l r) =  abs (leaves l - leaves r) <= 1

4. 空でない整数のリストを平衡木に変換する関数 balance :: [Int] -> Tree を定義せよ。
   ヒント：最初にリストを、長さが高々一つだけ異なるリスト二つに分割する関数を実装せよ。

書けたんだけど、空リストを適用すると無限ループしてエラーになってしまう。

module TenEightFour where

import TenEightThree

devide    :: [a] -> ([a], [a])
devide xs =  splitAt (length xs `div` 2) xs

balance :: [Int] -> Tree
balance [n] = Leaf n
balance xs  = Node (balance l) (balance r)
  where (l, r) = devide xs

5. 恒真式か検査する関数を拡張して、命題に論理和（∨）と同値（⇔）が使えるようにせよ。

コンストラクタにOrとEquivを追加。ついでに命題としてド・モルガンの法則（の片方）を定義してみる。

@@ -1,4 +1,4 @@
-module TenFour where
+module TenEightFive where
 
 import NineSeven
 import TenOne
@@ -8,6 +8,8 @@
   | Not Prop
   | And Prop Prop
   | Imply Prop Prop
+  | Or Prop Prop
+  | Equiv Prop Prop
 
 p1 :: Prop
 p1 = And (Var 'A') (Not (Var 'A'))
@@ -17,6 +19,8 @@
 p3 = Imply (Var 'A') (And (Var 'A') (Var 'B'))
 p4 :: Prop
 p4 = Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')
+p5 :: Prop
+p5 = Equiv (Not (And (Var 'A') (Var 'B'))) (Or (Not (Var 'A')) (Not (Var 'B')))
 
 type Subst = Assoc Char Bool
 
@@ -26,6 +30,8 @@
 eval s (Not p)     =  not (eval s p)
 eval s (And p q)   =  eval s p && eval s q
 eval s (Imply p q) =  eval s p <= eval s q
+eval s (Or p q)    =  eval s p || eval s q
+eval s (Equiv p q) =  eval s p == eval s q
 
 vars             :: Prop -> [Char]
 vars (Const _)   =  []
@@ -33,6 +39,8 @@
 vars (Not p)     =  vars p
 vars (And p q)   =  vars p ++ vars q
 vars (Imply p q) =  vars p ++ vars q
+vars (Or p q)    =  vars p ++ vars q
+vars (Equiv p q) =  vars p ++ vars q
 
 bools   :: Int -> [[Bool]]
 bools 0 = [[]]