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

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

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

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

となる。これで一般部については2次元配列を気にしなくて良くなった。ただし問題がある。いちばん上の行(第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

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

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

OK。