Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

To learn some Data.Map and Control.Monad.State, I have written the following code, which should count the occurrences of Char8 in a given file.

module Main where

import           Control.Monad.State
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Map              (Map)
import qualified Data.Map              as M
import           Data.Maybe
import           System.Environment

type Counter = ([Char], (Char, Integer), (Char, Integer), Map Char Integer)

main :: IO ()
main = do
  file <- liftM head getArgs
  string <- B.readFile file
  let (chars, seldom, often, counter) = execState (countChars string) ([], (' ', 10^12), (' ', 0), M.empty)
  mapM_ (\k -> putStrLn ('\'':k:"' " ++ show (fromJust $ M.lookup k counter))) chars
  putStrLn $ "minimum occurence: " ++ show (fst seldom) ++ ", " ++ show (snd seldom)
  putStrLn $ "maximum occurence: " ++ show (fst often)  ++ ", " ++ show (snd often)
  putStrLn $ "overal chars     : " ++ show (B.length string)

countChars :: B.ByteString -> State Counter ()
countChars bs | B.null bs = return ()
              | otherwise = do
  let c  = B.head bs
  let cs = B.tail bs
  unless (not . isPrint $ c) $ do
    (pre, minOcc, maxOcc, counter) <- get
    newPre <- return $ if (c `elem` pre)
                         then pre
                         else pre ++ [c]
    newCounter <- return (M.insertWith (+) c 1 counter)
    let newMinOcc = (\ (k1, v1) (k2, v2) -> if v2 < v1 then (k2, v2) else (k1, v1)) minOcc (c, newCounter M.! c)
    let newMaxOcc = (\ (k1, v1) (k2, v2) -> if v2 > v1 then (k2, v2) else (k1, v1)) maxOcc (c, newCounter M.! c)
    put (newPre, newMinOcc, newMaxOcc, newCounter)
  countChars cs

This code works as I want it for small files, counting and displaying the stats of the file, but it fails when the file gets bigger:

$ ls -l 46000.txt.utf-8
-rw-r--r-- 1 nobbz nobbz 156315 Jun 16 20:33 46000.txt.utf-8

$ ./Main 46000.txt.utf-8
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.

I don't grasp why a file of about 150kiB can overflow an 8Mib stack. If I increase to 10 MiB (./Main 46000.txt.utf-8 +RTS -k10M) it works, but using also -sstderr shows that the Program consumes 107 MiB in total.

How could I decrease memory usage, so it would work with large files and default stack-size?


Just to mention:

I want to keep the list of chars and their count of occurrence in the order of occurrence of the corresponding char, also I want that on equal count for most often and most seldom used chars that one "wins" that has occurred first.

Also I am aware of the fact that I have a file that states to be UTF-8 encoded and my program can only "see" ASCII, but I just took a random book from gutenberg.org to have a real text and not some "random" bytes in huge binarys or something comparable.

share|improve this question
An important thing to learn with Data.Map and Control.Monad.State is that you should almost always use Control.Monad.State.Strict and Data.Map.Strict instead :) –  bartavelle Jun 17 '14 at 9:47
Before the edit this was a valid answer: histogram :: Text -> MultiSet Char\n histogram t = T.foldl' (flip S.insert) S.empty . T.filter isAlpha $ t where MultiSet is from the multiset package. –  Florian Jun 17 '14 at 10:21

2 Answers 2

up vote 2 down vote accepted

If you're using "Char8", then it would make a lot of sense to me to write a simple histogram type function using a mutable attay in the ST monad, and then calculate the minimum and maximum values at the end; there's no need to do it as you go.

import Data.Vector.Unboxed.Mutable as V
import Data.Vector.Unboxed as V
import Data.ByteString as B
import Control.Monad.ST
import Data.Char

histo :: B.ByteString -> (Int,Int,Int)
histo bs = 
    let vec = create ( do
                mvec <- V.replicate 256 0
                forM [0 .. B.length bs - 1] $ \i -> do
                    let c = fromIntegral (B.index i bs) :: Int
                    n <- unsafeRead mvec c
                    unsafeWrite mvec c (n+1)
                return mvec
        f :: (Int, Int, Int) -> Int -> Word8 -> (Int, Int, Int)
        f (mn,mx,cnt) i w =
            let mn'  = if w > 0 && w < unsafeIndex vec mn then i else mn
                mx'  = if          w > unsafeIndex vec mx then i else mx
                cnt' = if isPrint (chr . fromIntegral $ w) then cnt+1 else cnt
            in (mn', mx',cnt')

     in V.foldl' f (32, 32,0) vec -- 32 = index for ' '

This should calculate the result in constant memory (though the fold should probably be made more strict using a strict 3-tuple but all three values are forced each time f is called anyway). I haven't tested this code because I don't currently have access to a compiler so there are probably missing imports and some type errors but I hope the gist is clear.

I think this is a good demonstration of when some mutation is useful (counting lots of elements) and when functional algorithms are clearer (folding over all the data). The counting could have been done using a fold too but I think it's easier to see that here it is definitely using a constant amount of memory for the counts and should also perform quite well.

share|improve this answer

Haskell is non-strict, so binding an expression to a name doesn't (always) evaluate the expression at that point. Instead it (may) create a "closure" or "thunk" that holds the expression and any local bindings on which the expression depends.

This can be nice; implementing custom control-flow constructs in Haskell is easy. This is a great advantage which writing your own DSL.

When performing a reduction of even a moderate amount of data, this is bad. No work is avoided by creating a thunk and then not later evaluating it. The thunks themselves may be larger than their results and even if not can cause a lot of "thrashing" in the garbage collector when they do finally get evaluated. When evaluating one thunk forces another thunk, they are processed (recursively) on the stack, so a long "chain" of thunks can end up with a stack overflow.

If you use State/StateT, you almost always want to use the strict State monad / StateT transformer, as the strictness there affects the pattern-matching of the tuple in bind/join, not the data itself. (I actually don't have a good example of when you'd want to use lazy State/StateT.)

On top of that, you'll want to use seq, bang (!) patterns, and strict data types (like Data.Map.Strict) to ensure that the state data is eagerly evaluated.

Finally, in an attempt to simplify your code, I would only keep track of the Data.Map.Strict Char8 Integer in your state, as the other elements of your state tuple can be calculated simply from that map.

For bonus points, you could also use a streaming library like conduit or pipes to avoid "slurping" the whole file into memory and instead process it in a streaming fashion.

newtype Histogram k v = Histo (Map k v)

-- |Calculate the histogram for a single chunk.
-- If not using a streaming library, this can be just over the whole file contents.
reduce :: ByteString -> Histogram Char8 Integer
reduce cs = Histo $ execState (omapM_ (modify . alter insOrInc) cs) M.empty
    insOrInc Nothing  = Just 1
    insOrInc (Just n) = Just $ succ n
-- omapM_ from mono-traversable

-- |mappend / mconcat are used for combining histograms calculated from each chunk
instance (Ord k, Num v) => Monoid (Histogram k v) where
    mempty = M.empty
    mappend = M.unionWith (+)
    mconcat = M.unionsWith (+)

type Keys = [Char8]
type Min = Maybe (Char8, Integer)
type Max = Maybe (Char8, Integer)

-- |Extract your pre/min/max from the final combined histogram
analyze :: Histogram Char8 Integer -> (Keys, Min, Max)
analyze (Histo dat) = (M.keys dat, headMay histList, lastMay histList)
 where histList = M.toAscList dat
-- headMay / lastMay from safe

-- A pipe over the WriterT (Histogram Char8 Integer) IO monad ties the streaming
-- together but be sure to use execWriterP to avoid space leaks in WriterT layer.
share|improve this answer

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.