Flujos de bits eficientes en Haskell

Question

Apr 30, 2018, 03:13 PM

Flujos de bits eficientes en Haskell

n un esfuerzo continuo por manipular eficientemente los bits (por ejemplo, vea esteSO pregunta) el desafío más nuevo es la transmisión eficiente y el consumo de bits.

omo una primera tarea simple, elijo encontrar la secuencia más larga de bits idénticos en un flujo de bits generado por/dev/urandom. Un encantamiento típico seríahead -c 1000000 </dev/urandom | my-exe. El objetivo real es transmitir bits y decodificar unaElias gamma code, por ejemplo, códigos que no son fragmentos de bytes o múltiplos de los mismos.

Para tales códigos de longitud variable, es bueno tener eltake, takeWhile, group, etc. lenguaje para la manipulación de listas. Desde unBitStream.take en realidad consumiría parte del bistream que alguna mónada probablemente entraría en juego.

l punto de partida obvio es la cadena de bytes perezosa deData.ByteString.Lazy.

UN. Contando bytes

Este programa muy simple de Haskell funciona a la par con un programa en C, como es de esperar.

import qualified Data.ByteString.Lazy as BSL

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

SI. Añadiendo bytes

Una vez que empiezo a usarunpack las cosas deberían empeorar.

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

orprendentemente, Haskell y C muestran casi el mismo rendimiento.

C. Secuencia más larga de bits idénticos

omo primera tarea no trivial, la secuencia más larga de bits idénticos se puede encontrar así:

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 <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)
gt; (group $ bitStream bs)

La cadena de bytes perezosa se convierte en una lista[Word8] y luego, usando turnos, cadaWord se divide en bits, lo que da como resultado una lista[Bool]. Esta lista de listas se aplana conconcat. Habiendo obtenido una lista (perezosa) deBool, utilizargroup para dividir la lista en secuencias de bits idénticos y luego asignarlength encima de eso. Finalmentemaximum da el resultado deseado. Bastante simple, pero no muy rápido:

# C
real    0m0.606s

# Haskell
real    0m6.062s

Esta ingenua implementación es exactamente un orden de magnitud más lenta.

Profiling muestra que se asigna una gran cantidad de memoria (aproximadamente 3 GB para analizar 1 MB de entrada). Sin embargo, no se observa una fuga espacial masiva.

Desde aquí empiezo a hurgar:

Hay unbitstream paquete que promete "Secuencias de bits estrictas, rápidas y compactas (es decir, lista de Bools) con fusión de secuencia semiautomática. ". Desafortunadamente no está actualizado con el @ actuvector paquete, veraqu para detallesNext, investigostreaming. No entiendo por qué debería necesitar una transmisión 'efectiva' que ponga en juego algo de mónada, al menos hasta que comience con el reverso de la tarea planteada, es decir, codificar y escribir secuencias de bits en el archivo. ¿Qué tal solofold -ing sobre elByteString? Tendría que introducir el estado para realizar un seguimiento de los bits consumidos. Esa no es la buenatake, takeWhile, group, etc. lenguaje que es deseable.

Y ahora no estoy muy seguro de a dónde ir.

Actualiza:

He descubierto cómo hacer esto constreaming ystreaming-bytestring. Probablemente no estoy haciendo esto bien porque el resultado es catastróficamente malo.

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) <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
gt; [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

Esto pondrá a prueba su paciencia con cualquier cosa más allá de unos pocos miles de bytes de entrada de stdin. El generador de perfiles dice que gasta una cantidad de tiempo increíble (cuadrática en el tamaño de entrada) enStreaming.Internal.>>=.loop yData.Functor.Of.fmap. No estoy muy seguro de cuál es el primero, pero elfmap indica (?) que el malabarismo de estosOf a b no nos está haciendo ningún bien y debido a que estamos en la mónada IO, no se puede optimizar.

También tengo el equivalente de transmisión del sumador de bytesaquí:SumBytesStream.hs, que es un poco más lento que el simple vagoByteString implementación, pero sigue siendo decente. Ya questreaming-bytestring es proclamado ser - estar "bytestring io hecho bien "Esperaba algo mejor. Probablemente no lo estoy haciendo bien, entonces.

En cualquier caso, todos estos cálculos de bits no deberían estar sucediendo en la mónada IO. PeroBSS.getContents me obliga a entrar en la mónada IO porquegetContents :: MonadIO m => ByteString m () y no hay salida.

Update 2

Siguiendo los consejos de @dfeuer utilicé lastreaming paquete en master @ HEAD. Aquí está el resultado.

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

El problema O (n ^ 2) deStreaming.concat está resuelto, pero todavía no nos estamos acercando al punto de referencia C.

Update 3

a solución de @ Cirdec produce un rendimiento a la par con C. La construcción que se utiliza se llama "listas codificadas de la Iglesia", consulte estaPues contest o el Wiki de Haskell en tipos de rango N.

Archivos fuente

Todos los archivos de origen se pueden encontrar en github. LosMakefile tiene todos los objetivos para ejecutar los experimentos y la creación de perfiles. El valor por defectomake solo construirá todo (crea unbin/ ¡directorio primero!) y luegomake time hará el tiempo en ellongest-seq ejecutables. Los ejecutables de C obtienen una-c añadido para distinguirlos.