Haskell中的高效比特流

Question

在不断努力有效地摆弄比特的过程中(例如,参见这个SO问题),最新的挑战是比特的有效流和消费.

作为第一个简单的任务,我选择在生成的比特流中找到最长的相同比特序列/dev/urandom.典型的咒语是head -c 1000000 </dev/urandom | my-exe.实际目标是流式比特并解码Elias伽马码,例如,不是字节块或其倍数的码.

对于可变长度的这样的代码它是好的,具有take,takeWhile,group,对于列表操作等语言.由于a BitStream.take实际上会消耗部分b声,因此一些monad可能会发挥作用.

明显的起点是来自的懒惰字节串Data.ByteString.Lazy.

A.计算字节数

正如预期的那样,这个非常简单的Haskell程序与C程序相同.

import qualified Data.ByteString.Lazy as BSL

main :: IO ()
main = do
    bs <- BSL.getContents
    print $ BSL.length bs

B.添加字节

一旦我开始使用unpack东西应该变得更糟.

main = do
    bs <- BSL.getContents
    print $ sum $ BSL.unpack bs

令人惊讶的是,Haskell和C表现出几乎相同的表现.

C.相同位的最长序列

作为第一个非常重要的任务,可以找到最长的相同位序列,如下所示:

module Main where

import           Data.Bits            (shiftR, (.&.))
import qualified Data.ByteString.Lazy as BSL
import           Data.List            (group)
import           Data.Word8           (Word8)

splitByte :: Word8 -> [Bool]
splitByte w = Prelude.map (\i-> (w `shiftR` i) .&. 1 == 1) [0..7]

bitStream :: BSL.ByteString -> [Bool]
bitStream bs = concat $ map splitByte (BSL.unpack bs)

main :: IO ()
main = do
    bs <- BSL.getContents
    print $ maximum $ length <$> (group $ bitStream bs)

将惰性字节串转换为列表[Word8],然后使用移位将每个字符串Word拆分为位,从而生成列表[Bool].然后将该列表列表展平concat.获得(懒惰)列表后Bool,使用group将列表拆分为相同位的序列,然后映射length到它.最后maximum给出了期望的结果.很简单,但不是很快:

# C
real    0m0.606s

# Haskell
real    0m6.062s

这种天真的实现正好慢了一个数量级.

分析显示分配了相当多的内存(解析1MB输入大约3GB).但是,没有观察到大量的空间泄漏.

从这里开始,我开始探索:

• 有一个bitstream软件包承诺" 快速,打包,严格的比特流(即Bools列表)与半自动流融合. " 不幸的是,它不是最新的当前vector包,请参阅此处了解详情.
• 接下来,我调查streaming.我不太明白为什么我需要'有效'的流媒体让一些monad发挥作用 - 至少直到我开始与提出的任务相反,即编码和写入比特流到文件.
• 刚刚fold过来的ByteString怎么样？我必须引入状态来跟踪消耗的比特.这是不是很漂亮take,takeWhile,group这是可取的,等语言.

现在我不太确定要去哪里.

更新:

我想出了如何用streaming和做streaming-bytestring.我可能没有做到这一点,因为结果是灾难性的糟糕.

import           Data.Bits                 (shiftR, (.&.))
import qualified Data.ByteString.Streaming as BSS
import           Data.Word8                (Word8)
import qualified Streaming                 as S
import           Streaming.Prelude         (Of, Stream)
import qualified Streaming.Prelude         as S

splitByte :: Word8 -> [Bool]
splitByte w = (\i-> (w `shiftR` i) .&. 1 == 1) <$> [0..7]

bitStream :: Monad m => Stream (Of Word8) m () -> Stream (Of Bool) m ()
bitStream s = S.concat $ S.map splitByte s

main :: IO ()
main = do
    let bs = BSS.unpack BSS.getContents :: Stream (Of Word8) IO ()
        gs = S.group $ bitStream bs ::  Stream (Stream (Of Bool) IO) IO ()
    maxLen <- S.maximum $ S.mapped S.length gs
    print $ S.fst' maxLen

这将测试你对stdin输入的几千字节之外的耐心.探查说,它花费的时间的量疯狂(二次输入大小)Streaming.Internal.>>=.loop和Data.Functor.Of.fmap.我不太清楚第一个是什么,但是fmap表明(？)这些杂耍Of a b并没有给我们带来任何好处,因为我们在IO monad中它无法被优化掉.

我也有这里SumBytesStream.hs的字节加法器的流式等价物:它比简单的懒惰ByteString实现稍慢,但仍然不错.既然streaming-bytestring被宣布为" 字母串我做得对 ",我期待更好.那么我可能做得不对.

在任何情况下,所有这些位计算都不应该在IO monad中发生.但BSS.getContents迫使我进入IO monad因为getContents :: MonadIO m => ByteString m ()并且没有出路.

更新2

按照@dfeuer的建议,我使用了streamingmaster @ HEAD 的包.这是结果.

longest-seq-c       0m0.747s    (C)
longest-seq         0m8.190s    (Haskell ByteString)
longest-seq-stream  0m13.946s   (Haskell streaming-bytestring)

O(n ^ 2)问题Streaming.concat已经解决,但我们仍然没有接近C基准.

更新3

Cirdec的解决方案产生与C相同的性能.使用的构造称为"教会编码列表",请参阅此SO答案或排名N类型的Haskell Wiki .

源文件:

所有源文件都可以在github上找到.在Makefile有所有不同的目标来运行实验和分析.默认make只会构建所有内容(bin/首先创建一个目录!)然后make time将对longest-seq可执行文件执行定时.C可执行文件会-c附加一个以区分它们.

Answer 1

当流上的操作融合在一起时，可以消除中间分配及其相应的开销。GHC prelude 以重写规则的形式为惰性流提供折叠/构建融合。一般的想法是，如果一个函数产生一个看起来像foldr的结果（它的类型(a -> b -> b) -> b -> b应用于(:)and []），而另一个函数使用一个看起来像foldr的列表，则可以删除构造中间列表。

对于你的问题，我将构建类似的东西，但使用严格的左折叠（foldl'）而不是foldr。foldl我将使用强制列表看起来像左折叠的数据类型，而不是使用尝试检测何时看起来像 a 的重写规则。

-- A list encoded as a strict left fold.
newtype ListS a = ListS {build :: forall b. (b -> a -> b) -> b -> b}

由于我一开始就放弃了列表，因此我们将重新实现列表前奏的一部分。

foldl'可以从列表和字节串的函数创建严格的左折叠。

{-# INLINE fromList #-}
fromList :: [a] -> ListS a
fromList l = ListS (\c z -> foldl' c z l)

{-# INLINE fromBS #-}
fromBS :: BSL.ByteString -> ListS Word8
fromBS l = ListS (\c z -> BSL.foldl' c z l)

最简单的使用示例是查找列表的长度。

{-# INLINE length' #-}
length' :: ListS a -> Int
length' l = build l (\z a -> z+1) 0

我们还可以映射和连接左侧折叠。

{-# INLINE map' #-}
-- fmap renamed so it can be inlined
map' f l = ListS (\c z -> build l (\z a -> c z (f a)) z)

{-# INLINE concat' #-}
concat' :: ListS (ListS a) -> ListS a
concat' ll = ListS (\c z -> build ll (\z l -> build l c z) z)

对于您的问题，我们需要能够将单词拆分为位。

{-# INLINE splitByte #-}
splitByte :: Word8 -> [Bool]
splitByte w = Prelude.map (\i-> (w `shiftR` i) .&. 1 == 1) [0..7]

{-# INLINE splitByte' #-}
splitByte' :: Word8 -> ListS Bool
splitByte' = fromList . splitByte

和一个ByteString成比特

{-# INLINE bitStream' #-}
bitStream' :: BSL.ByteString -> ListS Bool
bitStream' = concat' . map' splitByte' . fromBS

为了找到最长的运行，我们将跟踪先前的值、当前运行的长度以及最长运行的长度。我们使字段变得严格，以便折叠的严格性可以防止重击链在内存中累积。为状态创建严格的数据类型是控制其内存表示及其字段评估时间的简单方法。

data LongestRun = LongestRun !Bool !Int !Int

{-# INLINE extendRun #-}
extendRun (LongestRun previous run longest) x = LongestRun x current (max current longest)
  where
    current = if x == previous then run + 1 else 1

{-# INLINE longestRun #-}
longestRun :: ListS Bool -> Int
longestRun l = longest
 where
   (LongestRun _ _ longest) = build l extendRun (LongestRun False 0 0)

我们就完成了

main :: IO ()
main = do
    bs <- BSL.getContents
    print $ longestRun $ bitStream' bs

这要快得多，但不完全是 c 的性能。

longest-seq-c       0m00.12s    (C)
longest-seq         0m08.65s    (Haskell ByteString)
longest-seq-fuse    0m00.81s    (Haskell ByteString fused)

该程序分配大约 1 Mb 来从输入中读取 1000000 字节。

total alloc =   1,173,104 bytes  (excludes profiling overheads)

更新了github 代码