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中的数组访问速度慢?的主要内容,如果未能解决你的问题,请参考以下文章

php+mssql 访问速度慢是啥原因?

SQL SERVER 访问Sybase速度过慢,怎么解决?

Oracle应用程序在远程访问时速度非常慢

IIS访问速度很慢是怎么回事?高手请进

用户网站访问速度慢详解

linux访问win网络快,反过来慢