Functional Programming

ファイル入出力

今回はテキストファイルの入出力処理について説明します。

●標準入出力

Haskell では、ハンドル (Handle) を介してファイルにアクセスします。ハンドルはファイルと 1 対 1 に対応していて、ファイルからデータを入力するときは、ハンドルを経由してデータが渡されます。逆に、ファイルへデータを出力するときもハンドルを経由します。

通常のファイルはハンドルを生成しないとアクセスすることができません。ただし、標準入出力は Haskell の起動時にハンドルが自動的に生成されるので、簡単に利用することができます。一般に、キーボードからの入力を「標準入力」、画面への出力を「標準出力」といいます。標準入出力に対応するハンドルはモジュール System.IO に定義されています。下表に変数名を示します。

Handle はハンドルを表すデータ型です。簡単な入出力 で説明した関数 getLine, readLn, putStr, putStrLn, print は stdin, stdout 専用の関数ですが、ハンドルを指定して入出力を行う関数も System.IO には用意されています。主な関数を下表に示します。

hGetContents は遅延評価により、必要になったときにファイルからデータを読み込みます。つまり、返り値の文字列 (リスト) は遅延ストリームとして利用することができます。

簡単な実行例を示します。

Prelude> :m + System.IO
Prelude System.IO> hGetChar stdin
h'h'
Prelude System.IO> hGetLine stdin
hello, world
"hello, world"
Prelude System.IO> hPutChar stdout 'h'
hPrelude System.IO>
Prelude System.IO> hPutStr stdout "hello, world"
hello, worldPrelude System.IO>
Prelude System.IO> hPutStrLn stdout "hello, world"
hello, world
Prelude System.IO> hPrint stdout 10
10
Prelude System.IO> hPrint stdout "hello, world"
"hello, world"

●ファイルのオープンとクローズ

ファイルにアクセスする場合、次の 3 つの操作が基本になります。

1. アクセスするファイルをオープンする
2. 入出力関数を使ってファイルを読み書きする。
3. ファイルをクローズする。

「ファイルをオープンする」とは、アクセスするファイルを指定して、それと 1 対 1に対応するハンドルを生成することです。入出力関数はオープンしたハンドルを経由してファイルにアクセスします。Haskell の場合、ファイルをオープンするにはモジュール System.IO に用意されている関数 openFile を使います。オープンしたファイルは必ずクローズしてください。この操作を行う関数が hClose です。openFile と hClose の型を示します。

openFile :: FilePath -> IOMode -> IO Handle
hClose :: Handle -> IO ()
data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
type FilePath = String

openFile は引数にファイル名 (FilePath) とアクセスモード (IOMode) を指定して、ファイル名で指定されたファイルに対応する Handle を生成し、それを IO に格納して返します。アクセスモードは IOMode 型で指定します。下表にアクセスモードを示します。

読み込みモードの場合、ファイルが存在しないとエラーになります。書き出しモードの場合、ファイルが存在すれば、そのファイルを大きさ 0 に切り詰めてからオープンします。追加モードの場合、ファイルの最後尾にデータを追加します。

ファイル名は文字列で指定し、ファイル名のパス区切り記号にはスラッシュ ( / ) を使います。\ は文字列のエスケープコードに割り当てられているため、そのままではパス区切り記号に使うことはできません。ご注意ください。

●ファイルの表示

それでは簡単な例題として、ファイルの内容を画面へ出力する関数 cat を作ってみましょう。プログラムは次のようになります。

リスト : ファイルの表示 (1)

import System.IO

cat :: FilePath -> IO ()
cat filename = do
  handle   <- openFile filename ReadMode
  contents <- hGetContents handle
  putStr contents
  hClose handle

関数 cat の引数 filename はファイル名を表す文字列です。openFile で filename を ReadMode でオープンしてハンドルを変数 handle にセットします。次に、hGetContents でファイルの内容を読みこみ、それを putStr で画面に表示します。最後に hClose でハンドルをクローズします。

簡単な実行例を示します。test00.txt の内容を表示します。

hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

図 : test00.txt

*Main> cat "test00.txt"
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

もう一つ簡単な例題として、ファイルの先頭から n 行表示するように cat を変更してみましょう。関数名は cat' としました。次のリストを見てください。

リスト : ファイルの表示 (2)

cat' :: Int -> FilePath -> IO ()
cat' n filename = do
  handle   <- openFile filename ReadMode
  contents <- hGetContents handle
  mapM_ putStrLn $ take n $ lines contents
  hClose handle

lines は文字列を改行文字で分割する関数です。

lines :: String -> [String]

簡単な使用例を示します。

*Main> lines "foo bar baz"
["foo bar baz"]
*Main> lines "foo\nbar\nbaz"
["foo","bar","baz"]

cat' は hGetContents で読み込んだ文字列を lines で分割し、take で n 行取り出して mapM_ putStrLn で表示するだけです。

簡単な実行例を示します。

*Main> cat' 1 "test00.txt"
hello, world
*Main> cat' 2 "test00.txt"
hello, world
hello, Haskell
*Main> cat' 3 "test00.txt"
hello, world
hello, Haskell
foo bar baz
*Main> cat' 10 "test00.txt"
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

hGetContents を使わない場合は次のようになります。

リスト : ファイルの表示 (3)

takeLines :: Int -> Handle -> IO [String]
takeLines 0 _ = return []
takeLines n h = do
  eof <- hIsEOF h
  if eof 
    then return []
    else do
      x <- hGetLine h
      xs <- takeLines (n - 1) h
      return (x:xs)

cat'' :: Int -> FilePath -> IO ()
cat'' n filename = do
  handle   <- openFile filename ReadMode
  contents <- takeLines n handle
  mapM_ putStrLn contents
  hClose handle

関数 takeLines はハンドル h から n 行読み込み、それをリストに格納して返します。返り値の型は [String] ではなく IO [String] になることに注意してください。

ファイルからデータを読み込む場合、ファイルに格納されているデータには限りがあるので、ハンドルからデータを取り出していくと、いつかはデータがなくなります。この状態を「ファイルの終了 (end of file : EOF)」といいます。

最初に関数 hIsEOF を呼び出してファイルの終了 (EOF) をチェックします。hIsEOF の型を示します。

hIsEOF :: Handle -> IO Bool

EOF の場合は True を、そうでなければ False を返します。ただし、真偽値は IO に格納されて返されることに注意してください。

EOF の場合は return で空リストを IO に格納して返します。そうでなければ、hGetLine で 1 行読み込んで変数 x にセットします。次に takeLines で残りの (n - 1) 行を読み込んで変数 xs にセットします。最後に return で (x:xs) を IO に格納して返します。引数が 0 になったら return で空リストを IO に格納して返します。

cat'' は簡単です。ファイルを openFile でオープンし、そこから n 行を takeLines で読み込みます。あとは mapM_ putStrLn で読み込んだ行を標準出力に表示して、hClose でハンドルをクローズします。

●ファイルの書き込み

データをファイルに書き込むには、ファイルを WriteMode でオープンします。このとき、注意事項が一つあります。既に同じ名前のファイルが存在している場合は、そのファイルの長さを 0 に切り詰めてからデータを書き込みます。既存のファイルは内容が破壊されることに注意してください。

それでは簡単な例題として、[String] の要素を 1 行ずつファイルに書き込む関数 outputStrings を作ってみましょう。次のリストを見てください。

リスト : ファイルの書き込み

outputStrings :: FilePath -> [String] -> IO ()
outputStrings filename xs = do
  handle <- openFile filename WriteMode
  mapM_ (hPutStrLn handle) xs
  hClose handle

最初に openFile でファイル filename を WriteMode でオープンします。あとは、mapM_ を使ってリスト xs から要素を一つずつ取り出し、それを hPutStrLn でファイルに書き込みます。

簡単な実行例を示します。

*Main> outputStrings "test01.txt" ["hello, world", "foo", "bar", "baz", "oops"]
*Main> cat "test01.txt"
hello, world
foo
bar
baz
oops

ファイルをコピーするプログラムも簡単に作ることができます。次のリストを見てください。

リスト : ファイルのコピー

copyFile :: FilePath -> FilePath -> IO ()
copyFile fname1 fname2 = do
  hin  <- openFile fname1 ReadMode
  hout <- openFile fname2 WriteMode
  contents <- hGetContents hin
  hPutStr hout contents
  hClose hin
  hClose hout

引数 fname1 が入力ファイル名、fname2 が出力ファイル名を表します。最初に、fnam1 を ReadMode で、fname2 を WriteMode でモードでオープンします。次に、入力ファイルから hGetContents で内容を読み込み、hPutStr で出力ファイルへ書き出します。最後に hClose でファイルをクローズします。

簡単な実行例を示します。

*Main> copyFile "test00.txt" "test02.txt"
*Main> cat "test02.txt"
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

ファイルのコピーは関数 readFile と writeFile を使うともっと簡単になります。関数の型を示します。

readFile  :: FilePath -> IO String
writeFile :: FilePath -> String -> IO ()

ファイルのオープンとクローズの処理を readFile と writeFile が行ってくれるので、プログラムはとても簡単になります。次のリストを見てください。

リスト : ファイルのコピー (2)

copyFile' :: FilePath -> FilePath -> IO ()
copyFile' fname1 fname2 = readFile fname1 >>= writeFile fname2

readFile で読み込んだデータを演算子 >>= で取り出して writeFile に渡すだけです。

●withFile

Haskell には、ファイルのオープンとクローズを自動的に行ってくれる便利な関数 withFile が用意されています。withFile の型を示します。

withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r

withFile は第 1 引数にファイル名、第 2 引数にアクセスモード、第 3 引数に関数を指定します。withFile はファイルを指定されたアクセスモードでオープンし、そのハンドルを関数の引数に渡して呼び出します。withFile の実行が終了すると、ファイルのハンドルは自動的にクローズされます。何かしらのエラーが発生した場合でも withFile はファイルをクローズしてくれるので安心です。

簡単な例として cat'' と outputStrings を withFile を使って書き直してみましょう。プログラムは次のようになります。

リスト : withFile の使用例

cat''' :: Int -> FilePath -> IO ()
cat''' n filename = 
  withFile filename ReadMode $ \handle -> 
     takeLines n handle >>= mapM_ putStrLn

outputStrings' :: FilePath -> [String] -> IO ()
outputStrings' filename xs =
  withFile filename WriteMode $ \handle ->
    mapM_ (hPutStrLn handle) xs

withFile に渡す関数はラムダ式を使うと簡単です。ラムダ式の引数 handle に withFile がオープンしたファイルのハンドルが渡されます。どちらの場合もファイルをクローズする処理を書く必要がないので、プログラムはとても簡単になります。

このほかにも、Haskell にはいろいろな入出力関数が用意されています。詳しい説明は Haskell のリファレンスマニュアルを参照してください。

●コマンドライン引数の取得

Haskell の場合、モジュール System.Environment の変数 getArgs にコマンドラインで与えられた引数が格納されています。getArgs の型を示します。

getArgs :: IO [String]

簡単な実行例を示しましょう。次のリストを見てください。

リスト : コマンド引数の表示 (cmdline.hs)

import System.Environment

main :: IO ()
main = getArgs >>= print

cmdline.hs は変数 getArgs の内容を表示するだけです。3 つの引数を与えて起動すると、次のように表示されます。

$ stack ghc -- cmdline.hs
[1 of 1] Compiling Main             ( cmdline.hs, cmdline.o )
Linking cmdline.exe ...

$ ./cmdline foo bar baz
["foo","bar","baz"]

簡単な例として、コマンドラインからファイル名を指定してファイルの内容を表示するプログラム cat.hs を作ってみましょう。次のリストを見てください。

リスト : ファイルの表示 (cat.hs)

import System.Environment
import System.IO

main :: IO ()
main = do
  args <- getArgs
  case args of
    [] -> getContents >>= putStr
    _  -> mapM_ (\x -> readFile x >>= putStr) args

最初に getArgs でコマンドラインからファイル名を取得します。空リストの場合は標準入力 (stdin) からデータを getContents で読み込みます。そうでなければ、mapM_ で args からファイル名を取り出し、ラムダ式の中でファイルからデータを読み取って表示します。とても簡単ですね。

それでは cat.hs をコンパイルして、実際に実行してみましょう。

$ cat < test00.txt
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

$ cat test00.txt
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl

$ cat test00.txt test01.txt
hello, world
hello, Haskell
foo bar baz
oops! oops! oops!
abcd efgh ijkl
hello, world
foo
bar
baz
oops

$ 

正常に動作していますね。

二分木と Lisp のリスト

今回は簡単な例題として、Lisp のリストのようなデータ構造を Haskell で作成してみましょう。

●Lisp のリスト

Lisp のリストは複数の「コンスセル (cons cell)」を連結したものです。ひとつのコンスセルには、データを格納する CAR (カー) という場所と、次のセルを連結する CDR (クダー) という場所からなっています。次の図を見てください。

上図では、コンスセルを箱で表しています。左側の CAR がデータを格納する場所で、CDR が次のコンスセルと連結しています。上図の例では、先頭のコンスセルの CAR には 1 が格納され、CDR は次のコンスセルと連結しています。2 番目のコンスセルには CAR に 2 というデータが格納されています。このあとに接続されるコンスセルはもうないので、CDR にはリストの終わりを示す特別なデータ (NIL) が格納されます。このようなリストを Lisp では (1 2) と表記します。Haskell で記述すると [1, 2] になります。

ここまでは Haskell のリストとよく似ていますが、Lisp のリストは CAR にリストを格納して、リストを入れ子にすることができます。次の図を見てください。

上図のリストを 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 では二分木として扱うことになります。それでは実際に試してみましょう。

Prelude> data Tree a = Nil | Leaf a | Cons (Tree a) (Tree a) deriving Show
Prelude> a = Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil))
Prelude> a
Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil))
Prelude> b = Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil))
Prelude> b
Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil))
Prelude> 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 以外のデータの場合、そのリストを次のように表します。

左右のカッコの中間にドット ( . ) を置き、左側に 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 の返り値を連結します。

それでは実行してみましょう。

*Main> Nil
()
*Main> Cons (Leaf 1) Nil
(1)
*Main> Cons (Leaf 1) (Leaf 2)
(1 . 2)
*Main> Cons (Leaf 1) (Cons (Leaf 2) Nil)
(1 2)
*Main> Cons (Leaf 1) (Cons (Leaf 2) (Leaf 3))
(1 2 . 3)
*Main> Cons (Cons (Leaf 1) Nil) (Cons (Leaf 2) (Leaf 3))
((1) 2 . 3)
*Main> Cons (Cons (Leaf 1) (Leaf 2)) (Cons (Leaf 2) (Leaf 3))
((1 . 2) 2 . 3)
*Main> a = Cons (Leaf 2) (Cons (Leaf 10) (Cons (Leaf 11) Nil))
*Main> a
(2 10 11)
*Main> b = Cons (Leaf 3) (Cons (Leaf 12) (Cons (Leaf 13) Nil))
*Main> b
(3 12 13)
*Main> 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]

簡単な使用例を示します。

*Main> dropWhile isSpace "    foo bar baz"
"foo bar baz"
*Main> 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 引数は無視してかまいません。

それでは実行してみましょう。

*Main> read "()" :: Tree Int
()
*Main> read "(1)" :: Tree Int
(1)
*Main> read "(1 . 2)" :: Tree Int
(1 . 2)
*Main> read "(1 2 3 4 5 6 7 8)" :: Tree Int
(1 2 3 4 5 6 7 8)
*Main> read "(1 2 3 4 5 6 7 8 . 9)" :: Tree Int
(1 2 3 4 5 6 7 8 . 9)
*Main> read "((1 2) (3 4) (5 6) (7 8 . 9))" :: Tree Int
((1 2) (3 4) (5 6) (7 8 . 9))
*Main> 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 を返します。

簡単な実行例を示します。

*Main> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 3 4)" :: Tree Int)
True
*Main> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 3)" :: Tree Int)
False
*Main> (read "(1 2 3 4)" :: Tree Int) == (read "(1 2 4 3)" :: Tree Int)
False
*Main> (read "((1 2) (3 4))" :: Tree Int) == (read "((1 2) (3 4))" :: Tree Int)
True
*Main> (read "((1 2) (3 4))" :: Tree Int) == (read "((1 2) (3 . 4))" :: Tree Int)
False
*Main> (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 を返します。

簡単な実行例を示します。

*Main> a = read "(1 (2 (3 (4 . 5) 6) 7) 8 9)" :: Tree Int
*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> memberTree 4 a
True
*Main> memberTree 5 a
True
*Main> memberTree 9 a
True
*Main> memberTree 0 a
False
*Main> memberTree 10 a
False
*Main> findTree (>6) a
Just 7
*Main> findTree (>2) a
Just 3
*Main> findTree (<2) a
Just 1
*Main> 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 に格納して返します。とても簡単ですね。

簡単な実行例を示します。

*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> fmap (*2) a
(2 (4 (6 (8 . 10) 12) 14) 16 18)
*Main> fmap (+1) a
(2 (3 (4 (5 . 6) 7) 8) 9 10)
*Main> 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 と同様の動作になります。

簡単な実行例を示します。

*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> flatten = foldTree (:) []
*Main> flatten a
[1,2,3,4,5,6,7,8,9]
*Main> countLeaf = foldTree (const (+1)) 0
*Main> countLeaf a
9
*Main> sumTree = foldTree (+) (0::Int)
*Main> 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 を適用します。

簡単な実行例を示します。

*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> filterTree even a
[2,4,6,8]
*Main> 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 をそのまま返します。

それでは実行してみましょう。

*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> subst (Leaf 10) (Leaf 5) a
(1 (2 (3 (4 . 10) 6) 7) 8 9)
*Main> subst (Leaf 10) (Cons (Leaf 4) (Leaf 5)) a
(1 (2 (3 10 6) 7) 8 9)
*Main> 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 を加算します。

それでは実行してみましょう。

*Main> height Nil
0
*Main> height (Leaf 1)
1
*Main> height (Cons (Leaf 1) Nil)
2
*Main> height (Cons (Leaf 1) (Cons (Leaf 2) Nil))
3
*Main> a
(1 (2 (3 (4 . 5) 6) 7) 8 9)
*Main> 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)