针对InterviewStreet字符串相似度挑战的Haskell解决方案

时间:2012-09-01 21:18:36

标签: string algorithm haskell

这是解决InterviewStreet String Similarity挑战的最佳尝试。

import Control.Monad
import Data.Text as T
import qualified Data.Text.IO as TIO


sumSimilarities s = (T.length s) + (sum $ Prelude.map (similarity s) (Prelude.tail $ tails s))

similarity :: Text -> Text -> Int
similarity a b = case commonPrefixes a b of
                     Just (x,_,_) -> T.length x
                     Nothing -> 0

main = do
    cases <- fmap read getLine
    inputs <- replicateM cases TIO.getLine
    forM_ inputs $ print . sumSimilarities

它只通过了7/10的测试用例。测试用例7,8和9失败,因为它们超过了分配的执行时间。

我正在尝试验证这确实可以在Haskell中解决,并且一半寻找优化的Haskell程序的样子。

谢谢!    泰勒

1 个答案:

答案 0 :(得分:5)

user5402一样,我很好奇是否等效(对于某些等效值)C程序会在时限内完成,还是超时。如果愿意的话,看看使用ByteString的等效程序是否能够及时完成将会很有趣。 - 并非ByteString本身比Text更快,但由于输入必须转换为Text的内部表示,而ByteString将其视为原样,因此做出改变。 ByteString可能更快的另一个可能原因 - 如果测试机器具有32位GHC - 将text的融合至少用于需要比32位架构上通常可用的寄存器更多的寄存器获得全部利润[很久以前,在text-0.5到text-0.7的日子里,在我的32位盒子上,bytestring曾经相当快一点,不知道是否仍适用于较新的{ {3}}版本]。

好的,既然text已经验证了天真的算法在C语言中足够快,我已经继续使用ByteString s编写了一个天真算法的实现

{-# LANGUAGE BangPatterns #-}
module Main (main) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as U
import Control.Monad
import Data.Word

main :: IO ()
main = do
    cl <- C.getLine
    case C.readInt cl of
      Just (cases,_) -> replicateM_ cases (C.getLine >>= print . similarity)
      Nothing -> return ()

-- Just to keep the condition readable.
(?) :: B.ByteString -> Int -> Word8
(?) = U.unsafeIndex

similarity :: B.ByteString -> Int
similarity bs
    | len == 0  = 0
    | otherwise = go len 1
      where
        !len = B.length bs
        go !acc i
            | i < len   = go (acc + prf 0 i) (i+1)
            | otherwise = acc
        prf !k j
            | j < len && bs ? k == bs ? j   = prf (k+1) (j+1)
            | otherwise = k

并在一些不良案例中将其与OP的Text版本进行了比较。在我的盒子上,这比Text版本快四倍以上,所以有趣的是它是否足够快(C版本是另一个快4.5倍,所以它可能不是)。

但是,我认为由于使用具有二次最坏情况行为的天真算法,更有可能超出时间限制。可能有一些测试用例会引发天真算法的最坏情况。

因此,解决方案是使用可以更好地,最佳地线性扩展的算法。计算字符串相似性的一种线性算法是user5402

这个想法很简单(但是,像大多数好主意一样,不容易)。让我们调用一个(非空)子字符串,它也是字符串前缀substring的前缀。为避免重新计算,该算法使用prefix-substring的窗口,该窗口在当前被考虑的索引之前开始,该索引向右延伸最远(最初,窗口为空)。

使用的变量和算法的不变量:

  • i,正在考虑的索引从1开始(对于从0开始的索引;不考虑整个字符串)并且递增到length - 1
  • leftright,prefix-substring窗口的第一个和最后一个索引;不变量:
    1. left < ileft <= right < length(S)left > 0right < 1
    2. 如果left > 0,则S[left .. right]SS[left .. ]的最大公共前缀,
    3. 如果1 <= j < iS[j .. k]S的前缀,那么k <= right
  • 数组Z,不变量:对于1 <= k < iZ[k]包含最长公共前缀S[k .. ]S的长度。

算法:

  1. 设置i = 1left = right = 0(允许使用left <= right < 1的任何值),并为所有索引Z[j] = 0设置1 <= j < length(S)
  2. 如果i == length(S),请停止。
  3. 如果i > right,找到lS最长公共前缀的长度S[i .. ],请将其存储在Z[i]中。如果l > 0我们发现窗口比前一个更向右延伸,则设置left = iright = i+l-1,否则保持不变。增加i并转到2.
  4. 此处left < i <= right,因此子字符串S[i .. right]已知 - 因为S[left .. right]S的前缀,所以它等于S[i-left .. right-left]

    现在考虑S的最长公共前缀,其子字符串从索引i - left开始。 其长度为Z[i-left]S[k] = S[i-left + k]0 <= k < Z[i-left]S[Z[i-left]] ≠ S[i-left+Z[i-left]] Z[i-left] <= right-i。现在,如果i + Z[i-left],则S[i + Z[i-left]] = S[i-left + Z[i-left]] ≠ S[Z[i-left]] S[i + k] = S[i-left + k] = S[k] for 0 <= k < Z[i-left] 位于已知窗口内,因此

    S

    我们发现S[i .. ]Z[i-left]的最长公共前缀的长度为Z[i] = Z[i-left]。 然后设置i,增加S[i .. right],然后转到2.

    否则,Sright+1的前缀,我们检查它的扩展距离,开始比较索引right+1 - il处的字符。设长度为Z[i] = l。设置left = iright = i + l - 1i,增加ByteString,然后转到2.

  5. 由于窗口从不向左移动,并且比较总是在窗口结束后开始,因此字符串中的每个字符最多成功一次与字符串中的较早字符进行比较,并且对于每个起始索引,都存在大多数不成功的比较,因此算法是线性的。

    代码(使用Text出于习惯,应该可以轻松移植到{-# LANGUAGE BangPatterns #-} module Main (main) where import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Unsafe as U import Data.Array.ST import Data.Array.Base import Control.Monad.ST import Control.Monad import Data.Word main :: IO () main = do cl <- C.getLine case C.readInt cl of Just (cases,_) -> replicateM_ cases (C.getLine >>= print . similarity) Nothing -> return () -- Just to keep the condition readable. (?) :: B.ByteString -> Int -> Word8 (?) = U.unsafeIndex -- Calculate the similarity of a string using the Z-algorithm similarity :: B.ByteString -> Int similarity bs | len == 0 = 0 | otherwise = runST getSim where !len = B.length bs getSim = do za <- newArray (0,len-1) 0 :: ST s (STUArray s Int Int) -- The common prefix of the string with itself is entire string. unsafeWrite za 0 len let -- Find the length of the common prefix. go !k j | j < len && (bs ? j == bs ? k) = go (k+1) (j+1) | otherwise = return k -- The window with indices in [left .. right] is the prefix-substring -- starting before i that extends farthest. loop !left !right i | i >= len = count 0 0 -- when done, sum | i > right = do -- We're outside the window, simply -- find the length of the common prefix -- and store it in the Z-array. w <- go 0 i unsafeWrite za i w if w > 0 -- We got a non-empty common prefix and a new window. then loop i (i+w-1) (i+1) -- No new window, same procedure at next index. else loop left right (i+1) | otherwise = do -- We're inside the window, so the substring starting at -- (i - left) has a common prefix with the substring -- starting at i of length at least (right - i + 1) -- (since the [left .. right] window is a prefix of bs). -- But we already know how long the common prefix -- starting at (i - left) is. z <- unsafeRead za (i-left) let !s = right-i+1 -- length of known prefix starting at i if z < s -- If the common prefix of the substring starting at -- (i - left) is shorter than the rest of the window, -- the common prefix of the substring starting at i -- is the same. Store it and move on with the same window. then do unsafeWrite za i z loop left right (i+1) else do -- Otherwise, find out how far the common prefix -- extends, starting at (right + 1) == s + i. w <- go s (s+i) unsafeWrite za i w loop i (i+w-1) (i+1) count !acc i | i == len = return acc | otherwise = do n <- unsafeRead za i count (acc+n) (i+1) loop 0 0 1 ):

    {{1}}