代码之家  ›  专栏  ›  技术社区  ›  bjd2385

尝试用矩阵编写Levenshtein度量的一个实现

  •  4
  • bjd2385  · 技术社区  · 6 年前

    下面是到目前为止我在实现中使用“矩阵内存”所做的黑客工作。我现在正试图把哈斯克尔用在几乎所有的事情上,这样我才能真正学会它。我还没有真正理解的概念包括Monad Transformers、StateMonad(致力于此)和Lens。

    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 也不 coordinates 可在此函数中访问,正如在原始函数中定义的那样 let 声明 列文斯坦

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

    1 回复  |  直到 6 年前
        1
  •  7
  •   Cirdec    6 年前

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

    1. 用递归公式编写解决方案
    2. 通过重写函数对递归调用进行抽象 a -> b 作为 (a -> b) -> (a -> b) 没有递归调用。
    3. 通过内存中的某个点(let绑定、列表、数组、memotrie等)将递归调用重定向到memoization。

    对于水平距离,阵列是合适的。

    递归公式

    首先根据自身递归地编写水平距离公式

    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 :: Eq a => [a] -> [a] -> Int
    levenshtien a b = lev a b upperBound
      where
        upperBound = (length a, length b)
    

    递归调用上的Abstact

    然后替换对其他函数调用的递归调用 f 以某种方式实现了水平距离的其余部分。

    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' 通过使用 fix ,定义为 fix 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)
    

    把它们放在一起

    最后我们可以根据 列夫 fixArray ,记住一路上要重复使用的所有重要位。

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

    进一步改进

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