Haskellでものすごく簡単なスペル修正プログラムを作ってみる - その1:URLをフェッチして修正単語コーパスを作る

Peter Norvigのスペル修正プログラムはどう書くか(リンク先は青木氏による日本語訳)を見てみると画面一枚に収まるような短いPythonコードでスペルチェッカがかけることがわかる。スペルチェッカみたいなちょっと高度なことをしているプログラムが書けると、言語を使いこなしている感じがする。やはりプログラミング言語に慣れるには実際に役に立つプログラムを実際に書いて見るに限る、と私は思う。実際に役に立つのにコードが短くて済みそう、モチベーションが最後まで途切れないといいな、というわけで初めての本格的なHaskell入門の課題にスペルチェッカを選んでみた。果たしてPython版と同じように短いプログラムで表現できるのだろうか。

完成形の青写真を見てみる

スペル修正プログラムはどう書くかにあるプログラムから完成形の青写真を考えてみよう。定義しなくてはいけない関数は

• words
• train
• edits1
• known_edits2
• known
• correct

の6つのようだ。これを念頭に入れながら、コードを少しずつ膨らましていこう。

問題をはっきりさせる

リンク先のスペル修正プログラムはどう書くかに詳しい説明があるのでここでは詳しくは追わないのでリンク先の解説を読んでほしい。

目的は"wという打ち間違いを引き起こした候補単語c"の条件付き確率を与えるP(c|w)を考えるとき、P(c|w)を最大にするcをたくさんある単語の中から見つけ出すことだ。

条件付き確率はベイズの定理で崩すのがお決まりで（なぜお決まりかはリンク先で紹介されている）、ベイズの定理を使ってP(c|w)を変形すると

P(c|w) = P(w|c) * P(c) / P(w)

となる。

• P(w|c) : これは誤りモデルとよばれ、cのつもりでwを書いてしまう確率はどれだけか、ということを考えればよい。
• P(c) : cが書かれる確率は、書きたい人によるのだが、一般的な英語の文書に修正単語cが現れる確率に近いと考えていいだろう。つまり、私が"bbbbbbbbb"という単語を書きたい可能性は殆どゼロだが"the"と書きたい確率はそこそこ高いはず。なのでP("bbbbbbbbb")はゼロに近いがP("the")は結構大きい。
• P(w) : wが書かれる確率は定数だ。修正時に候補単語cを選ぶ計算には影響しない。ここでは無視して計算を省こう。

これで数学的な御膳建てが一応出来たので、コーディングに取り掛かろう。

P(c) : 候補単語cの出現確率を求める

cの出現確率はたくさんの文章の中でcが現れる確率として考えればいいだろう。ここではスペル修正プログラムはどう書くかの原文にあるbig.txtというとても大きい英文のファイルを拝借しよう。やりたいことは

• words関数を定義してテキストを単語のリストみたいなものにして返す。その時に大文字小文字を無視するためにすべて小文字にして空白やアルファベット以外のすべての記号でテキストを区切って単語を作っていく。つまり"There's no such thing as society."は["there", "s", "no", "such", "thing", "as", "society"]となる。
• train関数を定義してP(c)を求められるようにする。train関数は各単語がbig.txtに何個出てきたかを単語->回数というマップ(もしくは辞書)のデータ構造にして返す。

の2つだ。そのために必要なことはおおよそ

• big.txtのURLからテキストファイルをフェッチする
• この大きな文章をすべて小文字にして単語に分割する
• 単語のリストを受け取ってそれを辞書みたいな、マップみたいなデータ構造に収める

となりそうだ。まずはテキストファイルをフェッチする方法を考えてみる。

テキストファイルをURLからフェッチする

前回、標準入力を処理する方法がわかったのでbig.txtをダウンロードしてローカルファイルとしてそれを使えばいいのかな、と思ったのだけど、せっかくだからHaskellのライブラリの助けを借りてURLをフェッチしてみよう。後々役に立ちそうだ。

IntelliJ+Haskellの流れを見てくださっている方は"spller"という新しいプロジェクトをつくろう。プロジェクト名自体が間違っているという面白い奴は無視してくれて構わない。

URLをフェッチする

HackageにNetwork.HTTPというのがあるので、これを使ってみる。 使うためには(1)パッケージをcabal設定ファイルに追加してビルドするときに使えるようにして、(2)プログラムコードの上でimportするというのが必要だ。まずプロジェクトで使っているcabalファイルにHTTPパッケージを追加する。HTTPパッケージをまだインストールしていない場合は

cabal install HTTP

とコンソールで実行しよう。そのあとspller.cabalファイルのbuild-dependsのところに

  build-depends:   base,HTTP

と、カンマ区切りでHTTPを足そう。以降新しいパッケージはcabal installしてspller.cabalに足していこう。

さて、上のリンクを診てもらうとsimpleHTTPというのがあってこれでhttpリクエストが発行出来てレスポンスをゲットできるらしい。simpleHTTPの型は

simpleHTTP :: Request_String -> IO (Result Response_String)

で、このRequestをつくるgetRequestは

getRequest :: String -> Request_String

となる。getRequestにはurlを与えれば良さそうだ。ほしいのは

-- urlの文字列 -> レスポンス
ほしい関数 :: String -> IO (Result (Response ty))

なので、getRequestとsimpleHTTPをつなげれば良さそうだ。普通に書くと

res <- simpleHTTP (getRequest url)

となるのだけど、ちょっと格好を付けて

res <- (simpleHTTP . getRequest) url

としてみる。.を間に入れた(simpleHTTP . getRequest)がポイントで、.は関数を2つ混ぜあわせて合成することができる。つまり simpleHTTPByUrlString = (simpleHTTP . getRequest) :: String -> IO (Result (Response ty))みたいな新しい関数を作っているみたいになる。ちょっと格好いい、らしい。

これを使ってurlの文字列を受け取ってそのウェブページの内容を返す関数fetchUrlを定義してみると

    fetchUrl :: String -> String
    fetchUrl url = do
        response <- (simpleHTTP . getRequest) url
        case response of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return ""
            Right responseOk ->
                return (rspBody responseOk)

となる。さっき作ったsimpleHTTPとgetRequestのあいのこの返り値をresponseに入れているのはわかると思うが、ここでLeftとRightなる見慣れないのが現れた。これはEither型という違う2つの型を返す関数を作るテクニックなのでここでは深入りしない。Either a b 型はLeft a型と Right b型をとりうる。だいたいLeftは何かに失敗したパターンで、Rightは成功したパターンの返り値を割り当てる。responseはEitherを返すのでこのようにcase Either型の変数 ofで分岐してある。

Leftの失敗したパターンは単純にエラーメッセージを出すようにして空の文字列を返そう。hPutStrLnはCでいうput関数みたいなものでstderrにエラーメッセージを出す。

Rightではレスポンスの中身を取り出してそれを返すようにしよう。rspBodyはレスポンスの中身をStringで返してくれる。

Leftの中で使っている$演算子は関数適用演算子と呼ばれるが、主な用途は括弧なしで関数適用の優先順位を作り出すことだそうだ(ホントは遅延評価の難しい話が裏側にあると思う)。例えばfa fb fc dとあると((fa fb) fc) dとなってしまう。dをfc, fb, faの順番で適用したい場合はカッコがたくさん必要だ。でも$演算子を間に挟んでfa $ fb $ fc $ dとするとfa (fb (fc d))となる。Haskellのコードでは頻出なので使いこなすと格好いい気がする。

これを使って実行可能なコードを書いてみよう。ここで巨大なテキストファイルであるリンク先のbig.txtをフェッチすると時間がかかるのでよさげなテキストファイルを適当に探してみる。例えばhttp://textfiles.com/humor/computer.txtとか短くて良さそうだ。

module Main where
    import Text.Printf (printf)
    import Network.HTTP
    import System.IO

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- fetchUrl url
        print respStr
        printf "Completed. Exiting.\n"

    fetchUrl url = do
        response <- (simpleHTTP . getRequest) url
        case response of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return ""
            Right responseOk ->
                return (rspBody responseOk)

これでURLをフェッチしてテキストを読み込むことができるようになった。

テキストを処理するwords関数を実装する

テキストはいまStringに入っているので、String -> リスト型か何かになる関数wordsを定義しよう。

    scan reg target =
        case matchRegexAll reg target of
            Just (_, _, a, xs) -> concat $ xs : [scan reg a]
            Nothing -> []
    wordsFromText textStr = scan (makeRegex "([a-z]+)") $ map toLower textStr

wordsがPrelude.wordsとぶつかるのでwordsFromTextと名前をつけてみた。ここでは正規表現ライブラリText.Regexの助けを借りてscan関数を定義して、それを使って文字列のリストを作っている。

ここでは$を使って大きな文字列であるtextStrを2段階で処理している。

map toLower textStrはCharのリストとしての文字列の一文字ずつにData.Char.toLower関数をあてはめてすべて小文字に変換している。これが第1段階の処理になる。

第2段階の処理はscan関数で、これを正規表現で次々処理する関数を定義した。scan関数は正規表現オブジェクトと文字列を受け取って文字列のリストを返す。正規表現をマッチさせる関数matchRegexAll関数はパッケージのドキュメントによるとMaybe型を返す。Maybe型はJavaとかで言うnullable型でNullか、中身がある返り値かどっちかになるのでcase なんとか ofして中身をパターンマッチで分岐させる。Just xは中身がある場合、Nothingはnullと同じだ。中身はパッケージのドキュメントによれば、

Just ( everything before match,
         portion matched,
         everything after the match,
         subexpression matches )

なので、前2つは無視して再帰的にscanを呼び出すためのeverything after the matchと答えの文字列の一つとなるsubexpression matchesをパターンマッチで変数に割り当て使おう。まず答えとなるsubexpression matchesであるxsを答えとなるリストの頭にcons(:で要素をくっつける)して、scan関数をeverything after the matchに対して再び呼び出そう。

正規表現を使うのでregex-posix,regex-compatの２つのパッケージをcabalファイルに足してText.Regex.Posix (makeRegex)やText.Regex (matchRegexAll) をインポートする必要がある。ついでにtoLowerとかも必要で、全体のコードは以下の感じになるはず。

module Main where
    import Text.Printf (printf)
    import Network.HTTP
    import System.IO
    import Data.Char (toLower)
    import Text.Regex.Posix (makeRegex)
    import Text.Regex (matchRegexAll)

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- fetchUrl url
        printf "Completed.\n"
        print $ wordsFromText respStr

    scan reg target =
        case matchRegexAll reg target of
            Just (_, _, a, xs) -> concat $ xs : [scan reg a]
            Nothing -> []
    wordsFromText textStr = scan (makeRegex "([a-z]+)") $ map toLower textStr

    fetchUrl url = do
        response <- (simpleHTTP . getRequest) url
        case response of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return ""
            Right responseOk ->
                return (rspBody responseOk)

こんな感じかな。なんか動きそうなので、とりあえず次に行こう。

train関数を定義して誤りモデルトレーニングを行う

と、何やら大げさに言ってみたが、前述のとおりtrain関数は単語の出現回数をカウントするだけだ。ここではData.Mapを使う。これは普通の連想配列で、insertWithKeyという便利な関数がある。

Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a

つまり、insertWithKey <結合に使う関数> <新しいキー> <新しい値> <追加するマップ>という呼び方をする。ここでキーは単語、値は回数として、結合に使う関数のところでマップにすでにある回数と新しく足す回数（当然1だ）を足し算する関数とすればよい。結合に使う関数の型は(k -> a -> a ->a)、つまりキーと新しい値と古い値と答えの値という関数だ。これを使ってtrainを書いてみると

    countWords [] = Data.Map.empty
    countWords (x:xs) =
      let s = countWords xs in
          Data.Map.insertWithKey (\k x y ->x + y)  x 1 s
    train features = countWords features

割りとコンパクトだ。一度コンパイルして結果を見てみよう。結果は

Completed.
fromList [("a",38),("ab",1),("abacus",1),("about",5),("absurd",1),("act",1),...,("you",33),("your",33)]

となった。ここですでに見えているのはyouとyourはこの文章では登場回数が同じだった。youtと打ち込んだ時にyouと打ちたかったのだろうか？それともyourと打ちたかったのだろうか？これを次回は考えることになるだろう。またabacusみたいな単語は頻出しないというのも直感と一致する。いい感じだ。

今日のまとめ

盛りだくさんになってしまったのでここまでにしてみよう。今日完成したプログラムは

module Main where
    import Text.Printf (printf)
    import Network.HTTP
    import System.IO
    import Data.Char (toLower)
    import Data.Map (insertWithKey, empty)
    import Text.Regex.Posix (makeRegex)
    import Text.Regex (matchRegexAll)

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- fetchUrl url
        printf "Completed.\n"
        print $ train $ wordsFromText respStr

    scan reg target =
        case matchRegexAll reg target of
            Just (_, _, a, xs) -> concat $ xs : [scan reg a]
            Nothing -> []
    wordsFromText textStr = scan (makeRegex "([a-z]+)") $ map toLower textStr

    countWords [] = Data.Map.empty
    countWords (x:xs) =
      let s = countWords xs in
          Data.Map.insertWithKey (\k x y ->x + y)  x 1 s
    train features = countWords features

    fetchUrl url = do
        response <- (simpleHTTP . getRequest) url
        case response of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return ""
            Right responseOk ->
                return (rspBody responseOk)

だ。cabalファイルは

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

executable spller
  main-is:         Main.hs
  hs-source-dirs:  src
  build-depends:   base,HTTP,regex-posix,regex-compat,containers

みたいになった、はず。

次回はスペル修正の前にやっておかなくてはいけないもろもろの問題を片付けよう。