前回はユニットテストの下ごしらえをして評価を実装する手前までやってみた。前回まででIntelliJ上でボタンクリックでユニットテストが走る。この上に実際に評価をするためのコードを書き足していこう。

スペル修正プログラムはどう書くかによると[OTA] Birkbeck spelling error corpus [Electronic resource] / Roger Mittonにスペル修正のコーパスがあるそうな。つまり、間違っている単語とその正しい単語の組み合わせがたくさんあると。これを使えば間違っている単語を今回作ったプログラムに通して答えを得たら、それをコーパスの正答と比較することでどのくらいの精度で修正できているかがみえる。

まずはコーパスをダウンロードしてzipを解凍する。中身にはREADMEと実際のコーパスファイルが入っている。コーパスファイルは特定のフォーマットになってはおらず、AAAREADMEDOC.643にそのファイルの説明が書いてある。例えばFAWTHROP1DAT.643というファイルはコンピュータに読める形式だと書いてあるので、中を覗いてみると空白でカラムが揃えられた2カラムのファイルで。雰囲気としては

shusei-tango                      saisho-no-error-tango,
shusei-tango2                    tsugino-error-tango,
...

といった感じ。

評価プログラムにまず必要なのは、このファイルをローカルドライブからロードしてパーズして評価を走らせる準備をすることのようだ。

ファイルのロードを実装する

これはCachedHttpDataを作るときに使ったreadが使える。ファイルの読み込みに失敗すると復旧ができないのでcatchしないでおこう。

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

としてみた。

パーズする

ファイルが手に入ったので、次はパージングだ。これも適当に終わらせてしまう。一行は単語といくつかの空白とカンマと改行なので、これを順番にText.splitしていく。つまり、

改行でsplitして一行ごと分解する
カンマがいらないので消す
一行のうち空白の前と後ろを取り出す

ということをするために、以下のようにしてみた:

    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 = List.map (\x -> (x!!0,x!!1)) (List.map (List.filter (\x -> Text.length x > 0)) (List.map parsePair list))

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

まずは一行ごとに分解するparseLine。次にそのリストを処理して、(修正単語, エラー単語)という形のタプルのリストを返すparsePairs。parsePairsは一行を処理してタプルを作り出すparsePairをすべての行に適用する。

getCorpusはそれらをIOから使えるようにしたもので、ファイル名を与えるとタプルのリストを返す。

スペル修正プログラムをリファクタしてスペル修正部分をモジュールに取り出す

Haskellは参照透過なので、部分をモジュールに切り出すのがとても簡単。Main.hsのcorrectとかその他もろもろをSpellCorrectorというモジュールに切り出してみる。基本的にはカットアンドペーストで大丈夫。以下のようになった:

Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where
    import Text.Printf (printf)
    import System.Environment (getArgs)
    import qualified Data.Text as Text
    import Data.Text ()
    import qualified Data.List as List
    import qualified CachedHttpData as CHD
    import qualified SpellCorrector as SC
    import Control.Monad

    main :: IO ()
    main = do
        word:url:_ <- liftM (++ ["http://norvig.com/big.txt"]) getArgs
        respStr <- CHD.getUrl url
        let (corrected,candidates) = SC.correct (Text.pack word) $ SC.train $ SC.wordsFromText respStr
        printf "Corrected : "
        print corrected
        printf "Candidates : "
        print $ List.take 5 candidates
        printf "...\n"

SpellCorrector.hs

module SpellCorrector where
    import qualified Data.Text as Text
    import Data.Text ()
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified Data.Ord as Ord

    wordsFromText :: Text.Text -> [Text.Text]
    wordsFromText textStr = Text.split (`elem` " ,\"\'\r\n!@#$%^&*-_=+()") (Text.toLower textStr)

    train :: [Text.Text] -> Map.Map Text.Text Int
    train =
        List.foldl' (\map element -> Map.insertWithKey (\_ v y -> v + y) element 1 map) Map.empty

    substr :: Text.Text -> Int -> Int -> Text.Text
    substr s i j = Text.take (j - i) $ Text.drop i s

    edits1 :: Text.Text -> [Text.Text]
    edits1 word =
        let
            l = Text.length word
            alphabet = "abcdefghijklmnopqrstuvwxyz"
        in
        [ substr word 0 i `Text.append` substr word (i + 1) l | i <- [0..l-1] ] ++
            [ substr word 0 i `Text.snoc` (word `Text.index` (i+1)) `Text.snoc` (word `Text.index` i) `Text.append` substr word (i + 2) l | i <- [0..l-2] ] ++
            [ substr word 0 i `Text.snoc` (alphabet !! c) `Text.append` substr word (i + 1) l | c <- [0..25], i <- [0..l-1] ] ++
            [ substr word 0 i `Text.snoc` (alphabet !! c) `Text.append` substr word i l | c <- [0..25], i <- [0..l-1] ]

    edits2 :: Text.Text -> [Text.Text]
    edits2 word =
        [e2 | e1 <- edits1 word, e2 <- edits1 e1]

    known :: [Text.Text] -> Map.Map Text.Text Int -> [Text.Text]
    known words knownWords = List.foldl' (\z x -> if x `Map.member` knownWords then x:z else z) [] words

    knownEdits2 :: Text.Text -> Map.Map Text.Text Int -> [Text.Text]
    knownEdits2 word = known (edits2 word)

    orSet a b = if not (null a) then a else b

    correct :: Text.Text -> Map.Map Text.Text Int -> ((Text.Text, Int), [(Text.Text, Int)])
    correct word knownWords =
        let
            candidate =
                known [word] knownWords `orSet`
                known (edits1 word) knownWords `orSet`
                knownEdits2 word knownWords `orSet`
                [word]
        in
            let
                candidatePacked = List.sortBy (flip $ Ord.comparing snd) (map (\x -> (x, Map.findWithDefault 0 x knownWords)) candidate)
            in
                (List.head candidatePacked, candidatePacked)

こんな感じになった。メインのプログラムがビルドできるか確かめておこう。

テストからSpellCorrectorとCachedHttpData使えるようにする

.cabalファイルにメインのソースディレクトリを追加しておかないとコンパイルできないので、srcディレクトリをTest-Suiteのディレクトリの部分に追加しておく:

name:              spllerE
version:           1.0
Build-Type:        Simple
cabal-version:     >= 1.2

executable spllerE
  main-is:         Main.hs
  hs-source-dirs:  src
  build-depends:   base,HTTP,containers,text,pureMD5,bytestring
  ghc-options:     -Wall -O2 -fno-warn-unused-do-bind

Test-Suite Test
  type:       exitcode-stdio-1.0
  main-is:    Main.hs
  hs-source-dirs:  src/test,src
  build-depends:    base,HUnit,test-framework,test-framework-hunit,text,containers
  ghc-options:     -Wall -O2 -fno-warn-unused-do-bind

これで、テストからSpellCorrectorとCachedHttpDataが使えるようになったはず。確かめてみよう:

module Main where
    import Test.HUnit
    import Test.Framework
    import Test.Framework.Providers.HUnit
    import qualified Control.Exception as Ex
    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"
        print $ List.take 5 corpus
        respStr <- CHD.getUrl dictUrl
        let trained = SC.train $ SC.wordsFromText respStr
        print $ List.take 5 $ Map.toList trained
        defaultMain $ hUnitTestToTests $ TestList
            [
                TestLabel "hoge" $ TestCase assertOne,
                TestLabel "spellTest1" $ TestCase (spellTestOne corpus trained)
            ]

    assertOne = do
        10 @=? sum [1,2,3,4]
        24 @=? product [1,2,3,4]
        "hoge" @=? "HOGE"

    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 = List.map (\x -> (x!!0,x!!1)) (List.map (List.filter (\x -> Text.length x > 0)) (List.map parsePair list))

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

    spellTestOne corpus trained = do
        10 @=? sum [1,2,3,4]

で、実行結果は

(たくさんWarningとか...)
Linking dist/build/Test/Test ...
Running 1 test suites...
Test suite Test: RUNNING...
[("abattoir","abbatoir"),("abhorrence","abhorence"),("absence","absense"),("absorbent","absorbant"),("absorption","absorbtion")]
[("",196312),(".",930),("...",232),("....",2),("..............|",1)]
:hoge: [Failed]
expected: "hoge"
 but got: "HOGE"
:spellTest1: [OK]

         Test Cases  Total      
 Passed  1           1          
 Failed  1           1          
 Total   2           2          
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.

Process finished with exit code 1

これで、コーパスファイルを読み込んで使えるところまで持ってこられた。次回は実際にテストを書いてみたいと思う。

euphonictechnologies’s diary

Haskell超初心者の日記です。OCamlが好きです。

Haskellで作ったものすごく簡単なスペル修正プログラムを評価してみる - その2:修正単語コーパスのロードとパージング

ファイルのロードを実装する

パーズする

スペル修正プログラムをリファクタしてスペル修正部分をモジュールに取り出す

テストからSpellCorrectorとCachedHttpData使えるようにする