这是解决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程序的样子。
谢谢! 泰勒
答案 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
left
和right
,prefix-substring窗口的第一个和最后一个索引;不变量:
left < i
,left <= right < length(S)
,left > 0
或right < 1
,left > 0
,则S[left .. right]
是S
和S[left .. ]
的最大公共前缀,1 <= j < i
和S[j .. k]
是S
的前缀,那么k <= right
Z
,不变量:对于1 <= k < i
,Z[k]
包含最长公共前缀S[k .. ]
和S
的长度。算法:
i = 1
,left = right = 0
(允许使用left <= right < 1
的任何值),并为所有索引Z[j] = 0
设置1 <= j < length(S)
。i == length(S)
,请停止。i > right
,找到l
和S
最长公共前缀的长度S[i .. ]
,请将其存储在Z[i]
中。如果l > 0
我们发现窗口比前一个更向右延伸,则设置left = i
和right = i+l-1
,否则保持不变。增加i
并转到2. 此处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.
否则,S
是right+1
的前缀,我们检查它的扩展距离,开始比较索引right+1 - i
和l
处的字符。设长度为Z[i] = l
。设置left = i
,right = i + l - 1
,i
,增加ByteString
,然后转到2.
由于窗口从不向左移动,并且比较总是在窗口结束后开始,因此字符串中的每个字符最多成功一次与字符串中的较早字符进行比较,并且对于每个起始索引,都存在大多数不成功的比较,因此算法是线性的。
代码(使用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}}