tudurikata

 tudurikata

各パーサーコンビネータにおけるtry/eof(endOfInput)の挙動

2021-07-31
/code#Haskell#Megaparsec#Attoparsec#Parsec

Advent of Code 2020のDay 19を解いていて、複数パーサーの選択でしばらくつまずいていたのでメモ。

TL;DR

テキストを直和型のリストにパースする

Day 19では次のようなテキストを適切にパースすることが求められる。

0: 4 1 5
1: 2 3 | 3 2
2: 4 4 | 5 5
3: 4 5 | 5 4
4: "a"
5: "b"

これを、ひとまず次のような型としてパースしたい。

data Rule = Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

-- expected result
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

Magaparsec - tryで失敗してくれない?

最初に使ったのはMegaparsec。このソースコードから始めよう。

import qualified Data.Map.Strict as M
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Data.Text as T
import Data.Void
import Data.Either (rights)

type Parser = Parsec Void String

readInt x = read x :: Int

data Rule = Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

zero :: Parser Rule
zero = do
  string "0: "
  list <- sepBy1 (many alphaNumChar) (char ' ')
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair = do
  y <- many digitChar
  char ' '
  z <- many digitChar
  return (readInt y, readInt z)

pairs :: Parser Rule
pairs = do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy1 pair (string " | ")
  return $ Pairs n p

key :: Parser Rule
key = do
  n <- readInt <$> many alphaNumChar
  string ": \""
  c <- letterChar
  char '\"'
  return $ Key n c

rules = try zero <|> key <|> pairs

main = readFile "day19e.txt" >>= print . rights . map (parse rules "") . lines

cabal replmainを実行すると、結果はこうなる。

[Zero [4,1,5],Key 4 'a',Key 5 'b']

Data.Eitherrightsで強制的にRightのみを抽出しているので分かりにくいが、2〜4行めはパースに失敗している。ちなみにエラーメッセージはかなり難解。

Right (Zero [4,1,5]),Left (ParseErrorBundle {bundleErrors = TrivialError 1 (Just (Tokens (':' :| " 2"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState = PosState {pstateInput = "1: 2 3 | 3 2", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}}),Left (ParseErrorBundle {bundleErrors = TrivialError 1 (Just (Tokens (':' :| " 4"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState = PosState {pstateInput = "2: 4 4 | 5 5", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}}),Left (ParseErrorBundle {bundleErrors = TrivialError 1 (Just (Tokens (':' :| " 4"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState = PosState {pstateInput = "3: 4 5 | 5 4", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}}),Right (Key 4 'a'),Right (Key 5 'b')]

色々と試行錯誤した結果わかったのは、tryでくるんでいるからといって必ず適切なパーサーを選択してくれるわけではない(適切に選択してもらうためには工夫が必要)ということ。

たとえば2行目の1: 2 3 | 3 2のみをパースしてみると、

*Main> parseTest rules "1: 2 3 | 3 2"
1:2:
  |
1 | 1: 2 3 | 3 2
  |  ^^^
unexpected ": 2"
expecting ": "" or alphanumeric character

tryでくるんでいるから最終的にはpairsを使ってパースしてくれるはずなのに、そうなっていない。
ちなみにpairs単体でパースすると、

*Main> parseTest pairs "1: 2 3 | 3 2"
Pairs 1 [(2,3),(3,2)]

となって正しい結果が出るので、pairs自体にミスがあるわけではなさそうだ。

rulesはまずzeroをトライするが、string "0: "にマッチしないので失敗し、backtrackが発生する。
次にkeyをトライする。そうすると、最初のmany alphaNumCharは成功するが、次のstring ": \""は失敗するのでまたbacktrackが発生する…はずなのだがそうならず、パースは失敗に終わる。

try以降の選択肢の順番なのか?

最初に、tryのくるみ方に問題があるのかもしれないと考えて、tryのあとを色々と変えてみた。すると実際、rules = try key <|> zero <|> pairsとした場合は、

[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

となり成功している。

さらに、rules = try key <|> pairs <|> zeroの場合。

[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

一見成功しているように見えるが、第1行めがZeroではなくPairsでのパースになってしまっているので間違っている。

zero, pairs, keyの順番を入れ替えて試した結果は以下の通り。

orderresultT/F
zero key pairs[Zero [4,1,5],Key 4 'a',Key 5 'b']F
zero pairs key[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)]]F
pairs zero key[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F
pairs key zero[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F
key zero pairs[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']T
key pairs zero[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F

このあたりで薄々ストーリーが見えてくる。zeroで拾いたいのにpairsになってしまっているのは、0: 4 1 5で言うと"1"まではpairsで拾えてしまえることがまず発端になっている。それだけなら残りを失敗するのでいいじゃないか、となりそうだが、途中でパースが止まっても成功扱いとなり、次の行に進んでしまう。

実際、

pairs :: Parser Rule
pairs = do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy pair (string " | ")
  return $ Pairs n p

と、sepBy1からsepByにしてみると、結果は

[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Pairs 4 [],Pairs 5 []]

となって最後の2行がpairsで拾われてしまっていることがわかる。

Megaparsecでのeofの挙動

4: "a"pairsではなくkeyで拾うべき行だということをプログラムに伝えるには、try以降のパーサーの順番をあれこれいじるよりもeofを使えばよいのではないか、と思いつき、以下のようにしてみる。

zero :: Parser Rule
zero = do
  string "0: "
  list <- sepBy1 (many alphaNumChar) (char ' ')
  eof
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair = do
  y <- readInt <$> many alphaNumChar
  char ' '
  z <- readInt <$> many alphaNumChar
  return (y,z)

pairs :: Parser Rule
pairs = do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy1 pair (string " | ")
  eof
  return $ Pairs n p

key :: Parser Rule
key = do
  n <- readInt <$> many alphaNumChar
  string ": \""
  c <- letterChar
  char '\"'
  eof
  return $ Key n c

しかし結果は変わらず、

-- try zero <|> pairs <|> key
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)]]

入力の終了にのみマッチするはずのeofが動いていない。

念のため、テストパーサーを書いてみるとこちらはちゃんと機能する。

test :: Parser String
test = do
  s <- many alphaNumChar
  eof
  return s

---

*Main> parseTest test "aaa"
"aaa"
*Main> parseTest test "aaa111"
"aaa111"
*Main> parseTest test "aaa111+++"
1:7:
  |
1 | aaa111+++
  |       ^
unexpected '+'
expecting alphanumeric character or end of input

Attoparsecでの挙動

つまり、tryでくるんだパーサーにおいてeofがちゃんと動いていないのではないか?ということだ。
どこかのコードが間違っている可能性も十分あるし、ソースコードを読んでいないのでMegaparsecの調査としてはここまでなのだが、本来であれば、try以降のパーサーの順序は極力考慮せず組み立てられるのが理想…だと思うので、これは困る。ちなみに、後に検証してみたところ、Parsecのtry/eofでも同じ問題が発生する。

そこで、試しにAttoparsecを使ってみるとこちらはうまくいった。

import Data.Attoparsec.Text
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Either (rights)

readInt x = read x :: Int

data Rule = Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

zero :: Parser Rule
zero = do
  string "0: "
  list <- many1 digit `sepBy1` char ' '
  endOfInput
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair = do
  x <- readInt <$> many1 digit
  space
  y <- readInt <$> many1 digit
  return (x,y)

pairs :: Parser Rule
pairs = do
  n <- readInt <$> many1 digit
  string ": "
  p <- sepBy1 pair (string " | ")
  endOfInput
  return $ Pairs n p

key :: Parser Rule
key = do
  n <- readInt <$> many1 digit
  string ": \""
  c <- letter
  char '\"'
  endOfInput
  return $ Key n c

rules = choice [pairs, key, zero]

main = TIO.readFile "day19e.txt" >>= print . rights . map (parseOnly rules) . T.lines

---

*Main> main
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

もちろん、choice以降のリスト内の順序をどのパターンにしても、結果は変わらなかった。

ちなみに各パーサーのendOfInputを外すと、

-- rules = choice [pairs, key, zero]
[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 "a",Key 5 "b"]

となって1行目をpairsで拾ってしまっているので、やっぱりendOfInputが機能していることがわかる。

コード自体はほぼ変わらない。主な変更点としては、

MegaparsecAttoparsec
trychoice
eofendOfInput

まず1点め、tryでなくchoiceを使うというのは、Attoparsecがデフォルトで失敗時backtrackをする仕様のためで、これは素晴らしい(tryも実装されているが、これはParsecとの互換性のためと明記されている)。
そしてMegaparsecのeofとAttoparsecのendOfInputは、どうやら局所的に違う挙動をするらしい。(MegaparsecとParsecがこの点で同じ動きをしたのは、MegaparsecがParsecのフォークだからかもしれない)

同じようなディテールで頭を悩ませている人がいたら、参考になれば幸いです。