haskell中的数组访问速度慢?
Posted
技术标签:
【中文标题】haskell中的数组访问速度慢?【英文标题】:Slow array access in haskell? 【发布时间】:2014-12-03 17:58:04 【问题描述】:我在 Kattis 上做这个汽车游戏问题:https://open.kattis.com/problems/cargame 有五秒的时间限制,但在最后一个实例中,我的代码需要更长的时间才能运行。我相当确定我在做正确的事情(从大 O 的角度来看),所以现在我需要以某种方式对其进行优化。 我从以下位置下载了测试数据: http://challenge.csc.kth.se/2013/challenge-2013.tar.bz2
从分析来看,似乎大部分运行时间都花在了 containsSub 中,这只不过是一个数组访问和一个尾递归调用。此外,它只调用了大约 100M 次,那么为什么运行需要 6.5 秒(我的笔记本电脑上是 6.5 秒。我发现 Kattis 通常慢两倍,所以可能更像 13 秒)。在统计页面上,一些 C++ 解决方案在一秒钟内运行。甚至一些 python 解决方案也只能勉强在 5 秒内完成。
module Main where
import Control.Monad
import Data.Array (Array, (!), (//))
import qualified Data.Array as Array
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List
import Data.Maybe
main::IO()
main = do
[n, m] <- readIntsLn
dictWords <- replicateM n BS.getLine
let suffixChains = map (\w -> (w, buildChain w)) dictWords
replicateM_ m $ findChain suffixChains
noWordMsg :: ByteString
noWordMsg = BS.pack "No valid word"
findChain :: [(ByteString, WordChain)] -> IO ()
findChain suffixChains = do
chrs <- liftM (BS.map toLower) BS.getLine
BS.putStrLn
(
case find (containsSub chrs . snd) suffixChains of
Nothing -> noWordMsg
Just (w, _) -> w
)
readAsInt :: BS.ByteString -> Int
readAsInt = fst . fromJust . BS.readInt
readIntsLn :: IO [Int]
readIntsLn = liftM (map readAsInt . BS.words) BS.getLine
data WordChain = None | Rest (Array Char WordChain)
emptyChars :: WordChain
emptyChars = Rest . Array.listArray ('a', 'z') $ repeat None
buildChain :: ByteString -> WordChain
buildChain s =
case BS.uncons s of
Nothing -> emptyChars
Just (hd, tl) ->
let wc@(Rest m) = buildChain tl in
Rest $ m // [(hd, wc)]
containsSub :: ByteString -> WordChain -> Bool
containsSub _ None = False
containsSub s (Rest m) =
case BS.uncons s of
Nothing -> True
Just (hd, tl) -> containsSub tl (m ! hd)
编辑:采取 2:
我尝试构建一个惰性尝试来避免搜索我已经搜索过的内容。例如,如果我已经遇到以“a”开头的三连音,那么将来我可以跳过任何不包含“a”的内容。如果我已经搜索过以“ab”开头的三元组,我可以跳过任何不包含“ab”的内容。如果我已经搜索了确切的三元组“abc”,我可以返回与上次相同的结果。从理论上讲,这应该有助于显着加速。实际上运行时间是相同的。
此外,如果没有 seq,分析需要很长时间并给出虚假结果(我猜不出为什么)。 使用 seqs,分析表明大部分时间都花在了 forLetter(这是数组访问被移动到的地方,所以看起来数组访问是缓慢的部分)
-# LANGUAGE TupleSections #-
module Main where
import Control.Monad
import Data.Array (Array, (!), (//))
import qualified Data.Array as Array
import qualified Data.Array.Base as Base
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Functor
import Data.Maybe
main::IO()
main = do
[n, m] <- readIntsLn
dictWords <- replicateM n BS.getLine
let suffixChainsL = map (\w -> (w, buildChain w)) dictWords
let suffixChains = foldr seq suffixChainsL suffixChainsL
suffixChains `seq` doProbs m suffixChains
noWordMsg :: ByteString
noWordMsg = BS.pack "No valid word"
doProbs :: Int -> [(ByteString, WordChain)] -> IO ()
doProbs m chains = replicateM_ m doProb
where
cf = findChain chains
doProb =
do
chrs <- liftM (map toLower) getLine
BS.putStrLn . fromMaybe noWordMsg $ cf chrs
findChain :: [(ByteString, WordChain)] -> String -> Maybe ByteString
findChain [] = const Nothing
findChain suffixChains@(shd : _) = doFind
where
letterMap :: Array Char (String -> Maybe ByteString)
letterMap =
Array.listArray ('a','z')
[findChain (mapMaybe (forLetter hd) suffixChains) | hd <- [0..25]]
endRes = Just $ fst shd
doFind :: String -> Maybe ByteString
doFind [] = endRes
doFind (hd : tl) = (letterMap ! hd) tl
forLetter :: Int -> (ByteString, WordChain) -> Maybe (ByteString, WordChain)
forLetter c (s, WC wc) = (s,) <$> wc `Base.unsafeAt` c
readAsInt :: BS.ByteString -> Int
readAsInt = fst . fromJust . BS.readInt
readIntsLn :: IO [Int]
readIntsLn = liftM (map readAsInt . BS.words) BS.getLine
newtype WordChain = WC (Array Char (Maybe WordChain))
emptyChars :: WordChain
emptyChars = WC . Array.listArray ('a', 'z') $ repeat Nothing
buildChain :: ByteString -> WordChain
buildChain = BS.foldr helper emptyChars
where
helper :: Char -> WordChain -> WordChain
helper hd wc@(WC m) = m `seq` WC (m // [(hd, Just wc)])
【问题讨论】:
由于懒惰,分析可能会将创建WordChain
的成本归因于实际强制创建(在containsSub
中)。不过,只是猜测。
我尝试添加 seq's 以确保在读取子序列列表之前创建所有字链。大部分工作仍在 containsSub 中完成。这是合理的,因为 containsSub 被调用(在最坏的情况下)5000*10000*3 次,而只创建了 5000*100 个 WordChains
通过将数据类型更改为data WordChain = None | Rest -# UNPACK #- !(Array Int WordChain)
,我从 3.7 秒到 2.5 秒(对于第二个示例问题);使用m `unsafeAt` (fromIntegral hd - 97)
代替!
和unsafeReplace m [(fromIntegral hd - 97, wc)]
代替//
。 GC 时间是 25%,所以你可以通过不构造中间字节串来让 GC 不运行来挤出更多时间。
我不知道这是否会有所帮助,因为我不知道它是否真的接近问题,但buildChain
似乎具有折叠结构。使用 fold 函数可能有助于加快处理速度,或者至少使代码更易于阅读。
@dfeuer 谢谢,已修复
【参考方案1】:
containsSub
中的 uncons
调用会创建一个新的 ByteString
。尝试通过使用索引跟踪字符串中的偏移量来加速它,例如:
containsSub' :: ByteString -> WordChain -> Bool
containsSub' str wc = go 0 wc
where len = BS.length str
go _ None = False
go i (Rest m) | i >= len = True
| otherwise = go (i+1) (m ! BS.index str i)
【讨论】:
我试过这个,它剃掉了大约半秒。此外,根据hackage.haskell.org/package/bytestring-0.10.4.1/docs/… uncons 是一个 O(1) 操作。我认为这意味着它正在重用字符串尾部的内存,而不是分配一个新的 它正在为字符串的尾部重用内存,但是ByteString
的值是一个长度+一个指向字符的指针,这就是uncons
必须创建的结构。跨度>
如果数组访问受到限制,您可以尝试通过将!
替换为Data.Array.Base
中的unsafeAt
来消除边界检查。【参考方案2】:
在#haskell 和#ghc IRC 频道上进行了多次讨论后,我发现问题与这个 ghc 错误有关:https://ghc.haskell.org/trac/ghc/ticket/1168
解决办法就是改变 doProbs 的定义
doProbs m chains = cf `seq` replicateM_ m doProb
...
或者只是用 -fno-state-hack 编译
ghc 的 state hack 优化导致它在每次调用时都不必要地重新计算 cf(以及相关的 letterMap)。
所以它与数组访问无关。
【讨论】:
以上是关于haskell中的数组访问速度慢?的主要内容,如果未能解决你的问题,请参考以下文章