今回は簡単な例題として、Lisp のリストのようなデータ構造を Haskell で作成してみましょう。
Lisp のリストは複数の「コンスセル (cons cell)」を連結したものです。ひとつのコンスセルには、データを格納する CAR (カー) という場所と、次のセルを連結する CDR (クダー) という場所からなっています。次の図を見てください。
CAR CDR CAR CDR
┌─┬─┐ ┌─┬─┐
│・│・┼─→│・│・┼→終端 (NIL)
└┼┴─┘ └┼┴─┘
↓ ↓
１ ２
図 : リストの構造
上図では、コンスセルを箱で表しています。左側の CAR がデータを格納する場所で、CDR が次のコンスセルと連結しています。上図の例では、先頭のコンスセルの CAR には 1 が格納され、CDR は次のコンスセルと連結しています。2 番目のコンスセルには CAR に 2 というデータが格納されています。このあとに接続されるコンスセルはもうないので、CDR にはリストの終わりを示す特別なデータ (NIL) が格納されます。このようなリストを Lisp では (1 2) と表記します。Haskell で記述すると [1, 2] になります。
ここまでは Haskell のリストとよく似ていますが、Lisp のリストは CAR にリストを格納して、リストを入れ子にすることができます。次の図を見てください。
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
│・│・┼→│・│・┼→│・│／│ ／ : NIL
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ │ │
１ │ │
│ ↓
│ ┌─┬─┐ ┌─┬─┐ ┌─┬─┐
│ │・│・┼→│・│・┼→│・│／│
│ └┼┴─┘ └┼┴─┘ └┼┴─┘
│ ↓ ↓ ↓
│ ３ １２ １３
↓
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
│・│・┼→│・│・┼→│・│／│
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
２ １０ １１
図 : リストの階層構造
上図のリストを Lisp で記述すると (1 (2 10 11) (3 12 13)) になります。Haskell で記述すると [1, [2, 10, 11], [3, 12, 13]] になりますが、これは要素の型が Integer と [Integer] で異なるため、Haskell ではエラーになります。
Haskell の場合、このような構造は二分木として表すことができます。
リスト : 二分木の定義 data Tree a = Nil | Leaf a | Cons (Tree a) (Tree a) deriving Show
Nil は空の木を表します。Leaf は葉を表していて、要素を格納します。節は Cons で表します。第 1 要素がコンスセルの CAR に、第 2 要素が CDR に対応します。けっきょく、Lisp のリストは線形のリストではなく、Haskell では二分木として扱うことになります。それでは実際に試してみましょう。
ghci> data Tree a = Nil | Leaf a | Cons (Tree a) (Tree a) deriving Show ghci> a = Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil)) ghci> a Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil)) ghci> b = Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil)) ghci> b Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil)) ghci> Cons (Leaf 1) (Cons a (Cons b Nil)) Cons (Leaf 1) (Cons (Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil))) (Cons (Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil))) Nil))
表示がごちゃごちゃしていて、このままでは二分木の構造がよくわかりませんね。M.Hiroi は Lisp のカッコに慣れているせいか、(1 (2 10 11) (3 12 13)) と表示したほうがわかりやすいと思います。そこで、まずは最初に二分木を Lisp 風のカッコで表示するプログラムを作ってみましょう。
ここで Lisp でのリストの表記法について簡単に説明しておきましょう。コンスセルの CDR は NIL だけではなく他のデータを格納することもできます。Lisp ではリストの終端が NIL 以外のデータの場合、そのリストを次のように表します。
┌─┬─┐ ┌─┬─┐
│・│・┼─→ NIL │・│・┼─→２
└┼┴─┘ └┼┴─┘
↓ ↓
１ １
(1) ≡ (1 . NIL) (1 . 2)
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
│・│・┼─→│・│・┼─→│・│・┼─→ NIL
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
１ ２ ３
(1 2 3) ≡ (1 . (2 . (3 . NIL)))
図 : リストの終端 (その１)
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
│・│・┼─→│・│・┼─→│・│・┼─→d
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
ａ ｂ ｃ
(a b c . d) ≡ (a . (b . (c . d)))
図 : リストの終端 (その２)
左右のカッコの中間にドット ( . ) を置き、左側に CAR のデータを、右側に CDR のデータを書きます。つまり、リスト (1) は (1 . NIL) と表すことができます。このようなデータを Lisp では「ドット対 (dotted pair)」と呼びます。たとえば、CAR が 1 で CDR が 2 であれば (1 . 2) となります。普通のリストも次のようにドット対を使って表現できます。
(1) ≡ (1 . NIL) (1 2 3) ≡ (1 . (2 . (3 . NIL))) ((1 2) (3 4)) ≡ ((1 . (2 . NIL)) . ((3 . (4 . NIL)) . NIL)) ((1 2) 3 4) ≡ ((1 . (2 . NIL)) . (3 . (4 . NIL)))
それでは、リスト (a b c) の終端を d に変えてみましょう。ドット対を使った表記法では、(a . (b . (c . d))) となりますが、これは (a b c . d) と表すことができます。このように、NIL 以外のアトムで終端されたリストを Lisp では「ドットリスト (dotted list)」と呼びます。
ドットの後ろは CDR にセットするデータを指定するのですから、複数のデータを書いたり省略してはいけません。次の場合、Lisp ではエラーになります。
( . a) ; CAR がない (a . ) ; CDR がない (a . b c) ; CDR にデータが複数ある (a . . b) ; ドットが複数ある (a . b . c )
Lisp のリストのように二分木 Tree を表示するプログラムは簡単です。次のリストを見てください。
リスト : 二分木の表示
showTree :: Show a => Tree a -> String
showTree (Cons a d) =
show a ++ case d of
Nil -> ""
(Leaf x) -> " . " ++ show x
_ -> " " ++ showTree d
showTree xs = show xs
instance Show a => Show (Tree a) where
show Nil = "()"
show (Leaf x) = show x
show xs = "(" ++ showTree xs ++ ")"
Tree a を型クラス Show のインスタンスに設定します。関数 show の引数が Nil ならば "()" を返します。引数が Leaf x であれば show x を呼び出します。そうでなければ二分木なので、関数 showTree を呼び出して、その結果をカッコ ( ) で囲みます。
showTree は引数が Cons a d ならば show a で CAR を文字列に変換します。次に、CDR が Nil であれば空文字列 "" を連結します。Leaf x であればドットリストなので、ドット " . " と show x の返り値を連結します。それ以外の場合はコンスルがつながっているので、空白 " " と showTree d の返り値を連結します。
それでは実行してみましょう。
ghci> Nil () ghci> Cons (Leaf 1) Nil (1) ghci> Cons (Leaf 1) (Leaf 2) (1 . 2) ghci> Cons (Leaf 1) (Cons (Leaf 2) Nil) (1 2) ghci> Cons (Leaf 1) (Cons (Leaf 2) (Leaf 3)) (1 2 . 3) ghci> Cons (Cons (Leaf 1) Nil) (Cons (Leaf 2) (Leaf 3)) ((1) 2 . 3) ghci> Cons (Cons (Leaf 1) (Leaf 2)) (Cons (Leaf 2) (Leaf 3)) ((1 . 2) 2 . 3) ghci> a = Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil)) ghci> a (2 10 11) ghci> b = Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil)) ghci> b (3 12 13) ghci> Cons (Leaf 1) (Cons a (Cons b Nil)) (1 (2 10 11) (3 12 13))
次は文字列から二分木を生成する処理を作りましょう。
リスト : 文字列から二分木を生成
-- 空白文字のスキップ
skipSpace :: String -> String
skipSpace = dropWhile isSpace
-- 要素の読み込み
readsItem :: Read a => ReadS (Tree a)
readsItem s = do
(x, t) <- reads s
return (Leaf x, skipSpace t)
-- 二分木の読み込み
readsTree :: Read a => ReadS (Tree a)
readsTree ('(':xs) = iter (skipSpace xs)
where
iter (')':xs) = return (Nil, xs)
iter ('.':xs) = do
(y, ')':ys) <- readsItem xs
return (y, ys)
iter xs@('(':_) = do
(a, ys) <- readsTree xs
(d, zs) <- iter (skipSpace ys)
return (Cons a d, zs)
iter xs = do
(a, ys) <- readsItem xs
(d, zs) <- iter ys
return (Cons a d, zs)
readsTree (' ':xs) = readsTree xs
-- インスタンスの設定
instance Read a => Read (Tree a) where
readsPrec _ s = readsTree s
関数 skipSpace は空白文字を読み飛ばします。isSpace は空白文字を判定する関数で、モジュール Data.Char に定義されています。dropWhile は述語が真を返す要素をリストの先頭から取り除く関数です。
isSpace :: Char -> Bool dropWhile :: (a -> Bool) -> [a] -> [a]
簡単な使用例を示します。
ghci> dropWhile isSpace " foo bar baz" "foo bar baz" ghci> dropWhile isSpace "foo bar baz" "foo bar baz"
関数 readsItem と readsTree はリストモナドを使ってプログラムします。readsItem は二分木の要素を読み込む関数です。要素は関数 reads で文字列からデータに変換します。返り値はタプルを格納したリストで、タプルの要素は Leaf x と残りの文字列です。このとき、文字列に skipSpace を適用して、先頭の空白文字を取り除いておきます。
二分木の読み込みは関数 readsTree で行います。先頭文字が '(' の場合は局所関数 iter を呼び出して二分木を生成します。このとき、skipSpace で '(' の後ろの空白文字を削除しておきます。iter の最初の節で、先頭文字が ')' の場合は (Nil, xs) を返します。xs は残りの文字列です。次の節で、先頭文字がドットの場合はドットリストなので、CDR 部の要素を readsItem で読み込み、残りの文字列の先頭が ')' で終わっていることを確認します。
3 番目の節で、先頭文字が '(' であれば、CAR 部の要素は二分木なので readsTree を再帰呼び出しします。そして、iter を再帰呼び出しして CDR 部を読み込み、それらを Cons に格納して返します。それ以外の場合は readsItem で CAR 部を読み込み、iter を再帰呼び出しして CDR 部を読み込みます。そして、それらを Cons に格納して返します。一番最後の節は、与えられた文字列の空白文字を削除します。
あとは Tree a を Read のインスタンスに設定します。Read の場合、readsPrec を定義すると、関数 read と reads が機能します。二分木 Tree の場合、readsPrec の第 1 引数は無視してかまいません。
それでは実行してみましょう。
ghci> read "()" :: Tree Int () ghci> read "(1)" :: Tree Int (1) ghci> read "(1 . 2)" :: Tree Int (1 . 2) ghci> read "(1 2 3 4 5 6 7 8)" :: Tree Int (1 2 3 4 5 6 7 8) ghci> read "(1 2 3 4 5 6 7 8 . 9)" :: Tree Int (1 2 3 4 5 6 7 8 . 9) ghci> read "((1 2) (3 4) (5 6) (7 8 . 9))" :: Tree Int ((1 2) (3 4) (5 6) (7 8 . 9)) ghci> read "(((1 2) (3 4)) (5 6) (7 8 . 9))" :: Tree Int (((1 2) (3 4)) (5 6) (7 8 . 9))
正常に動作していますね。
次は二分木を操作する関数を作ってみましょう。最初に等値演算子を定義します。
リスト : 等値演算子の定義 instance Eq a => Eq (Tree a) where Nil == Nil = True Leaf x == Leaf y = x == y Cons a d == Cons a' d' = a == a' && d == d' _ == _ = False
演算子 == の右辺と左辺が Nil の場合は True を返します。Leaf x と Leaf y の場合は x と y を == で比較します。Cons の場合は CAR を == で比較し、それから CDR を == で比較します。それ以外の場合は False を返します。
簡単な実行例を示します。
ghci> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 3 4)" :: Tree Int) True ghci> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 3)" :: Tree Int) False ghci> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 4 3)" :: Tree Int) False ghci> (read "((1 2) (3 4))" :: Tree Int) == (read "((1 2) (3 4))" :: Tree Int) True ghci> (read "((1 2) (3 4))" :: Tree Int) == (read "((1 2) (3 . 4))" :: Tree Int) False ghci> (read "((1 2) (3 . 4))" :: Tree Int) == (read "((1 2) (3 . 4))" :: Tree Int) True
次は二分木を探索する関数 memberTree と findTree を作ります。二分木 Tree は二分探索木ではないので、二分木を巡回してすべての要素を調べることになります。
リスト : 二分木の探索 import Control.Monad memberTree :: Eq a => a -> Tree a -> Bool memberTree x Nil = False memberTree x (Leaf y) = x == y memberTree x (Cons a d) = memberTree x a || memberTree x d findTree :: (a -> Bool) -> Tree a -> Maybe a findTree p (Leaf x) = if p x then Just x else mzero findTree p (Cons a d) = findTree p a `mplus` findTree p d findTree _ _ = mzero
memberTree は CAR と CDR の部分木をたどり、引数 x と等しい要素を探します。二分木が Nil ならば False を返します。Leaf y の場合は x と等しいかチェックします。Cons a d の場合は CAR を調べて結果が False であれば CDR を調べます。
findTree は述語 p が真を返す最初の要素を探します。MonadPlus を使っていることに注意してください。二分木が Leaf の場合、p x が真であれば Just x を返し、そうでなければ mzero (Nothing) を返します。Cons a d の場合は findTree を CAR に適用し、その結果が mzero であれば findTree を CDR に適用します。それ以外の場合は mzero を返します。
簡単な実行例を示します。
ghci> a = read "(1 (2 (3 (4 . 5) 6) 7) 8 9)" :: Tree Int ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> memberTree 4 a True ghci> memberTree 5 a True ghci> memberTree 9 a True ghci> memberTree 0 a False ghci> memberTree 10 a False ghci> findTree (>6) a Just 7 ghci> findTree (>2) a Just 3 ghci> findTree (<2) a Just 1 ghci> findTree (<1) a Nothing
次は二分木のマップ関数を定義しましょう。Tree を Functor のインスタンスにします。次のリストを見てください。
リスト : マッピング instance Functor Tree where fmap f Nil = Nil fmap f (Leaf x) = Leaf (f x) fmap f (Cons a d) = Cons (fmap f a) (fmap f d)
二分木が Nil ならば Nil を返します。Leaf x ならば Leaf (f x) を返します。Cons a d ならば、CAR と CDR に fmap を適用し、その結果を Cons に格納して返します。とても簡単ですね。
簡単な実行例を示します。
ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> fmap (*2) a (2 (4 (6 (8 . 10) 12) 14) 16 18) ghci> fmap (+1) a (2 (3 (4 (5 . 6) 7) 8) 9 10) ghci> fmap (:[]) a ([1] ([2] ([3] ([4] . [5]) [6]) [7]) [8] [9])
次は二分木を畳み込む関数 foldTree を作りましょう。
リスト : 畳み込み foldTree :: (a -> b -> b) -> b -> Tree a -> b foldTree _ a Nil = a foldTree f a (Leaf x) = f x a foldTree f a (Cons l r) = foldTree f (foldTree f a r) l
二分木が Nil ならば累積変数 a を返します。Leaf x ならば x と a に関数 f を適用します。Cons l r であれば CDR に foldTree を適用してから、CAR に foldTree を適用します。これで foldr と同様の動作になります。
簡単な実行例を示します。
ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> flatten = foldTree (:) [] ghci> flatten a [1,2,3,4,5,6,7,8,9] ghci> countLeaf = foldTree (const (+1)) 0 ghci> countLeaf a 9 ghci> sumTree = foldTree (+) (0::Int) ghci> sumTree a 45
foldTree を使うと二分木を平坦化する関数 flatten, 葉 (要素) の個数を求める countLeaf, 要素の合計値を求める関数 sumTree など、いろいろな関数を簡単に定義することができます。
また、次のように述語が真を返す要素をリストに格納して返す関数 filterTree も簡単に定義することができます。
リスト : フィルター filterTree :: (a -> Bool) -> Tree a -> [a] filterTree p = foldTree (\x a -> if p x then x:a else a) [] -- 別解 filterTree' :: (a -> Bool) -> Tree a -> [a] filterTree' p tree = filter p $ foldTree (:) [] tree
foldTree のラムダ式の中で、p x の返り値が真であれば x を a に追加します。そうでなければ a をそのまま返します。別解は foldTree で二分木を平坦化してから filter を適用します。
簡単な実行例を示します。
ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> filterTree even a [2,4,6,8] ghci> filterTree odd a [1,3,5,7,9]
次は二分木 z の中で y と等しい部分木を x に置き換える関数 subst x y z を作ってみましょう。
リスト : 二分木の置換
subst :: Eq a => Tree a -> Tree a -> Tree a -> Tree a
subst _ _ Nil = Nil
subst x y z
| y == z = x
| otherwise = case z of
(Cons a d) -> Cons (subst x y a) (subst x y d)
_ -> z
二分木が Nil であれば Nil を返します。Nil でなければ、部分木 z が y と等しいかチェックし、そうであれば x を返します。それ以外の場合、z が Cons a d であれば、CAR と CDR に subst を適用して、その返り値を Cons に格納して返します。それ以外の場合は z をそのまま返します。
それでは実行してみましょう。
ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> subst (Leaf 10) (Leaf 5) a (1 (2 (3 (4 . 10) 6) 7) 8 9) ghci> subst (Leaf 10) (Cons (Leaf 4) (Leaf 5)) a (1 (2 (3 10 6) 7) 8 9) ghci> subst (Cons (Leaf 10) Nil) (Cons (Leaf 4) (Leaf 5)) a (1 (2 (3 (10) 6) 7) 8 9)
最後に、二分木の高さを求める関数 height を作りましょう。
リスト : 二分木の高さ height :: Tree a -> Int height Nil = 0 height (Leaf _) = 1 height (Cons a d) = 1 + max (height a) (height d)
Nil ならば 0 を、Leaf ならば 1 を返します。Cons ならば CAR 部と CDR 部に height を適用し、大きいほうの値に 1 を加算します。
それでは実行してみましょう。
ghci> height Nil 0 ghci> height (Leaf 1) 1 ghci> height (Cons (Leaf 1) Nil) 2 ghci> height (Cons (Leaf 1) (Cons (Leaf 2) Nil)) 3 ghci> a (1 (2 (3 (4 . 5) 6) 7) 8 9) ghci> height a 8
正常に動作していますね。
--
-- tree2.hs : Lisp 風のリスト (二分木)
--
-- Copyright (C) 2013-2021 Makoto Hiroi
--
import Data.Char
import Control.Monad
-- 二分木の定義
data Tree a = Nil | Leaf a | Cons (Tree a) (Tree a)
-- 等値演算子
instance Eq a => Eq (Tree a) where
Nil == Nil = True
Leaf x == Leaf y = x == y
Cons a d == Cons a' d' = a == a' && d == d'
_ == _ = False
-- ファンクタ
instance Functor Tree where
fmap f Nil = Nil
fmap f (Leaf x) = Leaf (f x)
fmap f (Cons a d) = Cons (fmap f a) (fmap f d)
-- 二分木の表示
showTree :: Show a => Tree a -> String
showTree (Cons a d) =
show a ++ case d of
Nil -> ""
(Leaf x) -> " . " ++ show x
_ -> " " ++ showTree d
showTree xs = show xs
instance Show a => Show (Tree a) where
show Nil = "()"
show (Leaf x) = show x
show xs = "(" ++ showTree xs ++ ")"
-- 空白文字のスキップ
skipSpace :: String -> String
skipSpace = dropWhile isSpace
-- 要素の読み込み
readsItem :: Read a => ReadS (Tree a)
readsItem s = do
(x, t) <- reads s
return (Leaf x, skipSpace t)
-- 二分木の読み込み
readsTree :: Read a => ReadS (Tree a)
readsTree ('(':xs) = iter (skipSpace xs)
where
iter (')':xs) = return (Nil, xs)
iter ('.':xs) = do
(y, ')':ys) <- readsItem xs
return (y, ys)
iter xs@('(':_) = do
(a, ys) <- readsTree xs
(d, zs) <- iter (skipSpace ys)
return (Cons a d, zs)
iter xs = do
(a, ys) <- readsItem xs
(d, zs) <- iter ys
return (Cons a d, zs)
readsTree (' ':xs) = readsTree xs
-- インスタンスの設定
instance Read a => Read (Tree a) where
readsPrec _ s = readsTree s
-- 探索
memberTree :: Eq a => a -> Tree a -> Bool
memberTree x Nil = False
memberTree x (Leaf y) = x == y
memberTree x (Cons a d) = memberTree x a || memberTree x d
findTree :: (a -> Bool) -> Tree a -> Maybe a
findTree p (Leaf x) = if p x then Just x else mzero
findTree p (Cons a d) = findTree p a `mplus` findTree p d
findTree _ _ = mzero
-- 畳み込み
foldTree :: (a -> b -> b) -> b -> Tree a -> b
foldTree _ a Nil = a
foldTree f a (Leaf x) = f x a
foldTree f a (Cons l r) = foldTree f (foldTree f a r) l
-- フィルター
filterTree :: (a -> Bool) -> Tree a -> [a]
filterTree p = foldTree (\x a -> if p x then x:a else a) []
-- 置換
subst :: Eq a => Tree a -> Tree a -> Tree a -> Tree a
subst _ _ Nil = Nil
subst x y z
| y == z = x
| otherwise = case z of
(Cons a d) -> Cons (subst x y a) (subst x y d)
_ -> z
-- 木の高さ
height :: Tree a -> Int
height Nil = 0
height (Leaf _) = 1
height (Cons a d) = 1 + max (height a) (height d)