gistfile1.hs

module Histogram
       where

import Data.Array

data Histogram = Histogram { 
  numBuckets :: Int
  , histStep :: Int
  , histBuckets :: Array Int Int
  , histBounds :: Array Int Int
  , histSize :: Int
  } deriving (Show)
                 
mkHistogram :: Int -> Int -> Histogram
mkHistogram nb s = Histogram {
  numBuckets = nb
  , histStep = s
  , histBuckets = listArray (0, nb - 1) (replicate nb 0)
  , histBounds = mkBounds nb s
  , histSize = 0
  }
    
mkBounds :: Int -> Int -> Array Int Int
mkBounds nb s = listArray (0, nb - 1) (map (* s) [0..(nb - 1)])
                         
reset :: Histogram -> Histogram                
reset h@Histogram { numBuckets = nb } = h { 
  histBuckets = listArray (0, nb) (replicate nb 0)
  , histSize = 0
  } 
          
getQuantile :: Histogram -> Double -> Int
getQuantile h quantile = loop 0 0
  where
    nb = numBuckets h 
    buckets = histBuckets h
    hs = histSize h
    bounds = histBounds h
    loop total i 
      | i == nb = 0
      | otherwise = 
        if (currQuantile >= quantile) then  bounds ! i
        else loop (total + (buckets ! i)) (i + 1) 
          where
            currQuantile = (fromIntegral total) / (fromIntegral hs)
                        
insert :: Histogram -> Int -> Histogram
insert h@Histogram { histBuckets = hb, histSize = hs } datum =  h {
  histBuckets = hb // [(idx, curr + 1)]
  , histSize = hs + 1 
  } where curr = hb ! idx
          idx = findBucket h datum
          
findBucket :: Histogram -> Int -> Int
findBucket h datum =
  if (datum > s * nb) then nb - 1
  else loop 0 (nb - 1) 
    where
      s = histStep h
      nb = numBuckets h
      loop low high 
        | low > high = -1
        | otherwise = 
          case cmp of 
            EQ -> mid
            GT -> loop low (mid - 1)
            LT -> loop (mid + 1) high
            where mid = (low + high) `div` 2
                  cmp = compareToBucket h mid datum
         
compareToBucket :: Histogram -> Int -> Int -> Ordering
compareToBucket h bucket datum = 
  if (low <= datum && high > datum) then EQ
  else if (low > datum) then GT
       else LT
    where
      low = (histBounds h) ! bucket
      high = low + (histStep h)