具体例で学ぶHaskell


# はじめに

前回 [すごいH本が楽しかったのでまとめた](https://qiita.com/ta-ka/items/8679737ac70cf1dc1d78) という記事を書きました．
Haskellの勉強が楽しかったので，[『プログラミングHaskell』](http://amzn.asia/dSz4MZb)を読みました．
その内容の簡単なまとめ記事です．


# 関数型パーサー

第8章の内容になります．
関数を組み合わせて便利なパーサーを構築する過程が面白かったので，題材として取り上げました．

## パーサーの型

`a` 型のパーサーを，`String` 型を受け取り，`Maybe (a, String)` 型を返す関数として定義します．
失敗する場合を扱えるように `Maybe` を用いています．
`Maybe` の中身は，`a` 型の結果と消費されなかった残りの文字列のタプルになります．
定義は以下のようになります．

```haskell
type Parser a = String -> Maybe (a, String)
```

## 基本的なパーサー

基本的なパーサーから始め，徐々に便利なパーサーを構築します．
`a` 型の値と入力文字列を受け取り，文字列を消費しないパーサーを返す関数 `return'` を定義します．

```haskell
return' :: a -> Parser a
return' v s = Just (v, s)
```

入力文字列にかかわらず常に失敗する関数 `failure` を定義します．

```haskell
failure :: Parser a
failure s = Nothing
```

入力文字列が空なら失敗し，そうでなければ最初の文字を消費する関数 `item` を定義します．

```haskell
item :: Parser Char
item []     = Nothing
item (x:xs) = Just (x, xs)
```

それぞれの関数を試してみます．

```haskell
ghci> return' 1 "abc"
Just (1,"abc")

ghci> failure "abc"
Nothing

ghci> item ""
Nothing

ghci> item "abc"
Just ('a',"bc")
```

## 連結と選択

まず，パーサーを連結させることを考えます．
入力文字列に1番目のパーサー `p` を適用し，失敗すれば全体も失敗します．
成功の場合は，1番目のパーサーの結果 `v` に関数 `f` を適用し，2番目のパーサを生成します．
この2番目のパーサーに1番目のパーサーの結果の残りの文字列 `s'` を渡すと最終的な結果が得られます．

```haskell
(>>==) :: Parser a -> (a -> Parser b) -> Parser b
p >>== f = \s -> case p s of
    Nothing -> Nothing
    Just (v, s') -> f v s'    
```

文字を3つ消費し，1番目と3番目を組にして返してみます．

```haskell
ghci> (item >>== \x -> item >>== \y -> item >>== \z -> return' (x, z)) "abcdef"
Just (('a','c'),"def")
```

次にパーサーの結果を選択することを考えます．
1番目のパーサーに入力文字列を渡し，成功したらその結果を，失敗したら2番目のパーサーを適用した結果を返します．

```haskell
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = \s -> case p s of
    Nothing -> q s
    Just (v, s') -> Just (v, s')
```

いくつか試してみます．

```haskell
ghci> (item +++ return 'd') "abc"
Just ('a', "bc")

ghci> (failure +++ return 'd') "abc"
Just ('d', "abc")

ghci> (failure +++ failure) "abc"
Nothing
```

## パーサーの部品

基本的なパーサーと，連結や選択を組み合わせると意味のあるパーサーを定義できます．
`sat`, `string`, `many`, `many1` を見ていきます．

**sat**
述語 `p` を満足する一文字用のパーサー `sat` を以下のように定義します．

```haskell
sat :: (Char -> Bool) -> Parser Char
sat p = item >>== \c -> if p c
    then return' c
    else failure
```

`sat` に色々な述語を渡すと，特定の文字に対するパーサーを定義できます．

```haskell
import Data.Char

digit :: Parser Char
digit = sat isDigit

lower :: Parser Char
lower = sat isLower

alphanum :: Parser Char
alphanum = sat isAlphaNum

char :: Char -> Parser Char
char x = sat (== x)
```

試してみます．

```haskell
ghci> digit "123"
Just ('1',"23")

ghci> digit "abc"
Nothing

ghci> char 'a' "abc"
Just ('a',"bc")

ghci> char 'a' "123"
Nothing
```

**string**
パーサー `char` を使ってパーサー `string` を定義します．
パーサー `string` は，引数の文字列がすべて消費される場合に限って成功します．

```haskell
string :: String -> Parser String
string [] = return' []
string (x:xs) = char x >>== \_ -> string xs >>== \_ -> return' (x:xs)
```

`Parser` をモナドインスタンスとして宣言していれば，do記法で以下のように定義できます．

```haskell
string :: String -> Parser String
string [] = return []
string (x:xs) = do
    char x
    string xs
    return (x:xs)
```

例を使って動作を追いかけてみます．
パーサー `char` で一文字目を消費し，成功なら `Just` を，失敗なら `Nothing` を返します．
`Just` の場合次のパーサー `string` に残りの文字列が渡されます．
`string "abc"` は，全てが成功した場合 `Just ("abc", 残りの文字列)` を返し，
どこかで失敗した場合 `Nothing` を返すパーサーです．

```haskell
string "abc"
char 'a' >>== \_ -> string "bc" >>== \_ -> return' ('a':"bc")
-- 入力文字列の先頭が 'a' かつ string "bc" の戻り値が Just なら Just ("abc", 残りの文字列) を返す

string "bc"
char 'b' >>== \_ -> string "c" >>== \_ -> return' ('b':"c")
-- 入力文字列の先頭が 'b' かつ string "c" の戻り値が Just なら Just ("bc", 残りの文字列) を返す

string "c"
char 'c' >>== \_ -> string "" >>== \_ -> return' ('c':"")
-- 入力文字列の先頭が 'c' なら Just ("c", 残りの文字列)を返す

string ""
return' ""
-- Just ("", 入力文字列) を返す
```

```haskell
ghci> string "abc" "abcdef"
Just ("abc", "def")

ghci> string "abc" "abdef"
Nothing
```

**many, many1**
`many` と `many1` はパーサーを失敗するまで適用し，成功した結果をリストにして返します．
`many` はパーサーを0回以上，`many1` はパーサーを1回以上適用します．

```haskell
many :: Parser a -> Parser [a]
many p = many1 p +++ return' []

many1 :: Parser a -> Parser [a]
many1 p = p >>== \v -> many p >>== \vs -> return' (v:vs)
```

`many` は，`+++` により `return'` を選択しているため，`many1` が失敗しても `Just` を返します．
`many1` は，述語 `p` を1回適用したのち，その結果に `many` を連結しています．

```haskell
ghci> many digit "123abc"
Just ("123","abc")

ghci> many digit "abcdef"
Just ("","abcdef")
```

パーサー `many`, `many1` を使ってパーサー `ident`, `nat`, `space` を定義します．
`ident` は識別子，`nat` は自然数，`space` は空白のパーサーです．

```haskell
ident :: Parser String
ident = lower >>== \x -> many alphanum >>== \xs -> return' (x:xs)

nat :: Parser Int
nat = many1 digit >>== \xs -> return' (read xs)

space :: Parser ()
space = many (sat isSpace) >>== \_ -> return' ()
```

それぞれの関数を試してみます．

```haskell
ghci> ident "abc def"
Just ("abc"," def")

ghci> nat "123 abc"
Just (123," abc")

ghci> space "  abc"
Just ((),"abc")
```

前後の空白を無視する `token` を定義し，`ident`, `nat` を強化します．

```haskell
token :: Parser a -> Parser a
token p = space >>== \_ -> p >>== \v -> space >>== \_ -> return' v

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat
```

これもそれぞれ試してみます．

```haskell
ghci> identifier "   abc def"
Just ("abc","def")

ghci> natural "  123  456  "
Just (123,"456  ")
```


# 切符番号遊び

11章の内容になります．
計算に使用できる自然数と四則演算を組み合わせて，目標の数になる計算式を作成するゲームです．
使用する自然数の個数は任意であり，使えるのはそれぞれ一回ずつです．
途中計算に出てくる数も自然数でなければならないという制約があります．
例えば，与えられた自然数が1, 3, 7, 10, 25, 50であり，目標の数を765とします．
解の一つは `(1 + 50) * (25 - 10)` になります．

```haskell
(1 + 50) * (25 - 10)
= 51 * (25 - 10)
= 51 * 15
= 765
```

## 演算の定義

まず，四則演算子の型を定義します．
`valid` は重複を排除するために工夫をしています．

```haskell
data Op = Add | Sub | Mul | Div deriving (Show)

-- 演算子を適用した結果が自然数となるか否かを返す
valid :: Op -> Int -> Int -> Bool
valid Add x y = x <= y -- x + y = y + x より x <= y の場合のみ計算すれば良い
valid Sub x y = x > y -- 結果は自然数でなければならないので x > y
valid Mul x y = x /= 1 && y /= 1 && x <= y -- 結果が変わらないので 1 を除く
valid Div x y = y /= 1 && x `mod` y == 0 -- 結果が変わらないので 1 を除く

-- 演算子を適用した結果を返す
apply :: Op -> Int -> Int -> Int
apply Add x y = x + y
apply Sub x y = x - y
apply Mul x y = x * y
apply Div x y = x `div` y
```

次に，数式の型を定義します．
数式は，自然数or二つの式への演算子適用を表します．
`eval` は空リストで失敗を表現します．

```haskell
data Expr = Val Int | App Op Expr Expr deriving (Show)

-- 式の中の自然数をリストとして返す
values :: Expr -> [Int]
values (Val n) = [n]
values (App _ l r) = values l ++ values r

-- 式全体の値を返す
eval :: Expr -> [Int]
eval (Val n) = [n | n > 0]
eval (App o l r) = [apply o x y | x <- eval l, y <- eval r, valid o x y]
```

以下のように動きます．

```haskell
-- (3 - 2) + (4 * 5)
ghci> values $ App Add (App Sub (Val 3) (Val 2)) (App Mul (Val 4) (Val 5))
[3,2,4,5]
ghci> eval $ App Add (App Sub (Val 3) (Val 2)) (App Mul (Val 4) (Val 5))
[21]
```

## 組み合わせ

組み合わせを扱う便利な関数を定義します．
これから紹介する関数はどれも感動するものばかりです．

**subs**
リストの部分リストを返します．
例えば，`[1,2,3]` に対する全ての部分リストは
 `[[],[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]` になります．
各要素を使うか否かなので，生成される部分リストは，2^(リストの長さ)パターンになります．
以下のように定義します．

```haskell
subs :: [a] -> [[a]]
subs [] = [[]]
subs (x:xs) = ys ++ map (x:) ys
    where ys = subs xs
```

空リストを受け取った場合，ネストした空リストを返します．
そうでなければ，tail `xs` から生成される部分リスト `ys` と，
head `x` を `ys` の先頭に追加したリスト `map (x:) ys` を結合したものを返します．
動きを追って見てみます．

```haskell
subs [1,2,3]
subs [2,3] ++ map (1:) subs [2,3] -- (1)

subs [2,3]
subs [3] ++ map (2:) subs [3] -- (2)

subs [3]
subs [] ++ map (3:) subs []
[[]] ++ map (3:) [[]]
[[],[3]] -- (3)

-- (2) へ (3) を渡す
subs [2,3]
[[],[3]] ++ map (2:) [[],[3]]
[[],[3],[2],[2,3]] -- (4)

-- (1) へ (4) を渡す
subs [1,2,3]
[[],[3],[2],[2,3]] ++ map (1:) [[],[3],[2],[2,3]]
[[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]]
```

**interleave**
リストに新たな要素を挿入したリストを返します．
例えば，新たな要素 `1` を `[2,3,4]` に挿入した結果は，
`[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1]]` になります．
以下のように定義します．

```haskell
interleave :: a -> [a] -> [[a]]
interleave x [] = [[x]]
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)
```

空リストに要素を追加した場合，追加要素のみのネストしたリストを返します．
そうでなければ，先頭に新たな要素 `x` を追加したリスト `(x:y:ys)` と，
リストのtail `ys` に新たな要素 `x` を追加したリスト `interleave x ys` の先頭に head `y` を追加したリストを
結合したものを返します．
動きを追って見てみます．

```haskell
interleave 1 [2,3,4]
(1:2:[3,4]) : map (2:) (interleave 1 [3,4]) -- (1)

interleave 1 [3,4]
(1:3:[4]) : map (3:) (interleave 1 [4]) -- (2)

interleave 1 [4]
(1:4:[]) : map (4:) (interleave 1 [])
[1,4] : map (4:) [[1]]
[1,4] : [[4,1]]
[[1,4],[4,1]] -- (3)

-- (3) を (2) へ渡す
interleave 1 [3,4]
[1,3,4] : map (3:) [[1,4],[4,1]]
[1,3,4] : [[3,1,4],[3,4,1]]
[[1,3,4],[3,1,4],[3,4,1]] -- (4)

-- (4) を (1) へ渡す
interleave 1 [2,3,4]
[1,2,3,4] : map (2:) [[1,3,4],[3,1,4],[3,4,1]]
[1,2,3,4] : [[2,1,3,4],[2,3,1,4],[2,3,4,1]]
[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1]]
```

**perms**
リストの要素の順列を返します．
例えば，`[1,2,3]` の順列は，
`[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]` になります．
以下のように定義します．

```haskell
perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = concat $ map (interleave x) (perms xs)
```

空リストの場合，ネストした空リストを返します．
そうでなければ，tail `xs` の順列に `interleave` を適用してhead `x` を新たな要素として挿入します．
動きを追って見てみます．

```haskell
perms [1,2,3]
concat $ map (interleave 1) (perms [2,3]) -- (1)

perms [2,3]
concat $ map (interleave 2) (perms [3]) -- (2)

perms [3]
concat $ map (interleave 3) (perms [])
concat $ map (interleave 3) [[]]
concat $ [[[3]]]
[[3]] -- (3)

-- (3) を (2) へ渡す
perms [2,3]
concat $ map (interleave 2) [[3]]
concat $ [[[2,3],[3,2]]]
[[2,3],[3,2]] -- (4)

-- (4) を (1) へ渡す
perms [1,2,3]
concat $ map (interleave 1) [[2,3],[3,2]]
concat $ [[[1,2,3],[2,1,3],[2,3,1]],[[1,3,2],[3,1,2],[3,2,1]]]
[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
```

**choices**
リストから選択肢を返します．
上記の素晴らしい関数を適用していくだけです．
`subs` により生成された部分リストに `map perms` で順列を取り，
最後に `concat` して平らにしています．

```haskell
choices :: [a] -> [[a]]
choices xs = concat $ map perms $ subs xs
```

**split**
リストを空でない二つのリストに分割して返します．
例えば，`[1,2,3,4]` を分割した結果は，`[([1],[2,3,4]),([1,2],[3,4]),([1,2,3],[4])]` になります．
以下のように定義します．

```haskell
split :: [a] -> [([a], [a])]
split [] = []
split [_] = []
split (x:xs) = ([x], xs) : [(x:ls, rs) | (ls, rs) <- split xs]
```

空リストor要素数1のリストの場合，空リストを返します．
そうでなければ，`([x], xs)` なるタプルとtail `xs` を分割した結果の左要素のリストの先頭に head `x` を加えたものを
結合して返します．
動きを追って見てみます．

```haskell
split [1,2,3,4]
([1], [2,3,4]) : [(1:ls, rs) | (ls, rs) <- split [2,3,4]] -- (1)

split [2,3,4]
([2], [3,4]) : [(2:ls, rs) | (ls, rs) <- split [3,4]] -- (2)

split [3,4]
([3], [4]) : [(3:ls, rs) | (ls, rs) <- split [4]]
[([3], [4])] -- (3)

-- (2) へ (3) を渡す
split [2,3,4]
([2], [3,4]) : [(2:ls, rs) | (ls, rs) <- [([3], [4])]]
([2], [3,4]) : [([2,3],[4])]
[([2],[3,4]),([2,3],[4])] -- (4)

-- (1) へ (4) を渡す
split [1,2,3,4]
([1], [2,3,4]) : [(1:ls, rs) | (ls, rs) <- [([2],[3,4]),([2,3],[4])]]
([1], [2,3,4]) : [([1,2],[3,4]),([1,2,3],[4])]
[([1],[2,3,4]),([1,2],[3,4]),([1,2,3],[4])]
```

## 問題を解く

組み合わせ関数を使って切符番号遊びを解きます．
まず，式と式全体を評価した値の組を表す型を定義します．

```haskell
type Result = (Expr, Int)

-- 2つの Result を受け取り，結果が自然数となる四則演算の結果 [Result] を返す
combine :: Result -> Result -> [Result]
combine (l, x) (r, y) = [(App o l r, apply o x y) | o <- [Add, Sub, Mul, Div], valid o x y]

-- 自然数のリストを受け取り，それぞれの値が一回だけ使われている全ての式を返す
results :: [Int] -> [Result]
results [] = []
results [n] = [(Val n, n) | n > 0]
results ns = [res | (ls, rs) <- split ns,
    lx <- results ls,
    ry <- results rs,
    res <- combine lx ry]
```

切符番号遊びを満たす全ての式を返す関数 `solutions` を定義できます．
`results` は与えられた自然数リストの値が一回だけ使われる全ての式を返すので，
`choices` によって `ns` から選択肢 `ns'` を生成し，`ns'` を `results` に渡します．
得られた値 `m` が目標となる値 `n` と等しくなるときの式 `e` が最終的な結果となります．

```haskell
solutions :: [Int] -> Int -> [Expr]
solutions ns n = [e | ns' <- choices ns,
    (e, m) <- results ns',
    m == n]
```


# おわりに

パーサーと切符番号遊びを具体例にHaskellを学ぶことができました．