-- | This module provides functions for calculating the natural logarithms in
--   a way useful for creating logarithmic Bytesizes
module Data.Tensort.Utils.LogNat (getLnBytesize, getLn) where

import Data.Tensort.Utils.Types (Sortable (..))

-- | Calculate a suitable logarithmic Bytesize from a Sortable

-- | ==== __Examples__
-- >>> getLnBytesize (SortBit [1 .. 27])
-- 4
--
-- >>> getLnBytesize  (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)])
-- 2
getLnBytesize :: Sortable -> Int
getLnBytesize :: Sortable -> Int
getLnBytesize (SortBit [Int]
xs) = Int -> Int
getLn ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)
getLnBytesize (SortRec [Record]
xs) = Int -> Int
getLn ([Record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Record]
xs)

-- | Calculate a the natural logarithm of an Int, rounded up to the nearest
--   integer
--
-- | ==== __Examples__
-- >>> getLn 27
-- 4
getLn :: Int -> Int
getLn :: Int -> Int
getLn Int
x = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double
forall a. Floating a => a -> a
log (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) :: Double)