{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-cse #-}
{-# OPTIONS_GHC -fno-full-laziness #-}
{-# OPTIONS_GHC -fno-float-in #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}

#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
#endif

--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2015
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Data.HyperLogLog.Config
  (
  -- * Config
    numBuckets
  , smallRange
  , interRange
  , rawFact
  , alpha
  , bucketMask
  -- * Rank
  , Rank
  , calcBucket
  , calcRank
  , lim32
  ) where

import Data.Binary
import Data.Bits
import Data.Bits.Extras
import Data.Vector.Serialize ()
import GHC.Int
#if __GLASGOW_HASKELL__ < 710
import GHC.Word
#endif

type Rank = Int8

------------------------------------------------------------------------------
-- Config
------------------------------------------------------------------------------

lim32 :: Double
lim32 :: Double
lim32 = Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Bits a => Int -> a
bit Int
32)
{-# INLINE lim32 #-}

numBuckets :: Integer -> Int
numBuckets :: Integer -> Int
numBuckets Integer
b = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL Int
1 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
{-# INLINE numBuckets #-}

smallRange :: Integer -> Double
smallRange :: Integer -> Double
smallRange Integer
b = Double
5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
numBuckets Integer
b)
{-# INLINE smallRange #-}

interRange :: Double
interRange :: Double
interRange = Double
lim32 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
30
{-# INLINE interRange #-}

rawFact :: Integer -> Double
rawFact :: Integer -> Double
rawFact Integer
b = Integer -> Double
alpha Integer
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m where
  m :: Double
m = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
numBuckets Integer
b)
{-# INLINE rawFact #-}

alpha :: Integer -> Double
alpha :: Integer -> Double
alpha Integer
b = Double
0.7213 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.079 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
numBuckets Integer
b))
{-# INLINE alpha #-}

bucketMask :: Integer -> Word32
bucketMask :: Integer -> Word32
bucketMask Integer
b = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
numBuckets Integer
b) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1

------------------------------------------------------------------------------
-- Util
------------------------------------------------------------------------------

calcBucket :: Integer -> Word32 -> Int
calcBucket :: Integer -> Word32 -> Int
calcBucket Integer
t Word32
w = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Integer -> Word32
bucketMask Integer
t)
{-# INLINE calcBucket #-}

calcRank :: Integer -> Word32 -> Int8
calcRank :: Integer -> Word32 -> Int8
calcRank Integer
t Word32
w = Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> Int -> Int8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall t. Ranked t => t -> Int
rank (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t
{-# INLINE calcRank #-}