前回は単語修正用のコーパスファイルを読み込んで、それをタプルのリストにするところまでできた。今回はそれを使って、スペル修正を評価することを試みる。

コーパス内のファイルをfor-eachでひとつひとつテストする:forMを使う、解剖してみる

for-eachしたい、のだけどfor-eachはかなり関数型言語っぽくない。とても手続き型言語の雰囲気を醸し出す、というのは関数型言語において実行順序というのがあんまり意味を持たないからだと思う。Haskellにおいて順序をもたらすのは見てきたようにIOモナドなので、これを使ってfor-eachみたいなことができるものがある。forMだ。forMはHackageによると

forM :: Monad m => [a] -> (a -> m b) -> m [b]
-- forM is mapM with its arguments flipped

forMをつかった簡単な例を見てみる

forM [1..10] $ \i -> do
    print i

これで、1,2,3,...,10が表示される。確かにfor-eachだ。forMはmapMを使って定義されるという。mapMを見てみると

mapM :: Monad m => (a -> m b) -> [a] -> m [b]  Source
-- mapM f is equivalent to sequence . map f.

ということらしい。そんでもってmapMはsequence . map fということらしい。更に解剖してみる。mapはわかるので(普通のリストに対するmapでモナドとは関係ない)、sequenceだ。sequenceを見てみると

sequence :: Monad m => [m a] -> m [a]    Source
-- Evaluate each action in the sequence from left to right, and collect the results.

どうやら突き当たったようだ。sequenceはmのモナドであるaのリストをaのリストのモナドmに変換する。わけがわからない。こういう時はソースを見るに限る。Hackageのソースのボタン（その関数定義のずっと右端にあるはず）を押してみる。sequenceのsourceは

-- | Evaluate each action in the sequence from left to right,
-- and collect the results.
sequence       :: Monad m => [m a] -> m [a] 
{-# INLINE sequence #-}
sequence ms = foldr k (return []) ms
            where
              k m m' = do { x <- m; xs <- m'; return (x:xs) }

一旦落ち着いてfoldrの定義から再確認していこう。foldrは

foldr <関数> <初期値> <処理するリスト>

ということになる。例えばfoldr (+) 0 [1,2,3,4]の場合、こんな感じ

f:id:euphonictechnologies:20140817150950p:plain

関数で初期値から初めてリストの要素を右から一個ずつつないでいくようなイメージ。

sequenceのfoldrの初期値は(return [])なるモナド。空っぽのリストを返す。モナドのリストからリストのモナドを返すsequenceの出発点としては、何もなかったら空のリストを返したいので、あってると思う。処理するリストはもちろん引数のモナドのリストだ。なので関数がわかればsequenceが分かりそう。

k m m' = do { x <- m; xs <- m'; return (x:xs) }

というのはmとm'という２つのモナドアクションを受け取って、そのモナドアクションの返り値を受け取ってxとxsにして、リストをつないで返す。ここでxは要素、xsはリストだ。それが、モナドアクションのリストをこんなかんじで処理していく:

f:id:euphonictechnologies:20140817152310p:plain

リストの中のそれぞれのモナドアクションM aからM dがa'からd'なる答えを返すとすると、上のように結果をどんどんつないでリストを使って最後M [a', b', c', d']というリストのモナドを返す。小難しく言ってるけど、モナドアクションのリストを左から右に処理して結果をどんどんつないでリストにして返す、というだけの話。その時にモナドアクションの返り値のモナドというコンテナをひっぺがして中身を取り出して、中身同士くっつけてモナドというコンテナに戻して...を繰り返してリストのモナドをどんどん伸ばしていく。

例えばsequence [print "1", print "2", print "3", print "4"]は1から4まで順番に表示することになる。printはIO ()を返すので（つまり何も返さないので)、副作用だけを順番にディスプレイに施していく。

例えばsequence [getChar, getChar, getChar, getChar]はgetCharがIO Charを返す関数であることを思い出すと、1文字読み込んではIO CharのIOというコンテナを剥がして中身のCharを取り出して[]とくっつけて、リストを作ってIO [Char]にして、でもって次の文字を読み込んでIO Charを取得してIOを剥がしてCharとIOを剥がした[Char]をリストのコンスでくっつけて...を繰り返しIO Charの4つをIO [Char]なる4文字のCharのリストのIOにして返す。

これで、sequenceが分かったとして、次にmapMにとりかかってみる。

sequenceがわかれば楽勝。mapMはsequence [print "1", print "2", print "3", print "4"]をsequence $ map print ["1", "2", "3", "4"]としているだけ。

最後にforM。これはmapMの関数とリストを逆にしてforっぽく見せているだけ。つまり、最初に出した

forM [1..10] $\ i -> do
    print i

は

mapM (\i -> do print i) [1..10]

と考えればよい。doのところにいろいろ複数行書けばそれをmapしてリストの要素ひとつひとつに当てはめていくだけ。sequenceでつないでいくので、doの中身で計算できたことをどんどん勝手につないでいって、最後にリストにして返してくれる。これを頭に入れて単語修正コーパスをfor-eachするプログラムを書いてみると:

    correctHelper ::(Text.Text, Text.Text) -> Map.Map Text.Text Int -> Text.Text
    correctHelper corpusPair trained = fst (fst (SC.correct (snd (corpusPair)) trained))

    spellTestForEach :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> IO [Assertion]
    spellTestForEach corpus trained =
        forM corpus $ \i -> do
            return $ fst (i) @=? correctHelper (i) trained

spellTestForEachにおけるcorpusは(修正後, 修正前)なる単語のタプルのリスト。それをひとつとって、修正後の単語と修正前の単語をcorrectHelper(単なるラッパ関数)にかけて修正をさせて、それを比較する、というAssertionを返すというモナドアクションをforMに食わせると、中身のsequenceがそのAssertionを返すモナドのリストをどんどん処理してAssertionのリストを返す一つのモナドを返す。for-eachが実現できている。

実行可能なMain.hsはこんな感じ

module Main where
    import Text.Printf (printf)
    import Test.HUnit
    import Test.Framework
    import Test.Framework.Providers.HUnit
    import qualified Data.Text as Text
    import qualified Data.Text.IO as TextIO
    import qualified Data.List as List
    import qualified Data.Map as Map
    import Control.Monad
    import qualified CachedHttpData as CHD
    import qualified SpellCorrector as SC


    corpusFilePath :: String
    corpusFilePath = "/Users/username/Downloads/0643/0643"

    dictUrl :: String
    dictUrl = "http://norvig.com/big.txt"

    main :: IO ()
    main = do
        corpus <- getCorpus "FAWTHROP1DAT.643.short"
        print $ List.take 5 corpus
        respStr <- CHD.getUrl dictUrl
        let trained = SC.train $ SC.wordsFromText respStr
        print $ List.take 5 $ Map.toList trained
        testlist <- (spellTestForEach corpus trained)
        defaultMain $ hUnitTestToTests $ TestList (List.map TestCase testlist)

    loadFile :: String -> String -> IO Text.Text
    loadFile fileName "" = loadFile fileName corpusFilePath
    loadFile fileName dir = do
        let filePath = dir ++ "/" ++ fileName
        TextIO.readFile filePath

    parseLine :: Text.Text -> [Text.Text]
    parseLine textStr = Text.split (`elem` ",\n") (Text.toLower textStr)

    parsePair :: Text.Text -> [Text.Text]
    parsePair pairStr = Text.split (`elem` " ") (Text.toLower pairStr)

    parsePairs :: [Text.Text] -> [(Text.Text, Text.Text)]
    parsePairs = List.map ((\ x -> (head x, x !! 1)) . List.filter (\ x -> Text.length x > 0) . parsePair)

    getCorpus :: String -> IO [(Text.Text, Text.Text)]
    getCorpus fileName = liftM (parsePairs . parseLine) $ loadFile fileName ""

    correctHelper ::(Text.Text, Text.Text) -> Map.Map Text.Text Int -> Text.Text
    correctHelper corpusPair trained = fst (fst (SC.correct (snd (corpusPair)) trained))

    spellTestForEach :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> IO [Assertion]
    spellTestForEach corpus trained =
        forM corpus $ \i -> do
            return $ fst (i) @=? correctHelper (i) trained

この中で使われているFAWTHROP1DAT.643.shortはFAWTHROP1DAT.643のうちから100個選んだテストのテスト用の小さいコーパスファイルだ。

実行してみると

/usr/local/bin/cabal test
Re-configuring with test suites enabled. If this fails, please run configure
manually.
Resolving dependencies...
Configuring spllerE-1.0...
Building spllerE-1.0...
Preprocessing executable 'spllerE' for spllerE-1.0...
Preprocessing test suite 'Test' for spllerE-1.0...
[3 of 3] Compiling Main             ( src/test/Main.hs, dist/build/Test/Test-tmp/Main.o )

src/test/Main.hs:2:5: Warning:
    The import of `Text.Printf' is redundant
      except perhaps to import instances from `Text.Printf'
    To import instances alone, use: import Text.Printf()
Linking dist/build/Test/Test ...
Running 1 test suites...
Test suite Test: RUNNING...
[("accommodations","accomodations"),("accompaniment","accompanimen"),("accompanying","accompaning"),("accomplice","acomplice"),("acquiescence","acquiesence")]
[("",196312),(".",930),("...",232),("....",2),("..............|",1)]
: [OK]
: [Failed]
expected: "accompaniment"
 but got: "accompanied"
: [OK]
: [OK]
: [OK]
: [OK]
: [Failed]
expected: "actually"
 but got: "actual"
: [Failed]
expected: "adaptability"
 but got: "adaptibility"
: [OK]
: [Failed]
expected: "alumnae"
 but got: "calumny"
: [Failed]
expected: "alumni"
 but got: "alumnae"
: [Failed]
expected: "yearned"
 but got: "turned"
: [Failed]
expected: "yeoman"
 but got: "woman"
: [OK]
: [OK]
: [OK]

         Test Cases    Total        
 Passed  62            62           
 Failed  38            38           
 Total   100           100          
Test suite Test: FAIL
Test suite logged to: dist/test/spllerE-1.0-Test.log
0 of 1 test suites (0 of 1 test cases) passed.

100個の内62個パスして38個失敗。62%の修正率。ちょっと低くないか...?

というわけで、今回はモナドについて考えてみた。まだまだ手に馴染んでこない。

ここらへんが良さそうだ: