dmjio
1/4/2014 - 2:01 PM

Vertical Letter Histogram

Vertical Letter Histogram

{-# LANGUAGE OverloadedStrings #-}

import           Control.Arrow              ((&&&))
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map                   as M

main :: IO ()
main = do
  text <- B.getContents
  case text of
    x | B.null x -> B.putStrLn "Nothing here..."
      | otherwise -> plotLetterFreq x

type BMap = M.Map Char Int

initialMap :: BMap
initialMap = M.fromList $ zip ['a'..'z'] $ repeat 0

plotLetterFreq :: ByteString -> IO ()
plotLetterFreq bs = addToMap bs initialMap >>= printMap

addToMap :: ByteString -> BMap -> IO BMap
addToMap bs bmap | B.null bs  = return bmap
                 | otherwise  = do
  let (hd,tl) = B.head &&& B.tail $ bs
      result = M.lookup hd bmap
  case result of
    Just x -> addToMap tl $ M.insert hd (x+1) bmap
    Nothing -> addToMap tl bmap

printMap :: BMap -> IO ()
printMap bmap = do handleEntry (M.toList bmap)
                   B.putStrLn $ B.pack ['A'..'Z']
    where
      width = M.size bmap - 1
      height = maximum $ map snd (M.toList bmap)
      index = (0, height)
      handleEntry xs = go width height index xs
      go width height (x,0) xs | width == x = return () -- base case
      go width height (x,0) xs = go width height (x+1, 0) xs  -- recursive cases
      go width height (x,y) xs      
          | width == x = do -- is edge
        case snd $ xs !! x of
          z | z >= y -> B.putStr "o\n" >> go width height (0, y-1) xs
            | otherwise -> B.putStr " \n" >> go width height (0, y-1) xs
          | otherwise = do
        case snd $ xs !! x of
          z | z >= y -> B.putStr "o" >> go width height (x+1, y) xs
            | otherwise -> B.putStr " " >> go width height (x+1, y) xs