文字列間のレーベンシュタイン距離を求める(3)Haskell版ふたたび

去年の12月に２つの文字列のレーベンシュタイン距離を求めるっていうのを、JavaScript と Haskell でやった。もともとは Python での実装を参考に２次元配列を使ってやってみたもので、JavaScript版はともかく Haskell版は２次元配列の更新に苦労した。
それが、今日ふと１次元配列でやってみたらどうだろうと思いついた。
つまりこうだ。(m + 1)行×(n + 1)列（m、n は比較する文字列２つの長さ）の各行をつなげた１次元配列を考えて、２次元配列の時の座標を表すタプル (i, j) で初期化しておく。0 < i, 0 < j のとき、(i, j) の値はひとつ左(i-1, j)、ひとつ上（i, j-1)、左上(i-1, j-1)から決まるから、これを１次元配列のインデックスに直すと次のようになる：

• ひとつ左： i * (n + 1) + j – 1
• ひとつ上： (i – 1) * (n + 1) + j
• 左上： (i – 1) * (n + 1) + j – 1

これをコードに落としこんでやるとこうなった：

module Main where

import System.Environment (getArgs)

levenshteinDistance :: String -> String -> Int
levenshteinDistance s1 s2 = last ld
  where
    ld = map f [(x, y) | x <- [0..m], y <- [0..n]]
    m = length s1
    n = length s2
    f (0, 0) = 0
    f (i, 0) = i
    f (0, j) = j
    f (i, j) = minimum [a, b, c]
      where
        a = ld !! (i * (n + 1) + j - 1) + 1
        b = ld !! ((i - 1) * (n + 1) + j) + 1
        c = ld !! ((i - 1) * (n + 1) + j - 1) + c'
        c' = if s1 !! (i - 1) == s2 !! (j - 1) then
          0
        else
          1

main :: IO ()
main = do
  args <- getArgs
  let s1 = args !! 0
  let s2 = args !! 1
  print $ levenshteinDistance s1 s2

結果はこうだ。

takatoh@apostrophe $ runhaskell ld2.hs apple play
4
takatoh@apostrophe $ runhaskell ld2.hs perl pearl
1

OK、うまくいった。

だけど、上のコードはまだ２次元配列の意識を引きずっている。もっと単純にできるはずだ。１次元配列のインデックスを x とすると：

• ひとつ左： x – 1
• ひとつ上： x – (n + 1)
• 左上： x – (n + 1) – 1

となる。これで一般部については２次元配列を気にしなくて良くなった。ただし問題がある。いちばん上の行（第0行）といちばん左の列（第0列）だ。少し考えて、x を (n + 1) で割った商と余りを使えばいいと気がついた。コードにするとこう：

module Main where

import System.Environment (getArgs)

levenshteinDistance :: String -> String -> Int
levenshteinDistance s1 s2 = last ld
  where
    ld = map f [0..((m + 1) * (n + 1) -1)]
    m = length s1
    n = length s2
    f x | x < n + 1                       = x
        | x `rem` (n + 1) == 0 = x `div` (n + 1)
        | otherwise                       = minimum [a, b, c]
    where
      a = ld !! (x - 1) + 1
      b = ld !! (x - (n + 1)) + 1
      c = ld !! (x - (n + 1) - 1) + c'
      c' = if s1 !! i == s2 !! j then
        0
      else
        1
      i = x `div` (n + 1) - 1
      j = x `rem` (n + 1) - 1

main :: IO ()
main = do
  args <- getArgs
  let s1 = args !! 0
  let s2 = args !! 1
  print $ levenshteinDistance s1 s2

１行だけだけど長くなってしまった。だけど考え方はシンプルのように思う。実行してみよう。

takatoh@apostrophe $ runhaskell ld3.hs apple play
4
takatoh@apostrophe $ runhaskell ld3.hs perl pearl
1

OK。