quickCheck 入門 - 英文生成(3)

少し考え方を変え、定義をそのままデータ構造にした。Grammar データを単なる Rule の配列でなくタプルのリストにしているのは、あとからルールを参照するため。

module EnglishRule3 where
import Test.QuickCheck
import Control.Monad
import Data.List

data Rule = Empty | Rule :+ Rule | Rule :| Rule | Alt [String] deriving (Eq)
type Grammar = [(String, Rule)]

-- 再帰的データ構造のため Show しないこと
-- instance Show Rule where
--     show Empty = "()"
--     show (r1 :+ r2) = (show r1) ++ " + " ++ (show r2)
--     show (r1 :| r2) = show r1 ++ " | " ++ show r2
--     show (Alt ws) = "(" ++ intercalate "," ws ++ ")"

-- 補助関数
catWords :: String -> String -> String
catWords "" "" = ""
catWords x "" = x
catWords "" y = y
catWords x y = x ++ " " ++ y

rule2gen :: Rule -> Gen String
rule2gen Empty = return ""
rule2gen (Alt ws) = elements ws
rule2gen (r1 :+ r2) = do
  s1 <- rule2gen r1
  s2 <- rule2gen r2
  return $ catWords s1 s2
rule2gen (r1 :| r2) = oneof [rule2gen r1, rule2gen r2]

generate :: Grammar -> String -> Gen String
generate g x = case lookup x g of
                 Just r -> rule2gen r
                 Nothing -> error ("unknown :" ++ x)

ルールの定義は以下の通り。

simpleGrammar = [ ("noun", noun),
                  ("verb", verb),
                  ("article", article),
                  ("noun-phrase", noun_phrase),
                  ("verb-phrase", verb_phrase),
                  ("sentence", sentence) ]
    where
      noun = Alt ["man", "ball", "woman", "table"]
      verb = Alt ["hit", "took", "saw", "liked"]
      article = Alt ["the", "a"]
      noun_phrase = article :+ noun
      verb_phrase = verb :+ noun_phrase
      sentence = noun_phrase :+ verb_phrase

bigGrammar = [ ("sentence", sentence),
               ("noun-phrase", noun_phrase),
               ("verb-phrase", verb_phrase),
               ("pp*", ppStar),
               ("adj*" , adjStar),
               ("pp", pp),
               ("prep", prep),
               ("adj", adj),
               ("article", article),
               ("name", name),
               ("noun", noun),
               ("verb", verb),
               ("pronoun", pronoun) ]
    where
      sentence = noun_phrase :+ verb_phrase
      noun_phrase = (article :+ (adjStar :+ (noun :+ ppStar))) :| (name :| pronoun)
      verb_phrase = verb :+ (noun_phrase :+ ppStar)
      ppStar = Empty :| (pp :+ ppStar)
      adjStar = Empty :| (adj :+ adjStar)
      pp = prep :+ noun_phrase
      prep = Alt ["to", "in", "by", "with", "on"]
      adj = Alt ["big", "little", "blue", "green", "adiabatic"]
      article = Alt ["the", "a"]
      name = Alt ["Pat", "Kim", "Lee", "Terry", "Robin"]
      noun = Alt ["man", "ball", "woman", "table"]
      verb = Alt ["hit", "took", "saw", "liked"]
      pronoun = Alt ["he", "she", "it", "these", "those", "that"]

実行例。

*EnglishRule3> sample' $ generate simpleGrammar "verb"
["liked","hit","hit","saw","hit","hit","hit","liked","took","saw","saw"]
*EnglishRule3> sample' $ generate simpleGrammar "sentence"
["a woman saw the man","the woman saw a woman","the ball liked a table","the woman took a woman","the table saw a man","the table liked the table","the table took a ball","a woman hit a woman","the woman hit a woman","the man liked the table","a man hit a table"]
*EnglishRule3> sample' $ generate bigGrammar "sentence"
["the big woman to Terry saw the man by Lee with a table with she with Kim","Lee saw these by the woman in he to a little big woman by a man to the ball by the ball in Terry to a big table in the table by a man to those by the big big blue adiabatic green adiabatic adiabatic table to that in Terry on the ball on he on a man by Terry by the ball on these in a green green big adiabatic ball in the woman in Terry in Lee with that with the blue table by a adiabatic little man with a woman with a man by Kim on the man on the blue green table on he in the blue blue table to the little ball to a man with the ball","the ball liked the table","Terry hit Robin","Pat saw Lee","a ball saw he","a blue little blue big man in Robin in the ball hit a big blue table on the little green big woman to a ball with Lee to it by Robin in the table by a little big green man on the green woman by it in Lee to a green ball on the woman by a blue woman on a green ball to she to a green ball","a ball hit a blue little green big table on a little little man on Kim to a blue adiabatic man to the adiabatic little woman to a man by Lee by the man in a man with that to these with a table in a man to a big man to she in Lee with he in she in he in Terry in a big man by the woman in Pat","a ball took the woman to the table in she on she with a big blue green table in the adiabatic little table on a woman on the adiabatic table in these to the green adiabatic woman by Lee on a big adiabatic man with Robin in the green big green man with Terry","Terry took these","those took Terry in Robin"]