Haskellで作ったものすごく簡単なスペル修正プログラムを評価してみる - その2:修正単語コーパスのロードとパージング
前回はユニットテストの下ごしらえをして評価を実装する手前までやってみた。前回までで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
これで、コーパスファイルを読み込んで使えるところまで持ってこられた。次回は実際にテストを書いてみたいと思う。
