Гистограмма ByteString

Основная идея dflemstr, конечно, верна, но поскольку вам нужна наилучшая производительность, вам нужно использовать непроверенный доступ к ByteString, а также к счетному массиву, например

import Control.Monad.ST
import Data.Array.ST
import Data.Array.Base (unsafeRead, unsafeWrite)
import Data.Array.Unboxed

import Data.Word

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe

histogram :: ByteString -> UArray Word8 Int
histogram bs = runSTUArray $ do
    hist <- newArray (0, 255) 0
    let l = BS.length bs
        update b = do
            o <- unsafeRead hist b
            unsafeWrite hist b (o+1)
        loop i
            | i < 0     = return hist
            | otherwise = do
                update $ fromIntegral (bs `unsafeIndex` i)
                loop (i-1)
    loop (l-1)

Согласно criterion, это имеет большое значение (построение гистограммы ByteString длиной 200 000):

warming up
estimating clock resolution...
mean is 1.667687 us (320001 iterations)
found 3078 outliers among 319999 samples (1.0%)
  1947 (0.6%) high severe
estimating cost of a clock call...
mean is 40.43765 ns (14 iterations)

benchmarking dflemstr
mean: 21.42852 ms, lb 21.05213 ms, ub 21.77954 ms, ci 0.950
std dev: 1.873897 ms, lb 1.719565 ms, ub 2.038779 ms, ci 0.950
variance introduced by outliers: 74.820%
variance is severely inflated by outliers

benchmarking unsafeIndex
mean: 312.6447 us, lb 304.3425 us, ub 321.0795 us, ci 0.950
std dev: 42.86886 us, lb 39.64363 us, ub 46.52899 us, ci 0.950
variance introduced by outliers: 88.342%
variance is severely inflated by outliers

(Я изменил код dflemstr, чтобы он также использовал runSTUArray и возвращал UArray Word8 Int, чтобы иметь возвращаемые значения uiform, однако это не имеет большого значения во времени выполнения.)

Наиболее эффективный метод, вероятно, включает использование изменяемого массива для хранения счетчиков. Это потенциально одно из самых эффективных доступных решений O (n):

import Control.Monad
import Control.Monad.ST

import Data.Array.ST

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString

import Data.Word

byteHistogram :: ByteString -> [Int]
byteHistogram bs = runST $ do
  histogram <- newArray (minBound, maxBound) 0 :: ST s (STUArray s Word8 Int)
  forM_ (ByteString.unpack bs) $ \ byte ->
    readArray histogram byte >>= return . (+1) >>= writeArray histogram byte
  getElems histogram

Ну, вы можете догадаться, или вы можете сделать программу и измерить ее - результаты могут вас удивить.

import Data.ByteString as B
import Data.IntMap.Strict as I
import qualified Data.Vector.Unboxed.Mutable as M
import Data.Vector.Unboxed as V
import Criterion
import Criterion.Main
import System.Entropy
import System.IO.Unsafe
import Data.Word

main = do
    bs <- getEntropy 1024
    defaultMain [ bench "map count" $ nf mapCount bs
                , bench "map group sort" $ nf mapGroup bs
                , bench "fold counters" $ nf mapFoldCtr bs
                , bench "vCount" $ nf vectorCount bs
                ]

-- O(n*m) (length of bytestring, length of list of element being counted up)
-- My guess: bad
mapCount :: ByteString -> [Int]
mapCount bs = Prelude.map (`B.count` bs) [0x00..0xFF]

-- Notice that B.sort uses counting sort, so there's already lots of
-- duplicate work done here.
-- O() isn't such a big deal as the use of lists - likely allocation and
-- large constant factors.
mapGroup :: ByteString -> [Int]
mapGroup = Prelude.map Prelude.length . Prelude.map B.unpack . B.group . B.sort

mapFoldCtr :: ByteString -> [Int]
mapFoldCtr bs  = I.elems $ B.foldl' cnt I.empty bs
 where
 cnt :: I.IntMap Int -> Word8 -> I.IntMap Int
 cnt m k = I.insertWith (+) (fromIntegral k) 1 m

 -- create (do { v <- new 2; write v 0 'a'; write v 1 'b'; return v })
vectorCount :: B.ByteString -> [Int]
vectorCount bs = V.toList $ V.create $ do
        v <- M.new 256
        Prelude.mapM_ (\i -> M.unsafeWrite v i 0) [0..255]
        Prelude.mapM_ (\i -> M.unsafeRead v (fromIntegral i) >>= M.unsafeWrite v (fromIntegral i) . (+1) ) (B.unpack bs)
        return v

И результаты (укороченные) удивительно хорошо отражают сортировку группы карт, но неудивительно, что решение в стиле изменчивого вектора/массива без коробки лидирует:

benchmarking map count
mean: 308.7067 us, lb 307.3562 us, ub 310.5099 us, ci 0.950
std dev: 7.942305 us, lb 6.269114 us, ub 10.08334 us, ci 0.950

benchmarking map group sort
mean: 43.03601 us, lb 42.93492 us, ub 43.15815 us, ci 0.950
std dev: 567.5979 ns, lb 486.8838 ns, ub 666.0098 ns, ci 0.950

benchmarking fold counters
mean: 191.5338 us, lb 191.1102 us, ub 192.0366 us, ci 0.950
std dev: 2.370183 us, lb 1.995243 us, ub 2.907595 us, ci 0.950

benchmarking vCount
mean: 12.98727 us, lb 12.96037 us, ub 13.02261 us, ci 0.950
std dev: 156.6505 ns, lb 123.6789 ns, ub 198.4892 ns, ci 0.950

Как ни странно, когда я увеличиваю размер строки байтов до 200 КБ, как использовал Даниэль, то часы отображения/группировки/сортировки составляют ~ 250 мкс, в то время как векторное решение занимает более 500 мкс:

benchmarking map count
mean: 5.796340 ms, lb 5.788830 ms, ub 5.805126 ms, ci 0.950
std dev: 41.65349 us, lb 35.69293 us, ub 48.39205 us, ci 0.950

benchmarking map group sort
mean: 260.7405 us, lb 259.2525 us, ub 262.4742 us, ci 0.950
std dev: 8.247289 us, lb 7.127576 us, ub 9.371299 us, ci 0.950

benchmarking fold counters
mean: 3.915101 ms, lb 3.892415 ms, ub 4.006287 ms, ci 0.950
std dev: 201.7632 us, lb 43.13063 us, ub 469.8170 us, ci 0.950

benchmarking vCount
mean: 556.5588 us, lb 545.4895 us, ub 567.9318 us, ci 0.950
std dev: 57.44888 us, lb 51.22270 us, ub 65.91105 us, ci 0.950
found 1 outliers among 100 samples (1.0%)
variance introduced by outliers: 80.038%
variance is severely inflated by outliers

Но эта дисперсия огромна - возможно, некоторые игры с размерами кучи заставят это исчезнуть (по крайней мере, в программе тестирования), но для меня это не так быстро или легко.

(Не воспринимайте это очень серьезно)

(Фактическое) самое быстрое решение и чистое решение FP - это... почти:

data Hist = Hist {v00 :: Int, v01 :: Int {- , v02 :: Int, ... -} }

emptyHist :: Hist
emptyHist = Hist 0 0 {- 0 0 ... -}

foldRecord :: B.ByteString -> [Int]
foldRecord = histToList . B.foldl' cnt emptyHist
  where histToList (Hist x00 x01 {- x02 ... -}) = [x00, x01 {- , x02, ... -}]
        cnt (Hist !x00 !x01)    0x00      = Hist (x00 + 1) x01 {- x02 ... -}
        cnt (Hist !x00 !x01) {- 0x01 -} _ = Hist x00 (x01 + 1) {- x02 ... -}
        {- ... -}

Использование тестов @Thomas работает за 11,67 мкс (предыдущий самый быстрый vCount занимает 14,99 мкс на моей машине).

Проблема в том, что cnt разбивается на 256 возможных шаблонов (полный эквивалентный код с использованием lens находится здесь) .

Компилятор медленно выбирает правильный шаблон (левая часть cnt) или увеличивает (правая часть cnt), но я думаю, что он должен генерировать эффективный код (по крайней мере, с равной эффективностью двух шаблонов).

(Использование 256 шаблонов cnt и 256 значений Hist занимает 1,35 мс!!!)

(В моей машине map group sort берут 42 нас, сзади vCount альтернатива)