バランスの取れた n 対のカッコ列を生成する関数 kakko n を定義してください。カッコ列は ( と ) からなる列のことで、バランスが取れているカッコ列は、右カッコで閉じることができる、つまり右カッコに対応する左カッコがある状態のことをいいます。たとえば n = 1 の場合、( ) はバランスの取れたカッコ列ですが、) ( はバランスが取れていません。
kakko :: Int -> [String]
ghci> mapM_ print $ kakko 3 "()()()" "()(())" "(())()" "(()())" "((()))" ghci> mapM_ print $ kakko 4 "()()()()" "()()(())" "()(())()" "()(()())" |
"()((()))" "(())()()" "(())(())" "(()())()" "(()()())" "(()(()))" "((()))()" "((())())" "((()()))" "(((())))" |
バランスの取れた n 対のカッコ列の総数を求める関数 kakko_num n を定義してください。
kakko_num :: Int -> Integer
ghci> kakko_num 1 1 ghci> kakko_num 2 2 ghci> kakko_num 3 5 ghci> kakko_num 4 14 ghci> kakko_num 5 42 ghci> kakko_num 10 16796 ghci> kakko_num 20 6564120420 ghci> kakko_num 50 1978261657756160653623774456 ghci> kakko_num 100 896519947090131496687170070074100632420837521538745909320
カッコ列は二分木に対応させることができます。二分木 Tree をカッコ列に変換する関数 treeTokakko tree を定義してください。
data Tree = L | N Tree Tree deriving Show treeTokakko :: Tree -> String
ghci> treeTokakko (N L L) "()" ghci> treeTokakko (N (N L L) L) "(())" ghci> treeTokakko (N L (N L L)) "()()" ghci> treeTokakko (N (N L L) (N L L)) "(())()" ghci> treeTokakko (N (N (N L L) L) L) "((()))" ghci> treeTokakko (N L (N L (N L L))) "()()()"
treeTokakko の逆変換を行う関数 kakkoTotree を定義してください。
kakkoTotree :: String -> Tree
ghci> kakkoTotree "()" N L L ghci> kakkoTotree "()()" N L (N L L) ghci> kakkoTotree "(())" N (N L L) L ghci> kakkoTotree "((()))" N (N (N L L) L) L ghci> kakkoTotree "()()()" N L (N L (N L L)) ghci> kakkoTotree "(())()" N (N L L) (N L L)
葉を n 個持つ二分木 Tree を列挙する関数 trees n を定義してください。
trees :: Int -> [Tree]
ghci> trees 1 [L] ghci> trees 2 [N L L] ghci> trees 3 [N L (N L L),N (N L L) L] ghci> mapM_ print $ trees 4 N L (N L (N L L)) N L (N (N L L) L) N (N L L) (N L L) N (N L (N L L)) L N (N (N L L) L) L
葉にデータを格納する二分木 Tree1 を次のように定義します。
data Tree1 a = Lf a | Nd (Tree1 a) (Tree1 a) deriving Show
二分木 Tree とデータを格納したリスト xs から二分木 Tree1 を生成する関数 makeTree1 を定義してください。
makeTree1 :: Tree -> [a] -> (Tree1 a, [a])
ghci> makeTree1 L [1] (Lf 1,[]) ghci> makeTree1 (N L L) [1,2] (Nd (Lf 1) (Lf 2),[]) ghci> makeTree1 (N (N L L) L) [1,2,3] (Nd (Nd (Lf 1) (Lf 2)) (Lf 3),[]) ghci> makeTree1 (N (N L L) (N L L)) [1,2,3,4] (Nd (Nd (Lf 1) (Lf 2)) (Nd (Lf 3) (Lf 4)),[])
リスト xs を前後で二分割することを考えます。二分割したリストをすべて求める関数 splits xs を定義してください。
splits :: [a] -> [([a], [a])]
ghci> splits [1] [([],[1]),([1],[])] ghci> splits [1,2] [([],[1,2]),([1],[2]),([1,2],[])] ghci> splits [1,2,3] [([],[1,2,3]),([1],[2,3]),([1,2],[3]),([1,2,3],[])] ghci> splits [1,2,3,4] [([],[1,2,3,4]),([1],[2,3,4]),([1,2],[3,4]),([1,2,3],[4]),([1,2,3,4],[])]
二分木 Tree1 に格納する要素をリスト xs で指定したとき、二分木 Trees1 を列挙する関数 trees1 xs を作ってください。
trees1 :: [a] -> [Tree1 a]
ghci> trees1 [1,2] [Nd (Lf 1) (Lf 2)] ghci> trees1 [1,2,3] [Nd (Lf 1) (Nd (Lf 2) (Lf 3)),Nd (Nd (Lf 1) (Lf 2)) (Lf 3)] ghci> mapM_ print $ trees1 [1,2,3,4] Nd (Lf 1) (Nd (Lf 2) (Nd (Lf 3) (Lf 4))) Nd (Lf 1) (Nd (Nd (Lf 2) (Lf 3)) (Lf 4)) Nd (Nd (Lf 1) (Lf 2)) (Nd (Lf 3) (Lf 4)) Nd (Nd (Lf 1) (Nd (Lf 2) (Lf 3))) (Lf 4) Nd (Nd (Nd (Lf 1) (Lf 2)) (Lf 3)) (Lf 4)
複雑なデータ構造をファイルなどに保存する場合、データ構造を線形なデータに変換できると便利です。このような操作を「シリアライズ (serialize) 」とか「シリアル化」といいます。逆に、元のデータ構造に戻す操作を「デシリアライズ」といいます。二分木 Tree1 をシリアライズする関数 serialize tree を作ってください。
今回は二分木の要素を整数 (Integer) とします。二分木は次の方法で簡単にシリアライズすることができます。
なお、シリアライズしたデータはリストに格納して返すことにします。
serialize :: Tree1 Integer -> [Integer]
ghci> serialize (Lf 1) [1,1] ghci> serialize (Nd (Lf 1) (Lf 2)) [0,1,1,1,2] ghci> serialize (Nd (Nd (Lf 1) (Lf 2)) (Lf 3)) [0,0,1,1,1,2,1,3] ghci> serialize (Nd (Nd (Lf 1) (Lf 2)) (Nd (Lf 3) (Lf 4))) [0,0,1,1,1,2,0,1,3,1,4]
関数 seriallize でシリアライズしたデータを復元する関数 deserialize ls を定義してください。
deserialize :: [Integer] -> (Tree1 Integer, [Integer])
ghci> deserialize [1,1] (Lf 1,[]) ghci> deserialize [0,1,1,1,2] (Nd (Lf 1) (Lf 2),[]) ghci> deserialize [0,0,1,1,1,2,1,3] (Nd (Nd (Lf 1) (Lf 2)) (Lf 3),[]) ghci> deserialize [0,0,1,1,1,2,0,1,3,1,4] (Nd (Nd (Lf 1) (Lf 2)) (Nd (Lf 3) (Lf 4)),[])
次に示す二分木 Tree2 を深さ優先で巡回する関数 preOreder, inOrder, postOrder を定義してください。preOrder は行きがけ順、inOrder は通りがけ順、postOrder は帰りがけ順で二分木を巡回します。
data Tree2 a = Nil | Node a (Tree2 a) (Tree2 a) deriving Show inOrder :: Tree2 a -> [a] preOrder :: Tree2 a -> [a] postOrder :: Tree2 a -> [a]
ghci> let a = Node 4 (Node 2 (Node 1 Nil Nil) (Node 3 Nil Nil)) (Node 6 (Node 5 Nil Nil) (Node 7 Nil Nil)) ghci> a Node 4 (Node 2 (Node 1 Nil Nil) (Node 3 Nil Nil)) (Node 6 (Node 5 Nil Nil) (Node 7 Nil Nil)) ghci> inOrder a [1,2,3,4,5,6,7] ghci> preOrder a [4,2,1,3,6,5,7] ghci> postOrder a [1,3,2,5,7,6,4]
二分木 Tree2 を幅優先で巡回する関数 bfs を定義してください。
bfs :: Tree2 a -> [a]
ghci> a Node 4 (Node 2 (Node 1 Nil Nil) (Node 3 Nil Nil)) (Node 6 (Node 5 Nil Nil) (Node 7 Nil Nil)) ghci> bfs a [4,2,6,1,3,5,7]
逆ポーランド記法で書かれた数式を計算するプログラムを作ってください。数式はリストで表すことにします。リストの要素 Item は次のように定義します。
data Item = Add | Sub | Mul | Div | Rpa | Lpa | Num Double deriving (Eq, Show)
演算子は Add (+), Sub (-), Mul (*), Div (/) で、数値は実数 (Double) だけとします。Rpa, Lpa はカッコを表しますが、このプログラムでは使いません。
逆ポーランド記法について簡単に説明します。私達が普通に式を書く場合、1 + 2 のように演算子を真ん中に置きます。この書き方を「中置記法」といいます。このほかに、「前置記法」と「後置記法」という書き方があります。前置記法は演算子を前に置く書き方で、ポーランド記法 (Polish Notation) と呼ばれることもあります。たとえば、1 + 2 であれば + 1 2 と書きます。数式にカッコをつけてみると (+ 1 2) となり、Lisp / Scheme のプログラムになります。
後置記法は演算子を後ろに置く書き方で、逆ポーランド記法 (RPN : Reverse Polish Notation) と呼ばれることもあります。1 + 2 であれば 1 2 + のように書きます。逆ポーランド記法の利点は、計算する順番に演算子が現れるため、カッコが不要になることです。たとえば、1 と 2 の和と 3 と 4 の和との積という数式を表してみましょう。
中置記法： (1 + 2) * (3 + 4) 後置記法： 1 2 + 3 4 + *
逆ポーランド記法は、日本語の読み方とまったく同じです。1 2 + で 1 と 2 の和を求め、3 4 + で 3 と 4 を求め、最後に 2 つの結果を掛け算して答えが求まります。
rpn :: [Item] -> Double
ghci> rpn [Num 1, Num 2, Add] 3.0 ghci> rpn [Num 1, Num 2, Add, Num 3, Num 4, Add, Mul] 21.0 ghci> rpn [Num 1, Num 2, Add, Num 3, Num 4, Sub, Mul] -3.0 ghci> rpn [Num 1, Num 2, Add, Num 3, Num 4, Add, Num 5, Num 6, Add, Mul, Mul] 231.0
中置記法で書かれた数式を計算するプログラムを作ってください。数式はリストで表すことにします。リストの要素 Item は次のように定義します。
data Item = Add | Sub | Mul | Div | Rpa | Lpa | Num Double deriving (Eq, Show)
演算子は Add (+), Sub (-), Mul (*), Div (/) で、数値は実数 (Double) だけとします。数式はカッコを使うことできます。右カッコを Rpa で、左カッコを Lpa で表します。
expression :: [Item] -> Integer
ghci> expression [Num 1, Add, Num 2, Add, Num 3, Add, Num 4] 10.0 ghci> expression [Num 1, Add, Num 2, Mul, Num 3, Add, Num 4] 11.0 ghci> expression [Lpa, Num 1, Add, Num 2, Rpa, Mul, Lpa, Num 3, Add, Num 4, Rpa] 21.0
数式 (四則演算とカッコ) を表す文字列をリストに変換する関数 read_expr s を定義してください。リストの要素 Item は次のように定義します。
data Item = Add | Sub | Mul | Div | Rpa | Lpa | Num Double deriving (Eq, Show)
演算子は + (Add), - (Sub), * (Mul), / (Div) で、数値は実数 (Double) だけとします。数式はカッコを使うことできます。右カッコを Rpa で、左カッコを Lpa で表します。
read_expr :: String -> [Item]
ghci> read_expr "1 2 3 + +" [Num 1.0,Num 2.0,Num 3.0,Add,Add] ghci> read_expr "1 2 + 3 4 - *" [Num 1.0,Num 2.0,Add,Num 3.0,Num 4.0,Sub,Mul] ghci> rpn $ read_expr "1 2 3 + +" 6.0 ghci> rpn $ read_expr "1 2 + 3 4 - *" -3.0 ghci> read_expr "1 + 2 * 3 - 4" [Num 1.0,Add,Num 2.0,Mul,Num 3.0,Sub,Num 4.0] ghci> read_expr "(1 + 2) / (3 - 4)" [Lpa,Num 1.0,Add,Num 2.0,Rpa,Div,Lpa,Num 3.0,Sub,Num 4.0,Rpa] ghci> expression $ read_expr "1 + 2 * 3 - 4" 3.0 ghci> expression $ read_expr "(1 + 2) / (3 - 4)" -3.0
リスト : カッコ列の生成
kakko :: Int -> [String]
kakko m = iter 0 0 [] []
where
iter x y a b
| x == m && y == m = (reverse a):b
| otherwise =
let b' = if x < m then iter (x + 1) y ('(':a) b else b
in if y < x then iter x (y + 1) (')':a) b' else b'
カッコ列の生成は簡単です。局所関数 iter の引数 x が左カッコの個数、引数 y が右カッコの個数を表します。引数 a, b は累積変数で、a は文字列 "(", ")" を格納したリスト、b は生成したカッコ列を格納したリストです。
バランスの取れたカッコ列の場合、x, y, m には y <= x <= m の関係が成り立ちます。x == m かつ y == m の場合、カッコ列がひとつ完成しました。リスト a を反転してリスト b に追加します。そうでなければ、iter を再帰呼び出しします。x < m であれば左カッコを追加し、y < x であれば右カッコを追加します。これでカッコ列を生成することができます。
カタラン数 - Wikipedia によると、カッコ列の総数は「カタラン数 (Catalan number) 」になるとのことです。カタラン数は次に示す公式で求めることができます。
これをそのままプログラムしてもいいのですが、それではちょっと面白くないので別な方法でプログラムを作ってみましょう。カタラン数は次に示す経路図において、A から B までの最短距離の道順を求めるとき、対角線を超えないものの総数に一致します。
Ｂ Ｂ
┌─┬─┬─┬─┐ ┌─┬─┬─０─14
│ │ │ │ │ │ │ │ │ │
├─┼─┼─┼─┤ ├─┼─０─５─14
│ │ │ │ │ │ │ │ │ │
├─┼─┼─┼─┤ ├─０─２─５─９
│ │ │ │ │ │ │ │ │ │
├─┼─┼─┼─┤ ０─１─２─３─４
│ │ │ │ │ │ │ │ │ │
└─┴─┴─┴─┘ １─１─１─１─１
Ａ Ａ
図 : 道順の総数の求め方
A からある地点にいたる最短距離の道順の総数は、左隣と真下の地点の値を足したものになります。一番下の地点は 1 で、対角線を越えた地点は 0 になります。あとは下から順番に足し算していけば、A から B までの道順の総数を求めることができます。上図の場合はカラタン数 Ｃ4 に相当し、その値は 14 となります。
これをそのままプログラムすると、次のようになります。
リスト : カッコ列の総数
kakko_num :: Int -> Integer
kakko_num m = iter (replicate (m + 1) 1)
where
iter [x] = x
iter (_:xs) = iter (tail ys)
where ys = [0] ++ zipWith (+) ys xs
実際の処理は局所関数 iter で行います。最初に replicate で一番下の地点の道順の総数 (1) を格納したリスト生成します。これが iter に渡す初期値になります。引数 m のカラタン数を求める場合、リストの大きさは m + 1 になります。あとは、リストの要素がひとつになるまで iter を再帰呼び出しします。
一段上の値を表すリスト ys は、一段下のリストの先頭要素を取り除いた xs と ys の要素を足し算することで求めることができます。ys は 0 から始まるので、Haskell では ys = [0] ++ zipWith (+) ys xs と書くことができます。iter を再帰呼び出しするときは、先頭の 0 を tail で取り除きます。これでカッコ列の総数 (カタラン数) を求めることができます。
バランスの取れたカッコ列と二分木は 1 対 1 に対応します。二分木を行きがけ順で巡回するとき、途中の節では左カッコ ( を出力して左右の枝をたどり、葉に到達したら右カッコ ) を出力すると、カッコ列を生成することができます。
リスト : 二分木をカッコ列に変換
data Tree = L | N Tree Tree deriving Show
butlast :: [a] -> [a]
butlast [] = error "butlast : empty list"
butlast [_] = []
butlast (x:xs) = x : butlast xs
treeTokakko :: Tree -> String
treeTokakko tree = butlast (iter tree) where
iter L = ")"
iter (N l r) = "(" ++ iter l ++ iter r
実際の処理は局所関数 iter で行います。引数が L の場合は右カッコを返します。引数が N l r の場合は、iter を再帰呼び出しして左部分木 l をたどり、それから右部分木 r をたどります。その結果と左カッコを演算子 ++ で連結すればいいわけです。ただし、最後に余分な右カッコが付いてくるので、関数 butlast で最後の要素を削除します。二分木の場合、葉 (L) の個数を n とすると、節 (N) の個数は n - 1 になります。カッコ列と違って L の個数が一つ多くなることに注意してください。
リスト : カッコ列を二分木に変換
kakkoTotree :: String -> Tree
kakkoTotree s = fst $ iter s where
iter "" = (L, "")
iter (')':s) = (L, s)
iter ('(':s) = (N l r, u)
where (l, t) = iter s
(r, u) = iter t
実際の処理は局所関数 iter で行います。リストの先頭要素が右カッコの場合は (L, s) を返します。左カッコの場合は、iter を再帰呼び出しして左部分木 l を生成し、それから右部分木 r を生成します。あとは (N l r, u) を返すだけです。ただし、葉に対応する右カッコがひとつ少ないので、引数 ls が空リストの場合は葉 L を返すようにします。
リスト : 二分木の列挙
trees :: Int -> [Tree]
trees n = map kakkoTotree $ kakko (n - 1)
-- 別解
trees' :: Int -> [Tree]
trees' 1 = [L]
trees' n = concatMap (\(xs, ys) -> joins (trees' xs) (trees' ys)) (splits n)
where splits n = [(x, n - x) | x <- [1 .. (n - 1)]]
joins ls rs = [N l r | l <- ls, r <- rs]
trees は map を使って kakko の返り値に kakkoTotree を適用するだけです。
別解は n 個の要素を左右の部分木に振り分ける局所関数 splits を使って二分木を生成します。たとえば n が 4 の場合、二分割する方法は (1, 3), (2, 2) (3, 1) の 3 通りがあります。あとは、同じことを左右の部分木に行って、それを統合していけばいいわけです。
trees の最初の節で、要素が一つの場合は [L] を返します。そうでなければ、splits で n を分割します。ラムダ式の中で分割したリスト xs, ys に trees を適用して左右の部分木を生成し、それを局所関数 joins で統合します。
たとえば、4 を 1 と 3 に分割する場合、[L] と [N (N L L) L, N L (N L L)] を統合して、2 つの二分木を生成することになります。この処理はリスト内包表記を使うと簡単ですね。あとは concatMap でラムダ式を適用して結果のリストを平坦化するだけです。
なお、別解は山下伸夫さんの「Haskell プログラミング 木(tree)で遊ぶ」を参考にさせていただきました。山下伸夫さんに感謝いたします。
リスト : 二分木 (Tree1) の生成
data Tree1 a = Lf a | Nd (Tree1 a) (Tree1 a) deriving Show
makeTree1 :: Tree -> [a] -> (Tree1 a, [a])
makeTree1 tree xs = iter tree xs
where iter _ [] = error "error makeTree1"
iter L (x:xs) = (Lf x, xs)
iter (N l r) xs = (Nd l' r', zs)
where (l', ys) = iter l xs
(r', zs) = iter r ys
実際の処理は局所関数 iter で行います。最初の節で、Tree1 に格納する要素がなくなったならばエラーを送出します。Tree が葉 (L) の場合はリストの先頭要素 x を Lf に格納して、残りのリスト xs と一緒にタプルに格納して返します。節 N の場合は iter を再帰呼び出しして、左部分木 l' と右部分木 r' を生成して、Nd l' r' と残りのリスト zs をタプルに格納して返します。
リスト : リストの二分割 splits :: [a] -> [([a],[a])] splits xs = zip (inits xs) (tails xs) -- 別解 splits' :: [a] -> [([a],[a])] splits' [] = [] splits' [x] = [([],[x]), ([x],[])] splits' xs@(y:ys) = ([],xs) : [(y:z, zs) | (z, zs) <- splits' ys]
splits は簡単です。モジュール Data.List の関数 inits と tails の返り値を zip でまとめるだけです。
別解は inits と tails を使わないでプログラムしたものです。最初の節で、引数が空リストの場合はリストを分割できないので空リストを返します。次の節で、要素が x しかない場合は空リストと [x] に分割します。最後の節で、空リストと xs に分割する場合は ([ ], xs) をリストに格納するだけです。それ以外の場合は、xs を y : ys に分割し、ys に対して splits' を再帰呼び出しします。そして、その返り値のタプルの第 1 要素 z (前半のリスト) に y を追加します。
リスト : 二分木 (Tree1) の列挙 trees1 :: [a] -> [Tree1 a] trees1 xs = map (\ts -> fst (makeTree1 ts xs)) $ trees $ length xs -- 別解 splits1 :: [a] -> [([a],[a])] splits1 [] = [] splits1 [_] = [] splits1 (x:xs) = ([x],xs) : [(x:ys, zs) | (ys, zs) <- splits1 xs] trees1' :: [a] -> [Tree1 a] trees1' [x] = [Lf x] trees1' ls = concatMap (\(xs, ys) -> joins (trees1' xs) (trees1' ys)) (splits1 ls) where joins ls rs = [Nd l r | l <- ls, r <- rs]
trees1 は trees と makeTree1 を使うと簡単です。trees で Tree を生成して、それを map に渡します。ラムダ式の中で引数 ts に makeTree1 を適用して Tree を Tree1 に変換します。
別解はリストを二分割する関数 splits1 を使ったものです。splits1 はリストを長さが 1 以上のリストに二分割します。たとえば、リストが [1,2,3,4] の場合、([1], [2,3,4]), ([1,2], [3,4]), [1,2,3],[4]) の 3 通りがあります。あとは、同じことを左右の部分木に行って、それを統合していけばいいわけです。
なお、trees1' は山下伸夫さんの「Haskell プログラミング 木(tree)で遊ぶ」を参考にさせていただきました。山下伸夫さんに感謝いたします。
リスト : 二分木のシリアライズ serialize :: Tree1 Integer -> [Integer] serialize (Lf x) = [1, x] serialize (Nd l r) = [0] ++ serialize l ++ serialize r
二分木のシリアライズは簡単です。引数が Nd (節) の場合、serialize を再帰呼び出しして左部分木 l をたどり、それから右部分木 r をたどります。その結果と [0] を演算子 ++ で連結すればいいわけです。Lf (葉) の場合は 1 と要素を格納したリストを返します。
リスト : 二分木のデシリアライズ
deserialize :: [Integer] -> (Tree1 Integer, [Integer])
deserialize (1:x:xs) = (Lf x, xs)
deserialize (0:xs) = (Nd x y, xs2)
where (x, xs1) = deserialize xs
(y, xs2) = deserialize xs1
deseriailize _ = error "deserialize error"
デシリアライズも簡単です。関数 deserialize は生成した二分木と残りのデータをタプルで返します。リストの先頭要素が 0 の場合、deserialize を再帰呼び出しして左部分木 x を生成し、それから右部分木 y を生成します。あとは (Nd x y, xs2) を返すだけです。リストの先頭要素が 1 の場合は葉なので、次の要素 x を取り出して (Lf x, xs) を返します。
リスト : 二分木の巡回 preOrder :: Tree2 a -> [a] preOrder Nil = [] preOrder (Node x l r) = [x] ++ preOrder l ++ preOrder r inOrder :: Tree2 a -> [a] inOrder Nil = [] inOrder (Node x l r) = inOrder l ++ [x] ++ inOrder r postOrder :: Tree2 a -> [a] postOrder Nil = [] postOrder (Node x l r) = postOrder l ++ postOrder r ++ [x] -- 別解 preOrder' :: Tree2 a -> [a] preOrder' tree = iter tree [] where iter Nil xs = xs iter (Node x l r) xs = x : (iter l (iter r xs)) inOrder' :: Tree2 a -> [a] inOrder' tree = iter tree [] where iter Nil xs = xs iter (Node x l r) xs = iter l (x : (iter r xs)) postOrder' :: Tree2 a -> [a] postOrder' tree = iter tree [] where iter Nil xs = xs iter (Node x l r) xs = iter l (iter r (x:xs))
二分木の巡回は定義をそのままプログラムしただけです。巡回の定義は拙作のページ「二分探索木」をお読みください。別解は演算子 ++ を使わないバージョンです。左部分木から巡回すると要素が逆順に並ぶので、右部分木から巡回していくことに注意してください。
リスト : 二分木の巡回 (幅優先探索) bfs :: Tree2 a -> [a] bfs tree = iter [tree] where iter [] = [] iter (Nil:xs) = iter xs iter (Node x l r:xs) = x : iter (xs ++ [l, r]) -- 別解 walk :: Int -> [Tree2 a] -> [Tree2 a] walk 0 _ = [] walk n (Nil:q) = walk (n - 1) q walk n (Node x l r:q) = l : r : walk (n + 1) q walk _ _ = error "walk" bfs' :: Tree2 a -> [a] bfs' tree = iter que where que = tree : walk 1 que iter [] = [] iter (Nil:qs) = iter qs iter (Node x _ _:qs) = x : iter qs
bfs の実際の処理は局所関数 iter で行います。iter の引数 (リスト) をキューとして使い、二分木の節を追加していくところがポイントです。最初は tree をキューに格納します。最初の節で、引数が空リストになったならば空リストを返します。これが再帰呼び出しの停止条件になります。次の節で、キューの先頭要素が Nil ならば、iter xs を再帰呼び出しします。Node の場合は、キューに左右の節 l, r を追加して iter を再帰呼び出しし、その返り値に要素 x を追加します。
別解 bfs' は演算子 ++ を使わないでプログラムしたものです。que はキューを表していて、関数 walk を使って二分木を幅優先で巡回します。que の先頭要素は tree で、walk はキューから節 (または葉) を取り出して、左右の部分木をキューに追加します。したがって、最初は tree が取り出されて、その左右の部分木がキューに追加されることになります。
walk の最初の節で、第 1 引数が 0 の場合は空リストを返します。これが再帰呼び出しの停止条件になります。二分木の場合、葉 (Nil) の個数を n とすると、節 (Node) の個数は n - 1 になります。最初に walk を呼び出すとき第 1 引数に 1 を与え、Node のときに第 1 引数を +1、Nil のときに -1 します。すると、二分木の巡回が終わったとき第 1 引数の値は 0 になります。
2 番目の節で、第 2 引数 (キュー) の先頭が Nil ならば、Nil をキューから取り除いて walk を再帰呼び出しします。3 番目の節で、キューの先頭要素が Node であれば、それをキューから取り除いて walk を再帰呼び出しします。そして、その返り値に左右の部分木 l, r を追加します。これで幅優先で二分木を巡回することができます。
なお、関数 walk は山本和彦さんの「なぜ Haskell ではキューが軽んじられているか？」を参考にさせていただきました。山本和彦さんに感謝いたします。
逆ポーランド記法の数式はスタックを使うと簡単に計算することができます。アルゴリズムは次のようになります。
1. 数値はスタックに追加する。 2. 演算子であればスタックから 2 つ数値を取り出し、演算結果をスタックに追加する。 3. 最後にスタックに残った値が答えになる。
たったこれだけの規則で数式を計算することができます。それでは、実際に 1 2 + 3 4 + * を試してみましょう。次の表を見てください。
|
|
スタックはリスト ( ) で表します。最初の 1 と 2 は数値なのでスタックにプッシュします。次は演算子 + なので、スタックからデータを取り出して 1 + 2 を計算します。そして、計算結果 3 をスタックにプッシュします。次に、3 と 4 は数値なのでスタックにプッシュします。その次は演算子 + なので同じように処理して、計算結果 7 をスタックにプッシュします。
スタックの中身は ( 7 3 ) となり、最初の計算結果 3 と次に計算した結果 7 がスタックに格納されています。この状態で最後の * を処理します。7 と 3 を取り出すとスタックは空の状態になります。そして、3 * 7 を計算して 21 をスタックにプッシュします。これで計算は終了です。スタックに残っている値 21 が計算結果となります。
このように、スタックを使うことで逆ポーランド記法で書かれた数式を簡単に計算することができます。実は数式だけではなく、スタックを用いてプログラムを実行することもできます。プログラミング言語 Forth は「数値」と「ワード」という 2 種類のデータしかありません。ワードには +, -, *, / などの演算子のほかに、いろいろな処理が定義されています。もちろん、ユーザが新しいワードを定義することもできます。
Forth の動作は、数値であればスタックにプッシュして、ワードであればそれを実行する、というシンプルなものです。これでプログラミングができるのですから、とてもユニークな言語ですね。
プログラムは次のようになります。
リスト : 数式の計算 (後置記法)
rpn :: [Item] -> Double
rpn xs = iter xs []
where
iter [] [x] = x
iter [] _ = error "rpn error"
iter (Num x : xs) zs = iter xs (x:zs)
iter (Add : xs) (x:y:zs) = iter xs (y + x : zs)
iter (Sub : xs) (x:y:zs) = iter xs (y - x : zs)
iter (Mul : xs) (x:y:zs) = iter xs (y * x : zs)
iter (Div : xs) (x:y:zs) = iter xs (y / x : zs)
iter _ _ = error "rpn error"
実際の処理は局所関数 iter で行います。引数 xs が数式を表すリストで、第 2 引数がスタックを表すリストです。第 1 引数が空リストになったら、スタックトップの値を返します。このとき、スタックに複数の値が格納されている場合はエラーを送出します。
次に、先頭要素が数値の場合はそれをスタックに追加します。演算子の場合、対応する計算を行って結果をスタックに積みます。このとき、最低でも 2 つの値がスタックになければいけません。x : y : zs とマッチングしない場合はエラーを送出します。計算するときは、先頭の要素 x が第 2 引数、2 番目の要素 y が第 1 引数になることに注意してください。結果はリスト zs の先頭に追加します。
参考文献『Ｃ言語による最新アルゴリズム事典』の「式の評価」によると、四則演算の数式は次の構文規則で表すことができます。
式 := 項 (+ | -) 項 (+ | -) 項 ... 項 :- 因子 (* | /) 因子 (* | /) 因子 ... 因子 := 数 | (式)
これをそのままプログラムすると、次のようになります。
リスト : 数式の計算 (中置記法)
factor :: [Item] -> (Double, [Item])
factor (Num x : xs) = (x, xs)
factor (Lpa : xs) =
case expr xs of
(v, Rpa:ys) -> (v, ys)
(_, _) -> error "factor error"
term :: [Item] -> (Double, [Item])
term xs = term_sub (factor xs)
where
term_sub (v, Mul:xs) =
let (v', ys) = factor xs in term_sub (v * v', ys)
term_sub (v, Div:xs) =
let (v', ys) = factor xs in term_sub (v / v', ys)
term_sub (v, xs) = (v, xs)
expr :: [Item] -> (Double, [Item])
expr xs = expr_sub (term xs)
where
expr_sub (v, Add:xs) =
let (v', ys) = term xs in expr_sub (v + v', ys)
expr_sub (v, Sub:xs) =
let (v', ys) = term xs in expr_sub (v - v', ys)
expr_sub (v, xs) = (v, xs)
expression :: [Item] -> Double
expression xs =
case expr xs of
(v, []) -> v
(_, _ ) -> error "expr error"
関数 expr は「式」を評価します。実際の処理は局所関数 expr_sub で行います。最初に関数 term を呼び出して「項」を評価します。返り値はタプルで、値は評価結果と残りのリストです。演算子が Add (+) または Sub (-) の場合、term を呼び出して式 xs を評価し、返り値を v' と ys にセットします。そして、v と v' を加算 (または減算) して expr_sub を再帰呼び出しします。そうでなければ、評価結果 v と残りのリスト xs をタプルで返します。
関数 term も同様の処理を行います。この場合は最初に関数 factor を呼び出して「因子」を評価します。そして、演算子が Mul (*) または Div (/) の場合は factor を呼び出して評価を続行します。そうでなければ、評価結果 v と残りのリスト xs をタプルで返します。関数 factor は簡単で、引数の先頭要素が数値の場合はそれをそのまま返し、Lpa であれば xs を expr に渡して評価します。戻ってきたら、リスト ys の先頭要素が Rpa であることを確認します。それ以外の場合はエラーを送出します。
最後に、関数 expression から expr を呼び出します。タプルの第 2 要素が空リストでなければ式に誤りがあるのでエラーを送出します。そうでなければ計算結果 v を返します。
リスト : 数式 (文字列) をリストに変換する
read_expr :: String -> [Item]
read_expr "" = []
read_expr (' ':s) = read_expr s
read_expr ('+':s) = Add : read_expr s
read_expr ('-':s) = Sub : read_expr s
read_expr ('*':s) = Mul : read_expr s
read_expr ('/':s) = Div : read_expr s
read_expr ('(':s) = Lpa : read_expr s
read_expr (')':s) = Rpa : read_expr s
read_expr xs =
case reads xs of
[] -> error "read_expr error"
[(x, xs')] -> Num x : read_expr xs'
引数が空文字列 "" の場合は空リストを返します。先頭要素が空白であれば、それをスキップします。先頭要素が +, -, *, /, (, ) であれば、read_expr を再帰呼び出しして、対応するデータ構築子を返り値のリストに追加します。それ以外の場合は reads で実数 (Double) に変換します。返り値が空リストの場合は実数に変換できなかったのでエラーを送出します。そうでなければ、Num x を read_expr の返り値に追加します。