{-|
    Module      :  AERN2.Norm
    Description :  Rough logarithmic norm
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable
-}
module AERN2.Norm
(
    HasNorm(..), NormLog(..), invertNormLog
)
where

import MixedTypesNumPrelude
import qualified Prelude as P

import Data.Complex

import Math.NumberTheory.Logarithms (integerLog2)


class HasNorm a where
    {-|
        For a value @x@, return @NormBits j@ where @j@ is close
        to the smallest @i@ with @|x| <= 2^i@.
        If @x == 0@ then return @NormZero@.
    -}
    getNormLog :: a -> NormLog

data NormLog
    = NormZero -- ^ ie NormBits (-infinity)
    | NormBits Integer
    deriving (NormLog -> NormLog -> Bool
(NormLog -> NormLog -> Bool)
-> (NormLog -> NormLog -> Bool) -> Eq NormLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormLog -> NormLog -> Bool
$c/= :: NormLog -> NormLog -> Bool
== :: NormLog -> NormLog -> Bool
$c== :: NormLog -> NormLog -> Bool
P.Eq, Eq NormLog
Eq NormLog
-> (NormLog -> NormLog -> Ordering)
-> (NormLog -> NormLog -> Bool)
-> (NormLog -> NormLog -> Bool)
-> (NormLog -> NormLog -> Bool)
-> (NormLog -> NormLog -> Bool)
-> (NormLog -> NormLog -> NormLog)
-> (NormLog -> NormLog -> NormLog)
-> Ord NormLog
NormLog -> NormLog -> Bool
NormLog -> NormLog -> Ordering
NormLog -> NormLog -> NormLog
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NormLog -> NormLog -> NormLog
$cmin :: NormLog -> NormLog -> NormLog
max :: NormLog -> NormLog -> NormLog
$cmax :: NormLog -> NormLog -> NormLog
>= :: NormLog -> NormLog -> Bool
$c>= :: NormLog -> NormLog -> Bool
> :: NormLog -> NormLog -> Bool
$c> :: NormLog -> NormLog -> Bool
<= :: NormLog -> NormLog -> Bool
$c<= :: NormLog -> NormLog -> Bool
< :: NormLog -> NormLog -> Bool
$c< :: NormLog -> NormLog -> Bool
compare :: NormLog -> NormLog -> Ordering
$ccompare :: NormLog -> NormLog -> Ordering
$cp1Ord :: Eq NormLog
P.Ord, Int -> NormLog -> ShowS
[NormLog] -> ShowS
NormLog -> String
(Int -> NormLog -> ShowS)
-> (NormLog -> String) -> ([NormLog] -> ShowS) -> Show NormLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormLog] -> ShowS
$cshowList :: [NormLog] -> ShowS
show :: NormLog -> String
$cshow :: NormLog -> String
showsPrec :: Int -> NormLog -> ShowS
$cshowsPrec :: Int -> NormLog -> ShowS
Show)

instance HasEqAsymmetric NormLog NormLog
instance HasOrderAsymmetric NormLog NormLog
instance CanMinMaxAsymmetric NormLog NormLog

invertNormLog :: NormLog -> NormLog
invertNormLog :: NormLog -> NormLog
invertNormLog NormLog
NormZero = String -> NormLog
forall a. HasCallStack => String -> a
error String
"cannot invert NormZero"
invertNormLog (NormBits Integer
b) = Integer -> NormLog
NormBits (-Integer
b)

instance HasNorm Integer where
    getNormLog :: Integer -> NormLog
getNormLog Integer
n
        | Integer
n Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = NormLog
NormZero
        | Integer -> AbsType Integer
forall t. CanAbs t => t -> AbsType t
abs Integer
n Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 = Integer -> NormLog
NormBits Integer
0
        | Bool
otherwise = Integer -> NormLog
NormBits (Integer -> NormLog) -> Integer -> NormLog
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog2 (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> AbsType Integer
forall t. CanAbs t => t -> AbsType t
abs Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1)

instance HasNorm Int where
    getNormLog :: Int -> NormLog
getNormLog = Integer -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog (Integer -> NormLog) -> (Int -> Integer) -> Int -> NormLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer

instance HasNorm Rational where
    getNormLog :: Rational -> NormLog
getNormLog Rational
x
        | Rational
x Rational -> Rational -> EqCompareType Rational Rational
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Rational
0.0 = NormLog
NormZero
        | Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs Rational
x Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
1.0 = Integer -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog (Integer -> NormLog) -> Integer -> NormLog
forall a b. (a -> b) -> a -> b
$ Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling (Rational -> RoundType Rational) -> Rational -> RoundType Rational
forall a b. (a -> b) -> a -> b
$ Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs Rational
x
        | Bool
otherwise = Integer -> NormLog
NormBits (Integer -> NormLog) -> Integer -> NormLog
forall a b. (a -> b) -> a -> b
$ Integer -> NegType Integer
forall t. CanNeg t => t -> NegType t
negate (Integer -> NegType Integer) -> Integer -> NegType Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog2 (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor (Rational -> RoundType Rational) -> Rational -> RoundType Rational
forall a b. (a -> b) -> a -> b
$ (Integer
1 Integer -> Rational -> DivType Integer Rational
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs Rational
x))

instance
  (HasNorm t)
  =>
  HasNorm (Complex t)
  where
  getNormLog :: Complex t -> NormLog
getNormLog (t
a :+ t
i) =
    (t -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog t
a) NormLog -> NormLog -> MinMaxType NormLog NormLog
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (t -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog t
i)

instance CanAddAsymmetric NormLog Integer where
    type AddType NormLog Integer = NormLog
    add :: NormLog -> Integer -> AddType NormLog Integer
add NormLog
NormZero Integer
_ = AddType NormLog Integer
NormLog
NormZero
    add (NormBits Integer
b) Integer
n = Integer -> NormLog
NormBits (Integer
bInteger -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
n)

instance CanAddAsymmetric Integer NormLog where
    type AddType Integer NormLog = NormLog
    add :: Integer -> NormLog -> AddType Integer NormLog
add Integer
_ NormLog
NormZero = AddType Integer NormLog
NormLog
NormZero
    add Integer
n (NormBits Integer
b) = Integer -> NormLog
NormBits (Integer
bInteger -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
n)

instance CanSub NormLog Integer where
    type SubType NormLog Integer = NormLog
    sub :: NormLog -> Integer -> SubType NormLog Integer
sub NormLog
NormZero Integer
_ = SubType NormLog Integer
NormLog
NormZero
    sub (NormBits Integer
b) Integer
n = Integer -> NormLog
NormBits (Integer
bInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
n)