euphonictechnologies’s diary

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

follow us in feedly

Haskellで作ったものすごく簡単なスペル修正プログラムを評価してみる - その4:修正用コーパスを読み込んで精度を確認する - Haskellの数値型と型クラスについて考える

前回はfor-eachで修正用コーパスの単語をひとつひとつテストすることができるようになった。 次は修正用コーパス全体に対して修正率を算出して表示できるようにする。

assertLT/assertGTをつくる

HUnitにはどうも「aがbより小さい」みたいなAssertionがないので自分で作ってみたい。 assertEqualを参考に作ってみようと思うのでまずはassertEqualが同実装されているか見てみる。Hackageのソースボタンでソースに飛ぶことができる。HUnitのHackageはここ。で、ソースを見てみると:

-- | Asserts that the specified actual value is equal to the expected value.
-- The output message will contain the prefix, the expected value, and the 
-- actual value.
--  
-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted
-- and only the expected and actual values are output.
assertEqual :: (Eq a, Show a) => String -- ^ The message prefix 
                              -> a      -- ^ The expected value 
                              -> a      -- ^ The actual value
                              -> Assertion
assertEqual preface expected actual =
  unless (actual == expected) (assertFailure msg)
 where msg = (if null preface then "" else preface ++ "\n") ++
             "expected: " ++ show expected ++ "\n but got: " ++ show actual

ということみたいだ。私がいまから作りたいのは"<"とか">"がやりたいので、関数の型は上で言うEq aの部分がOrd aになってこんなかんじになるはず。

assertLT :: (Ord a, Show a) => String -> a -> a -> Assertion

で、中身は殆ど上の (actual == expected)の部分を比較に変えるだけで作れるはず。やってみると

    assertLT :: (Ord a, Show a) => String -> a -> a -> Assertion
    assertLT preface expected actual =
        unless (actual < expected) (assertFailure msg)
        where msg = (if null preface then "" else preface ++ "\n") ++
                    "expected: " ++ show expected ++ "\n but got: " ++ show actual

と、単純な置換えだけで作ることができた。assertGTも同じように作れるはずだ。

修正用コーパス全体に修正をかけるコードを書く

実際にリストに修正を施して修正率を算出するコードは以下のようになるはずだ。

    spellTestOne :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> IO Assertion
    spellTestOne corpus trained = do
        let (ratio, nPassed, nTotal, correctedList) = (processList corpus trained)
        printf "NWords %d, Good %d, Bad %d, Pct %f\n" nTotal nPassed (nTotal - nPassed) ratio
        return $ assertGT "" 0.7 ratio

なので、processList関数を実装する。これはそれほど難しくない。リストとトレーニングデータを渡すとletの左辺にあるような修正に関するデータをタプルで渡してくれる。

    correctAndMark :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> [(Int, (Text.Text, Text.Text))]
    correctAndMark corpus trained = List.map (\x -> (if fst (x) == correctHelper (x) trained then 1 else 0, x)) corpus

    totalPasses :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> (Int, [(Int, (Text.Text, Text.Text))])
    totalPasses corpus trained =
        let correctedList = (correctAndMark corpus trained) in
            let correctedMarks = List.map fst correctedList in
                (List.foldl (+) 0 correctedMarks, correctedList)

    processList :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> (Double, Int, Int, [(Int, (Text.Text, Text.Text))])
    processList corpus trained =
        let (nPassed, correctedList) = totalPasses corpus trained in
        ((fromIntegral $ nPassed ) / (fromIntegral $ List.length corpus), nPassed, List.length corpus, correctedList)

processList -> totalPasses -> correctAndMarkというように依存関係がある。 processListはtotalPassesで実際に修正を施している。totalPassesは修正成功数と修正後のリストを渡してくれる。 totalPassesはcorrectAndMarkをすべての修正コーパスにそれぞれ施していく。correctAndMarkは修正が成功したら1で、失敗したら0を埋めていく。この1の数を修正成功トータル数として報告すればよい。

リスト全体の修正コーパス数と成功数がわかれば割り算で修正率が出せる、簡単だね。簡単かな? ここで私ははたと「Haskellの数値型について全然知らない」事に気づいた。つまり、

Prelude> let a = 100 :: Int
Prelude> let b = 10 :: Int
Prelude> a / b

<interactive>:6:3:
    No instance for (Fractional Int) arising from a use of `/'
    Possible fix: add an instance declaration for (Fractional Int)
    In the expression: a / b
    In an equation for `it': it = a / b

Int型には"/"演算子が定義されていないというのだ。

Haskellの数値と型クラス

Intの定義をHackageで確認してみる:Data.Int。すると、以下のようにクラスを継承していることがわかる:

f:id:euphonictechnologies:20140826184455p:plain

例えばShowを継承しているのでprintが簡単にできる。ここで気にしなくちゃいけないのは

Bounded Int
Enum Int
Eq Int
Integral Int
Num Int
Ord Int
Real Int

のあたりだろう。つまり、数値に関する型クラスだ。

型クラスって?

型クラスっていうのは上で定義したassertLTでいうと

assertLT :: (Ord a, Show a) => String -> a -> a -> Assertion

(Ord a, Show a)の部分だ。この部分で私は「比較ができない引数はいやだ。でもってShowができないとassertionのメッセージが出せないからShowも欲しい」ということを主張している。この2つの型クラスをサポートしている限りコンパイルできる。これはJavaでも一緒だ。特定のインターフェースを備えたクラスの値以外は引数に取らない、ということができるのと一緒。 それでいうと

  • IntはBoundedで最小値と最大値が存在する。
  • EnumはfromEnumとtoEnumで整数に一対一対応のマッピングができるクラスにつける。当然Intは整数に一対一対応できるのでEnumを継承するのが良い
  • Eqは何度も出てきたけど等値比較ができるもの。整数ならもちろん出来る。
  • Integralは整数の割り算ができる型クラス。もちろん我々がほしいのはこれだ!
  • Numは数値の型クラスの親玉。
  • Ordは順序集合の型。全順序集合じゃないといけないのでa, b, cがあった時にa < bかつb < cのときa < cにならないと壊れている。
  • RealはRational,つまりRatio型のある意味ラッパになっている型クラス。割り算、つまり2つのインスタンスの間に比率が定義されているような型を生み出す。

ここで、注目したいのはNumとReal,Integralだ。Intはこれらの型クラスを階層的に継承している。

  • Num : Eq a / Show a
    • Real : Ord a
    • Fractional
      • Floating

といった感じになっている。Num自体はEqしかサポートしていない。複素数なんかはOrdにならないのでOrdがついていないのだろう。 Realは実数なのでOrdがサポートされている。さらにIntegralはEnumを付加した数になっている。Integralの代表的なインスタンスはIntegerやIntだ。

で、さっきの問題に戻る。IntとIntで割り算して小数点で答えがほしい。答えはfromIntegralだ。fromIntegralは

fromIntegral :: (Integral a, Num b) => a -> b
fromIntegral = fromInteger . toInteger

で、fromIntegerでInteger -> NumにしてtoIntegerでNum -> Integerにしてくれる。ここでNumはNumでもFractional(小数点なので)と考えるとうまくいくはず。

relude> let a = 100 :: Int
Prelude> let b = 10 :: Int
Prelude> (fromIntegral a) / (fromIntegral b)
10.0
Prelude> :t (fromIntegral a) / (fromIntegral b)
(fromIntegral a) / (fromIntegral b) :: Fractional a => a

ということでうまくいっている、ので上の割り算部分でわざわざfromIntegralでトータルのコーパス数と成功数を変換した後割り算している。

今回のまとめ

出来上がったテストは以下の様な感じ:

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/yoshinori/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
        testAssertion <- (spellTestOne corpus trained)
        defaultMain $ hUnitTestToTests $ TestList
            [
                TestLabel "spellTest1" $ TestCase testAssertion
            ]

    assertLT :: (Ord a, Show a) => String -> a -> a -> Assertion
    assertLT preface expected actual =
        unless (actual < expected) (assertFailure msg)
        where msg = (if null preface then "" else preface ++ "\n") ++
                    "expected: " ++ show expected ++ "\n but got: " ++ show actual

    assertGT :: (Ord a, Show a) => String -> a -> a -> Assertion
    assertGT preface expected actual =
        unless (expected < actual) (assertFailure msg)
        where msg = (if null preface then "" else preface ++ "\n") ++
                    "expected: " ++ show expected ++ "\n but got: " ++ show actual

    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))

    correctAndMark :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> [(Int, (Text.Text, Text.Text))]
    correctAndMark corpus trained = List.map (\x -> (if fst (x) == correctHelper (x) trained then 1 else 0, x)) corpus

    totalPasses :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> (Int, [(Int, (Text.Text, Text.Text))])
    totalPasses corpus trained =
        let correctedList = (correctAndMark corpus trained) in
            let correctedMarks = List.map fst correctedList in
                (List.foldl (+) 0 correctedMarks, correctedList)

    processList :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> (Double, Int, Int, [(Int, (Text.Text, Text.Text))])
    processList corpus trained =
        let (nPassed, correctedList) = totalPasses corpus trained in
        ((fromIntegral $ nPassed ) / (fromIntegral $ List.length corpus), nPassed, List.length corpus, correctedList)

    spellTestOne :: [(Text.Text, Text.Text)] -> Map.Map Text.Text Int -> IO Assertion
    spellTestOne corpus trained = do
        let (ratio, nPassed, nTotal, correctedList) = (processList corpus trained)
        printf "NWords %d, Good %d, Bad %d, Pct %f\n" nTotal nPassed (nTotal - nPassed) ratio
        return $ assertGT "" 0.7 ratio

前回のfor-eachのテストは省いてある。もちろん足してあっても構わない。

今回は型クラスと数値型について考えてみた。昔のJavaのCollectionみたいに階層がやたら学術的にというかきっちりしていることがわかる。 今回は目的のためだけに必要な部分しか触れていないけれど、完全なチュートリアルが以下にある:

A Gentle Introduction to Haskell: Numbers

さらに以下が型クラスや数値型について良い情報源となると思う:

Haskell の数値 – Int は型で、Num は型クラス | すぐに忘れる脳みそのためのメモ

Haskell の代数的データ型と型クラス、instance 宣言の関係 | すぐに忘れる脳みそのためのメモ

A Gentle Introduction to Haskell: Standard Classes

次回予告

次はこのスペル修正プログラムをWebサーバにデプロイしてウェブアプリからスペル修正ができるように改造していくことでWarpやYesodみたいなHaskellのウェブスタックを勉強していこう。