Question

在不断努力有效地摆弄比特（例如，见SO question）时，最新的挑战是比特的有效流和消费。

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

对于这种可变长度的代码，最好使用take，takeWhile，group等语言进行列表操作。由于BitStream.take实际上会消耗掉一部分比特流，因此一些单子可能会发挥作用。

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

：一种。计算字节

这个非常简单的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表现出几乎相同的表现。

℃。相同位的最长序列

作为第一个非常重要的任务，可以找到最长的相同位序列：

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 package承诺“快速，打包，严格的比特流（即Bools列表），半自动流融合。”。不幸的是，它与当前vector包不是最新的，有关详细信息，请参阅here。
接下来，我调查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它无法优化。

我还有字节加法器here: SumBytesStream.hs的流式等价物，它比简单的惰性ByteString实现稍慢，但仍然不错。由于streaming-bytestring proclaimed为“ bytestring io right right ”，我期待更好。那么我可能做得不对。

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

更新2

根据@dfeuer的建议，我在master @ HEAD使用了streaming包。这是结果。

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

Streaming.concat的O（n ^ 2）问题已经解决，但我们仍然没有接近C基准。

更新3

Cirdec的解决方案产生与C相同的性能。使用的构造称为“教会编码列表”，请参阅此SO answer或rank-N types上的Haskell Wiki。

源文件：

所有源文件都可以在github找到。 Makefile具有运行实验和分析的所有各种目标。默认make将构建所有内容（首先创建一个bin/目录！）然后make time将对longest-seq可执行文件执行计时。 C可执行文件附加-c以区分它们。

Answer 1

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

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

-- 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)

使用one的最简单的例子是找到列表的长度。

{-# 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

要找到最长的跑步，我们将跟踪前一个值，当前跑步的长度以及最长跑步的长度。我们使字段严格，以便折叠的严格性防止thunk的链在内存中累积。为状态创建严格的数据类型是一种简单的方法来控制其内存表示以及何时对其字段进行求值。

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 code

Answer 2

我发现了另一个与C相同的解决方案。Data.Vector.Fusion.Stream.Monadic具有基于此Coutts, Leshchinskiy, Stewart 2007 paper的流实现。其背后的想法是使用销毁/展开流融合。

回想一下，列表的unfoldr :: (b -> Maybe (a, b)) -> b -> [a]通过重复应用（展开）从初始值开始的步进功能来创建列表。 Stream只是具有起始状态的unfoldr函数。（Data.Vector.Fusion.Stream.Monadic库使用GADT为Step创建可以方便地进行模式匹配的构造函数。我认为，不用GADT也可以完成。）

解决方案的核心是mkBitstream :: BSL.ByteString -> Stream Bool函数，该函数将BytesString转换为Bool的流。基本上，我们跟踪当前的ByteString，当前的字节以及当前未消耗的字节数。每当一个字节用完时，另一个字节就会被切掉ByteString。剩下Nothing时，流为Done。

longestRun函数直接来自@Cirdec的解决方案。

这是练习曲：

{-# LANGUAGE CPP #-}
#define PHASE_FUSED [1]
#define PHASE_INNER [0]
#define INLINE_FUSED INLINE PHASE_FUSED
#define INLINE_INNER INLINE PHASE_INNER
module Main where

import           Control.Monad.Identity            (Identity)
import           Data.Bits                         (shiftR, (.&.))
import qualified Data.ByteString.Lazy              as BSL
import           Data.Functor.Identity             (runIdentity)
import qualified Data.Vector.Fusion.Stream.Monadic as S
import           Data.Word8                        (Word8)

type Stream a = S.Stream Identity a   -- no need for any monad, really

data Step = Step BSL.ByteString !Word8 !Word8   -- could use tuples, but this is faster

mkBitstream :: BSL.ByteString -> Stream Bool
mkBitstream bs' = S.Stream step (Step bs' 0 0) where
    {-# INLINE_INNER step #-}
    step (Step bs w n) | n==0 = case (BSL.uncons bs) of
                            Nothing        -> return S.Done
                            Just (w', bs') -> return $ 
                                S.Yield (w' .&. 1 == 1) (Step bs' (w' `shiftR` 1) 7)
                       | otherwise = return $ 
                                S.Yield (w .&. 1 == 1) (Step bs (w `shiftR` 1) (n-1))


data LongestRun = LongestRun !Bool !Int !Int

{-# INLINE extendRun #-}
extendRun :: LongestRun -> Bool -> LongestRun
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 :: Stream Bool -> Int
longestRun s = runIdentity $ do
    (LongestRun _ _ longest) <- S.foldl' extendRun (LongestRun False 0 0) s
    return longest

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

Haskell中的高效比特流

2 个答案: