haskell中的数组访问速度慢？

Posted 2023-03-06

【中文标题】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）。

所以它与数组访问无关。