HaskellでDynamic Programmingそのいち

http://nais.to/~yto/clog/2007-01-22-4.htmlを見ながら、Haskellでスコアテーブルを作成するところまで実装してみました。mkDPTableのcのあたりは定義そのままです。というかPerlのプログラムを読むよりも定義見て実装した方が楽だったんじゃ。それにしてもさすがHaskellです。
検索はまだ実装してないので、またそのうち。

module Main (main) where

import Data.Array (listArray, Array, assocs)
import Text.Printf (printf)

{-
  P[i]はパターン（キーワード）、T[j]は検索・マッチ対象のテキスト。

  C[0, j] = 0
  C[i, 0] = i
  C[i, j] = if (P[i] = T[j])
              then C[i - 1, j - 1]
              else 1 + min(C[i - 1, j], C[i, j - 1], C[i - 1, j - 1])	        
-}

mkDPTable :: String -> String -> Array (Int, Int) Int
mkDPTable key s = listArray ((0, 0), (length key, length s)) table
  where
    table = do
      i <- [0 .. length key]
      j <- [0 .. length s]
      return $ c i j

    c 0 j = 0
    c i 0 = i
    c i j
      | key !! i' == s !! j' = d
      | otherwise            = 1 + (minimum [u, l, d])
      where
        i' = i - 1
        j' = j - 1
        u  = c i' j
        l  = c i  j'
        d  = c i' j'

showDPTable :: String -> String -> Array (Int, Int) Int -> String
showDPTable key s table = header ++ (concatMap f $ assocs $ table)
  where
    header = "      " ++ concatMap (printf "   %c") s ++ "\n"

    f ((i, j), c)
      | j == 0        = h ++ g c
      | j == length s = g c ++ "\n"
      | otherwise     = g c
      where
        g = printf " %-3d"
        h = printf " %c  " $ (' ' : key) !! i

main :: IO ()
main = do
  let key = "survey"
      s   = "foosurgerybar"
  putStr $ showDPTable key s $ mkDPTable key s

{-
 =>
         f   o   o   s   u   r   g   e   r   y   b   a   r
     0   0   0   0   0   0   0   0   0   0   0   0   0   0
 s   1   1   1   1   0   1   1   1   1   1   1   1   1   1
 u   2   2   2   2   1   0   1   2   2   2   2   2   2   2
 r   3   3   3   3   2   1   0   1   2   2   3   3   3   2
 v   4   4   4   4   3   2   1   1   2   3   3   4   4   3
 e   5   5   5   5   4   3   2   2   1   2   3   4   5   4
 y   6   6   6   6   5   4   3   3   2   2   2   3   4   5
-}