10.8 練習問題
これは楽勝。（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)
- 付録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
- 以下の二分木を考えよう。
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
- 空でない整数のリストを平衡木に変換する関数
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
- 恒真式か検査する関数を拡張して、命題に論理和（∨）と同値（⇔）が使えるようにせよ。
コンストラクタに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 = [[]]
