Hatena::Grouphaskell

wanparkの日記

 | 

2007-11-28

Haskellプログラミング(6) 文字列間の距離-モナドを使って-

http://www.ipsj.or.jp/07editj/promenade/4609.pdf

レーベンシュタイン距離を計算する。

data Operator = Insert Char
              | Delete
              | Substitute Char
              | Ident
                deriving Eq

align :: String -> String -> [Operator]
align [] []     = []
align (x:xs) [] = Delete   : align xs []
align [] (x:xs) = Insert x : align [] xs
align xxs@(x:xs) yys@(y:ys) = if x == y
                              then Ident : align xs ys
                              else shortest [Delete       : align xs yys,
                                             Insert y     : align xxs ys,
                                             Substitute y : align xs ys]
shortest = snd . foldl1 (\ a b -> if fst a > fst b then b else a) . map (\a -> (length $ filter (/= Ident) a, a))


showAlignment :: String -> String -> String
showAlignment from to = unlines ["Levenshtein distance: " ++ show (distance operators),
                                 showSkipWord isInsert from operators,
                                 showHomology operators,
                                 showSkipWord (== Delete) to operators]
    where
      operators = align from to
      distance = length . filter (/= Ident)
      isInsert (Insert _) = True
      isInsert _ = False
      showSkipWord :: (Operator -> Bool) -> String -> [Operator] -> String
      showSkipWord _ []  _ = ""
      showSkipWord _ cs [] = cs
      showSkipWord skip ccs@(c:cs) (op:ops) = if skip op
                                              then ' ' : showSkipWord skip ccs ops
                                              else c   : showSkipWord skip cs  ops
      showHomology = map (\op -> if op == Ident then '|' else ' ')
*Main> putStr $ showAlignment "kitten" "sitting"
Levenshtein distance: 3
kitten
 ||| |
sitting

DNA の alignment っぽく表示してみました。単に距離を求めるだけなら

distance :: String -> String -> Int
distance [] xs = length xs
distance xs [] = length xs
distance xxs@(x:xs) yys@(y:ys) = if x == y
                                 then distance xs ys
                                 else 1 + minimum [distance xs ys,
                                                   distance xxs ys,
                                                   distance xs yys]

Page not found · GitHub Pages の Memo モジュールを使ってメモ化する。ghc6.6 の場合、-fglasgow-exts オプションをつけないといけないみたいです。

import Memo
import Monad

data Ord a => ListTable a b  = ListTable [(a, b)]

instance Table ListTable where
    emptyTable = ListTable []
    lookupTable key (ListTable []) = Nothing
    lookupTable key tbl@(ListTable ((k, v):rest)) | key >  k  = Nothing
                                                  | key == k  = Just v
                                                  | otherwise = lookupTable key (ListTable rest)
    insertTable k v (ListTable list) = case break ((k >) . fst) list of
                                         (xs, ys) -> ListTable (xs ++ (k, v):ys)


mdistance :: Memo ListTable (String, String) Int
mdistance ([],   to) = return $ length to
mdistance (from, []) = return $ length from
mdistance (from, to) = memoise (\ (xxs@(x:xs), yys@(y:ys)) ->
                                    if x == y
                                    then mdistance (xs, ys)
                                    else 1 + liftM minimum (sequence [mdistance (xs,  ys),
                                                                      mdistance (xxs, ys),
                                                                      mdistance (xs,  yys)])) (from, to)

evalMdistance ::String -> String -> Int
evalMdistance from to = evalMemo mdistance (from, to)

"mdistance ([], to) = return $ length to" の return はいらないと思うんだけど、ないとエラーになる。暗黙の型変換を理解してない。

記事を読んだ。

先頭の文字が一致している時の挙動

その場合無条件に変換なしとしても最小距離は変わらない、と思ったんだけど、違うのかな。いや違くないよな。

Data.Map

lookup が O(n) から O(log n) になる。普通の配列でやれば O(1) だけど、と最後に言ってる

表示のやり方

なるほどーうまいねー

結局

前回の連載「記憶する関数」は理解されないこと前提だったのですか

nobsunnobsun2007/11/28 23:48Haskell には暗黙の型変換はありません。
length to の型は Int です。mdistance の型は Memo ListTable (String,String) Int
すなわち (String,String) -> State (ListTable (String,String) Int ですので、
return なしでは型があいません。

wanparkwanpark2007/11/29 03:19ありがとうございます。暗黙の型変換はそもそもないんですか。数値リテラルと型変換を混同していたようです。

 |