{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
module Numeric.Logarithms
(
log2Floor, log2Ceiling
, log2Approx, log2With
, ilog2Floor, ilog2Ceiling
, ilog2Approx, ilog2With
) where
import Data.Bits (bit)
import Data.Ratio (denominator, numerator)
import GHC.Exts (Int(I#))
import GHC.Integer (shiftLInteger)
import GHC.Integer.Logarithms (integerLog2#)
import GHC.Stack (HasCallStack)
integerLog2Floor :: Integer -> Int
integerLog2Floor :: Integer -> Int
integerLog2Floor Integer
x = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
x)
{-# INLINE splitLog2Unchecked #-}
splitLog2Unchecked :: Integer -> Integer -> (Int, Integer, Integer)
splitLog2Unchecked :: Integer -> Integer -> (Int, Integer, Integer)
splitLog2Unchecked Integer
num Integer
den = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m, Integer
num', Integer
den')
where
n :: Int
n = Integer -> Int
integerLog2Floor Integer
num
m :: Int
m = Integer -> Int
integerLog2Floor Integer
den
shl :: Integer -> Int -> Integer
shl Integer
x (I# Int#
s) = Integer -> Int# -> Integer
shiftLInteger Integer
x Int#
s
(Integer
num', Integer
den') = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
then (Integer
num Integer -> Int -> Integer
`shl` (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n), Integer
den)
else (Integer
num, Integer
den Integer -> Int -> Integer
`shl` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m))
{-# INLINE log2Unchecked #-}
log2Unchecked :: Integer -> Integer -> (Int, Ordering)
log2Unchecked :: Integer -> Integer -> (Int, Ordering)
log2Unchecked Integer
num Integer
den =
let (Int
lg, Integer
num', Integer
den') = Integer -> Integer -> (Int, Integer, Integer)
splitLog2Unchecked Integer
num Integer
den
in (Int
lg, Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
num' Integer
den')
{-# INLINE log2Approx_ #-}
log2Approx_ :: (HasCallStack, Real a) => a -> (Int, Ordering)
log2Approx_ :: a -> (Int, Ordering)
log2Approx_ a
x =
let !xr :: Rational
xr = a -> Rational
forall a. Real a => a -> Rational
toRational a
x
!num :: Integer
num = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
xr
!den :: Integer
den = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
xr
in if Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
then [Char] -> (Int, Ordering)
forall a. HasCallStack => [Char] -> a
error [Char]
"log2With_: x <= 0"
else Integer -> Integer -> (Int, Ordering)
log2Unchecked Integer
num Integer
den
{-# INLINE log2With_ #-}
log2With_ :: (HasCallStack, Real a) => (Int -> Ordering -> Int) -> a -> Int
log2With_ :: (Int -> Ordering -> Int) -> a -> Int
log2With_ Int -> Ordering -> Int
adj a
x =
let !(Int
lg, Ordering
cmp) = a -> (Int, Ordering)
forall a. (HasCallStack, Real a) => a -> (Int, Ordering)
log2Approx_ a
x
in Int -> Ordering -> Int
adj Int
lg Ordering
cmp
log2Approx :: (HasCallStack, Real a) => a -> (Int, Ordering)
log2Approx :: a -> (Int, Ordering)
log2Approx = a -> (Int, Ordering)
forall a. (HasCallStack, Real a) => a -> (Int, Ordering)
log2Approx_
log2With :: (HasCallStack, Real a) => (Int -> Ordering -> Int) -> a -> Int
log2With :: (Int -> Ordering -> Int) -> a -> Int
log2With = (Int -> Ordering -> Int) -> a -> Int
forall a.
(HasCallStack, Real a) =>
(Int -> Ordering -> Int) -> a -> Int
log2With_
log2Floor :: (HasCallStack, Real a) => a -> Int
log2Floor :: a -> Int
log2Floor = (Int -> Ordering -> Int) -> a -> Int
forall a.
(HasCallStack, Real a) =>
(Int -> Ordering -> Int) -> a -> Int
log2With_ (\Int
x -> \case Ordering
LT -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1; Ordering
_ -> Int
x)
log2Ceiling :: (HasCallStack, Real a) => a -> Int
log2Ceiling :: a -> Int
log2Ceiling = (Int -> Ordering -> Int) -> a -> Int
forall a.
(HasCallStack, Real a) =>
(Int -> Ordering -> Int) -> a -> Int
log2With_ (\Int
x -> \case Ordering
GT -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1; Ordering
_ -> Int
x)
{-# INLINE withPositiveInteger #-}
withPositiveInteger :: HasCallStack => (Integer -> r) -> Integer -> r
withPositiveInteger :: (Integer -> r) -> Integer -> r
withPositiveInteger Integer -> r
f Integer
x = if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
then [Char] -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"withPositiveInteger: x <= 0"
else Integer -> r
f Integer
x
{-# INLINABLE ilog2Floor #-}
ilog2Floor :: (HasCallStack, Integral a) => a -> Int
ilog2Floor :: a -> Int
ilog2Floor a
x = (Integer -> Int) -> Integer -> Int
forall r. HasCallStack => (Integer -> r) -> Integer -> r
withPositiveInteger Integer -> Int
integerLog2Floor (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x)
{-# INLINABLE ilog2Ceiling #-}
ilog2Ceiling :: (HasCallStack, Integral a) => a -> Int
ilog2Ceiling :: a -> Int
ilog2Ceiling = (Int -> Ordering -> Int) -> a -> Int
forall a.
(HasCallStack, Integral a) =>
(Int -> Ordering -> Int) -> a -> Int
ilog2With (\Int
x -> \case Ordering
GT -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1; Ordering
_ -> Int
x)
{-# INLINABLE ilog2Approx #-}
ilog2Approx :: (HasCallStack, Integral a) => a -> (Int, Ordering)
ilog2Approx :: a -> (Int, Ordering)
ilog2Approx a
x = (Integer -> (Int, Ordering)) -> Integer -> (Int, Ordering)
forall r. HasCallStack => (Integer -> r) -> Integer -> r
withPositiveInteger
(\Integer
xi ->
let lg :: Int
lg = Integer -> Int
integerLog2Floor Integer
xi
in (Int
lg, if Integer
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Bits a => Int -> a
bit Int
lg then Ordering
GT else Ordering
EQ))
(a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x)
{-# INLINABLE ilog2With #-}
ilog2With :: (HasCallStack, Integral a) => (Int -> Ordering -> Int) -> a -> Int
ilog2With :: (Int -> Ordering -> Int) -> a -> Int
ilog2With Int -> Ordering -> Int
adj a
x =
let !(Int
lg, Ordering
cmp) = a -> (Int, Ordering)
forall a. (HasCallStack, Integral a) => a -> (Int, Ordering)
ilog2Approx a
x
in Int -> Ordering -> Int
adj Int
lg Ordering
cmp