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) [i * s | i <- [0..(nb - 1)]]
                         
reset :: Histogram -> Histogram                
reset h@Histogram { numBuckets = nb } = h { 
  histBuckets = listArray (0, nb - 1) (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
      | currQuantile >= quantile = bounds ! i
      | otherwise = 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 
  | datum > s * nb = nb - 1
  | otherwise = 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 
  | low <= datum && high > datum = EQ
  | low > datum = GT
  | otherwise = LT
    where
      low = histBounds h ! bucket
      high = low + histStep h