时间戳

首页 > 解决方案 > 尝试用矩阵编写 Levenshtein 度量的实现

haskell - 尝试用矩阵编写 Levenshtein 度量的实现

问题描述

以下是迄今为止我在实现 Левенште́йн 时使用“矩阵记忆”共同破解的内容。我现在正在尝试将 Haskell 用于几乎所有事情，以便我真正学习它。我还没有真正掌握的概念包括单子转换器、状态单子（正在研究它）和镜头。

import Data.Matrix
import Control.Monad.State
import Control.Applicative


type RecState = Int

-- Set up the first row
setLeftCol :: String -> Matrix Int -> Maybe (Matrix Int)
setLeftCol str mat = let strLength = length str + 1
                     in foldr helper (Just mat) [1..strLength]
  where
    helper :: Int -> Maybe (Matrix Int) -> Maybe (Matrix Int)
    helper value matrixMon = (\m -> safeSet (value-1) (value,1) m) =<< matrixMon

-- Encapsulate a transposition in a Maybe context
transposeM :: Matrix a -> Maybe (Matrix a)
transposeM mat = Just (transpose mat)

-- Set up the first column
setTopRow  :: String -> Matrix Int -> Maybe (Matrix Int)
setTopRow str mat = let mat' = return mat
                    in mat' >>= transposeM >>= (setLeftCol str) >>= transposeM

-- Generate coordinates
coords :: Int -> Int -> [(Int,Int)]
coords width height = [(x,y) | x <- [1..(width+1)], y <- [1..(height+1)]]

safeFst :: Maybe (Int,Int) -> Maybe Int
safeFst tuple = case tuple of
                  Just (x,y) -> Just x
                  Nothing    -> Nothing

safeSnd :: Maybe (Int,Int) -> Maybe Int
safeSnd tuple = case tuple of
                  Just (x,y) -> Just y
                  Nothing    -> Nothing

distance :: Matrix Int -> State RecState (Matrix Int)
distance matrix = do
  index <- get
  let coordinate = coordinates !! index
      i = fst coordinate
      j = snd coordinate
  if index == size then
    put matrix
    return $ getElem i j matrix
  else do
    put (index + 1)
    let ch1 = w1 !! (i - 1)
        ch2 = w2 !! (j - 1)
        cost = if ch1 /= ch2 then 1 else 0
        entry1 = (getElem (i - 1) j matrix) + 1
        entry2 = (getElem i (j - 1) matrix) + 1
        entry3 = (getElem (i - 1) (j - 1) matrix) + cost
    return $ distance $ setElem (minimum [entry1,entry2,entry3]) coordinate matrix


-- Compute the Levenshtein distance on two strings.
levenshtein :: String -> String -> Int
levenshtein "" "" = 0
levenshtein "" w2 = length w2
levenshtein w1 "" = length w1
levenshtein w1 w2 = let lenW1 = length w1
                        lenW2 = length w2
                        size = lenW1 * lenW2
                        matrix = Just $ zero (lenW1 + 1) (lenW2 + 1)
                        matrix' = matrix >>= setLeftCol w1 >>= setTopRow w2
                        coordinates = coords lenW1 lenW2
                    in execState (distance <$> matrix') (lenW1 + 2)

showResults :: Show r => r -> IO ()
showResults = putStrLn . show

showLevenshtein :: String -> String -> IO ()
showLevenshtein = showResults . levenshtein

我的第一个问题是如何组织distance函数levenshtein？我首先将它放在以 .where开头的行之后的一个子句中in execState...。但是，我发现在这个函数中既size不能访问也不能访问，因为它们是在.coordinatesletlevenshtein

也可以随意评论我在这里尝试过的任何其他想法。

标签： haskell

解决方案

在 Haskell 中有一个解决动态规划问题的公式。

  1. 用递归公式写出解决方案
  2. 通过重写函数来抽象递归调用，a -> b就像(a -> b) -> (a -> b)没有递归调用一样。
  3. 通过内存中的某个点将递归调用重定向到 memoization - let 绑定、列表、数组、memotrie 等。

对于 levenshtien 距离，阵列是合适的。

递归公式

首先根据自身递归编写 levenshtien 距离公式

lev :: Eq a => [a] -> [a] -> (Int, Int) -> Int
lev a b (0, 0) = 0
lev a b (0, j) = j
lev a b (i, 0) = i
lev a b (i, j) = (lev a b (i-1, j) + 1) `min` (lev a b (i, j-1) + 1) `min` (lev a b (i-1, j-1) + if a !! (i - 1) == b !! (j - 1) then 0 else 1)

两个字符串的 levenshtien 距离是一直计算到最后一个字符的距离

levenshtien :: Eq a => [a] -> [a] -> Int
levenshtien a b = lev a b upperBound
  where
    upperBound = (length a, length b)

递归调用的抽象

然后将递归调用替换为对其他函数的调用，该函数f以某种方式实现其余的 levenshtien 距离。

lev' :: Eq a => [a] -> [a] -> ((Int, Int) -> Int) -> (Int, Int) -> Int
lev' a b f (0, 0) = 0
lev' a b f (0, j) = j
lev' a b f (i, 0) = i
lev' a b f (i, j) = (f (i-1, j) + 1) `min` (f (i, j-1) + 1) `min` (f (i-1, j-1) + if a !! (i - 1) == b !! (j - 1) then 0 else 1)

您可以使用恢复lev，其定义为lev'fixfix f = let x = f x in x

import Data.Function

lev :: Eq a => [a] -> [a] -> (Int, Int) -> Int
lev a b = fix (lev' a b)

通过数组进行记忆

最后，您需要一种将中间结果存储在数组中的方法。我发现以下方法比Data.Array中的函数更容易构建数组。

import Data.Array

buildArray :: Ix i => (i, i) -> (i -> e) -> Array i e
buildArray bounds f = listArray bounds (f <$> range bounds)

我们可以通过构建一个包含一些结果的数组来记忆数组中的函数，如果参数在数组中，则使用数组中存储的值，如果不是，则使用原始函数。

memoArray :: Ix i => (i, i) -> (i -> e) -> (i -> e)
memoArray bounds f = \i -> if inRange bounds i then arr ! i else f i
  where
    arr = buildArray bounds f

我们可以通过修复包含一些值的函数来修复一个函数，并将其一些值存储在一个数组中。

fixArray :: Ix i => (i, i) -> ((i -> e) -> i -> e) -> (i -> e)
fixArray bounds f = fix (memoArray bounds . f)

把它们放在一起

lev'最后，我们可以用and来重写 levenshtien fixArray，记住所有将在此过程中重复使用的重要位。

levenshtien :: Eq a => [a] -> [a] -> Int
levenshtien a b = fixArray ((1, 1), upperBound) (lev' a b) upperBound
  where
    upperBound = (length a, length b)

进一步改进

  • !!通过用数组替换列表来摆脱二次列表访问
  • 通过严格折叠一维数组来摆脱二次内存使用

推荐阅读