hp2pretty-0.1: src/Pretty.hs

module Pretty where

import Control.Monad (forM_, liftM2)
import Data.Array.ST
import Data.Array.Unboxed (UArray)
import Data.ByteString.Lazy.Char8 (pack)

import Types

pretty :: Info -> Graph
pretty hpi =
  let sticks = uncurry (ticks 20) (hpiSampleRange hpi)
      vticks = uncurry (ticks 20) (hpiValueRange hpi)
      labels = pack "(trace elements)" : (reverse . map fst . hpiValues) hpi
      values = hpiTrace hpi : (reverse . map snd . hpiValues) hpi
      bands  = accumulate values
  in  Graph
      { hpgJob        = hpiJob hpi
      , hpgDate       = hpiDate hpi
      , hpgSampleUnit = hpiSampleUnit hpi
      , hpgValueUnit  = hpiValueUnit hpi
      , hpgSampleRange= hpiSampleRange hpi
      , hpgValueRange = hpiValueRange hpi
      , hpgSampleTicks= sticks
      , hpgValueTicks = vticks
      , hpgLabels     = labels
      , hpgBands      = bands
      , hpgSamples    = hpiSamples hpi
      }

accumulate :: [[Double]] -> UArray (Int, Int) Double
accumulate [] = error $ "accumulate': empty"
accumulate xss@(x:_) = runSTUArray $ do
  let bands   = length xss
      samples = length x
  a <- newListArray ((0,1),(bands,samples)) $ replicate samples 0 ++ concat xss
  forM_ [1 .. samples] $ \s ->
    forM_ [1 .. bands] $ \b ->
      writeArray a (b, s) =<< liftM2 (+) (readArray a (b - 1, s)) (readArray a (b, s))
  return a

ticks :: Int -> Double -> Double -> [Double]
ticks n mi ma =
  let k = nearestNice $ (ma - mi) / fromIntegral n
      m0 = fromIntegral (ceiling (mi / k) :: Integer) * k
      m1 = fromIntegral (floor   (ma / k) :: Integer) * k
  in  [m0, m0 + k .. m1 ]

nearestNice :: Double -> Double
nearestNice k0 = head . dropWhile (< k0) $ nices

nices :: [Double]
nices = [ f * k | f <- map (10**) [-6 ..], k <- [1,2,5] ]