{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2015
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Numeric.Log.Signed
( SignedLog(..)
) where

import Data.Data (Data(..))
import GHC.Generics (Generic(..))
import Numeric
import Text.Read as T
import Text.Show as T

-- | @Log@-domain @Float@ and @Double@ values, with a sign bit.
data SignedLog a = SLExp { SignedLog a -> Bool
signSL :: Bool, SignedLog a -> a
lnSL :: a} deriving (Typeable (SignedLog a)
DataType
Constr
Typeable (SignedLog a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (SignedLog a))
-> (SignedLog a -> Constr)
-> (SignedLog a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (SignedLog a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (SignedLog a)))
-> ((forall b. Data b => b -> b) -> SignedLog a -> SignedLog a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SignedLog a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SignedLog a -> r)
-> (forall u. (forall d. Data d => d -> u) -> SignedLog a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SignedLog a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a))
-> Data (SignedLog a)
SignedLog a -> DataType
SignedLog a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (SignedLog a))
(forall b. Data b => b -> b) -> SignedLog a -> SignedLog a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SignedLog a)
forall a. Data a => Typeable (SignedLog a)
forall a. Data a => SignedLog a -> DataType
forall a. Data a => SignedLog a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> SignedLog a -> SignedLog a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> SignedLog a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> SignedLog a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SignedLog a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SignedLog a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SignedLog a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SignedLog a -> u
forall u. (forall d. Data d => d -> u) -> SignedLog a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SignedLog a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SignedLog a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SignedLog a))
$cSLExp :: Constr
$tSignedLog :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
gmapMp :: (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
gmapM :: (forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> SignedLog a -> m (SignedLog a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> SignedLog a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> SignedLog a -> u
gmapQ :: (forall d. Data d => d -> u) -> SignedLog a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> SignedLog a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignedLog a -> r
gmapT :: (forall b. Data b => b -> b) -> SignedLog a -> SignedLog a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> SignedLog a -> SignedLog a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SignedLog a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SignedLog a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (SignedLog a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SignedLog a))
dataTypeOf :: SignedLog a -> DataType
$cdataTypeOf :: forall a. Data a => SignedLog a -> DataType
toConstr :: SignedLog a -> Constr
$ctoConstr :: forall a. Data a => SignedLog a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SignedLog a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SignedLog a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignedLog a -> c (SignedLog a)
$cp1Data :: forall a. Data a => Typeable (SignedLog a)
Data, (forall x. SignedLog a -> Rep (SignedLog a) x)
-> (forall x. Rep (SignedLog a) x -> SignedLog a)
-> Generic (SignedLog a)
forall x. Rep (SignedLog a) x -> SignedLog a
forall x. SignedLog a -> Rep (SignedLog a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SignedLog a) x -> SignedLog a
forall a x. SignedLog a -> Rep (SignedLog a) x
$cto :: forall a x. Rep (SignedLog a) x -> SignedLog a
$cfrom :: forall a x. SignedLog a -> Rep (SignedLog a) x
Generic)

negInf :: Fractional a => a
negInf :: a
negInf = (-a
1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0

nan :: Fractional a => a
nan :: a
nan = a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0

multSign :: (Num a) => Bool -> a -> a
multSign :: Bool -> a -> a
multSign Bool
True = a -> a
forall a. a -> a
id
multSign Bool
False = a -> a -> a
forall a. Num a => a -> a -> a
(*) (-a
1)

-- $SignedLogCompTests
--
-- >>> (-7) < (3 :: SignedLog Double)
-- True
--
-- >>> 0 == (0 :: SignedLog Double)
-- True

instance (Eq a, Fractional a) => Eq (SignedLog a) where
  (SLExp Bool
sA a
a) == :: SignedLog a -> SignedLog a -> Bool
== (SLExp Bool
sB a
b) = (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b) Bool -> Bool -> Bool
&& (Bool
sA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
sB Bool -> Bool -> Bool
|| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Fractional a => a
negInf)

-- Does not necissarily handle NaNs in the same way as 'a' for >=, etc.
instance (Ord a, Fractional a) => Ord (SignedLog a) where
  compare :: SignedLog a -> SignedLog a -> Ordering
compare (SLExp Bool
_ a
a) (SLExp Bool
_ a
b) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Fractional a => a
negInf = Ordering
EQ
  compare (SLExp Bool
sA a
a) (SLExp Bool
sB a
b) = Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
mappend (Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
sA Bool
sB) (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- $SignedLogShowTests
--
-- >>> show (-0 :: SignedLog Double)
-- "0.0"
--
-- >>> show (1 :: SignedLog Double)
-- "1.0"
--
-- >>> show (-1 :: SignedLog Double)
-- "-1.0"

instance (Show a, RealFloat a, Eq a, Fractional a) => Show (SignedLog a) where
  showsPrec :: Int -> SignedLog a -> ShowS
showsPrec Int
d (SLExp Bool
s a
a) = (if Bool -> Bool
not Bool
s Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Fractional a => a
negInf Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
a) then Char -> ShowS
T.showChar Char
'-' else ShowS
forall a. a -> a
id) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
T.showsPrec Int
d (a -> a
forall a. Floating a => a -> a
exp a
a)

instance (RealFloat a, Read a) => Read (SignedLog a) where
  readPrec :: ReadPrec (SignedLog a)
readPrec = (a -> SignedLog a
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: a -> SignedLog a) (a -> SignedLog a) -> ReadPrec a -> ReadPrec (SignedLog a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
forall a. Read a => ReadPrec a
T.readPrec

nxor :: Bool -> Bool -> Bool
nxor :: Bool -> Bool -> Bool
nxor = Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- $SignedLogNumTests
--
-- Repeating internals, add testing function (~=)
--
-- >>> let nxor = (==)
-- >>> let multSign b = if b then id else (*) (-1)
--
-- >>> let SLExp sX x ~= SLExp sY y = abs ((exp x-(multSign (nxor sX sY) (exp y))) / exp x) < 0.01
--
-- Subtraction
--
-- >>> (3 - 1 :: SignedLog Double) ~= 2
-- True
--
-- >>> (1 - 3 :: SignedLog Double) ~= (-2)
-- True
--
-- >>> (3 - 2 :: SignedLog Float) ~= 1
-- True
--
-- >>> (1 - 3 :: SignedLog Float) ~= (-2)
-- True
--
-- >>> SLExp True (1/0) - SLExp True (1/0) :: SignedLog Double
-- NaN
--
-- >>> 0 - 0 :: SignedLog Double
-- 0.0
--
-- >>> 0 - SLExp True (1/0) :: SignedLog Double
-- -Infinity
--
-- >>> SLExp True (1/0) - 0.0 :: SignedLog Double
-- Infinity
--
-- Multiplication
--
-- >>> (3 * 2 :: SignedLog Double) ~= 6
-- True
--
-- >>> 0 * SLExp True (1/0) :: SignedLog Double
-- NaN
--
-- >>> SLExp True (1/0) * SLExp True (1/0) :: SignedLog Double
-- Infinity
--
-- >>> 0 * 0 :: SignedLog Double
-- 0.0
--
-- >>> SLExp True (0/0) * 0 :: SignedLog Double
-- NaN
--
-- >>> SLExp True (0/0) * SLExp True (1/0) :: SignedLog Double
-- NaN
--
-- Addition
--
-- >>> (3 + 1 :: SignedLog Double) ~= 4
-- True
--
-- >>> 0 + 0 :: SignedLog Double
-- 0.0
--
-- >>> SLExp True (1/0) + SLExp True (1/0) :: SignedLog Double
-- Infinity
--
-- >>> SLExp True (1/0) + 0 :: SignedLog Double
-- Infinity
--
-- Division
--
-- >>> (3 / 2 :: SignedLog Double) ~= 1.5
-- True
--
-- >>> 3 / 0 :: SignedLog Double
-- Infinity
--
-- >>> SLExp True (1/0) / 0 :: SignedLog Double
-- Infinity
--
-- >>> 0 / SLExp True (1/0) :: SignedLog Double
-- 0.0
--
-- >>> SLExp True (1/0) / SLExp True (1/0) :: SignedLog Double
-- NaN
--
-- >>> 0 / 0 :: SignedLog Double
-- NaN
--
-- Negation
--
-- >>> ((-3) + 8 :: SignedLog Double) ~= 8
-- False
--
-- >>> (-0) :: SignedLog Double
-- 0.0
--
-- >>> (-(0/0)) :: SignedLog Double
-- NaN
--
-- Signum
--
-- >>> signum 0 :: SignedLog Double
-- 0.0
--
-- >>> signum 3 :: SignedLog Double
-- 1.0
--
-- >>> signum (SLExp True (0/0)) :: SignedLog Double
-- NaN

instance RealFloat a => Num (SignedLog a) where
  SLExp Bool
sA a
a * :: SignedLog a -> SignedLog a -> SignedLog a
* SLExp Bool
sB a
b = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (Bool -> Bool -> Bool
nxor Bool
sA Bool
sB) (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b)
  {-# INLINE (*) #-}
  SLExp Bool
sA a
a + :: SignedLog a -> SignedLog a -> SignedLog a
+ SLExp Bool
sB a
b
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| Bool -> Bool -> Bool
nxor Bool
sA Bool
sB) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True a
a
    | Bool
sA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
sB Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b     = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sA (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1pexp (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a))
    | Bool
sA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
sB Bool -> Bool -> Bool
&& Bool
otherwise  = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sA (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1pexp (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b))
    | Bool
sA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
sB Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True a
forall a. Fractional a => a
negInf
    | Bool
sA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
sB Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b      = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sA (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1mexp (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a))
    | Bool
otherwise              = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sB (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1mexp (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b))
  {-# INLINE (+) #-}
  abs :: SignedLog a -> SignedLog a
abs (SLExp Bool
_ a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True a
a
  {-# INLINE abs #-}
  signum :: SignedLog a -> SignedLog a
signum (SLExp Bool
sA a
a)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True a
forall a. Fractional a => a
negInf
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
a = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True a
forall a. Fractional a => a
nan -- signum(0/0::Double) == -1.0, this doesn't seem like a behavior worth replicating.
    | Bool
otherwise = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sA a
0
  {-# INLINE signum #-}
  fromInteger :: Integer -> SignedLog a
fromInteger Integer
i = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0) (a -> SignedLog a) -> a -> SignedLog a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
  {-# INLINE fromInteger #-}
  negate :: SignedLog a -> SignedLog a
negate (SLExp Bool
sA a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (Bool -> Bool
not Bool
sA) a
a
  {-# INLINE negate #-}

instance RealFloat a => Fractional (SignedLog a) where
  SLExp Bool
sA a
a / :: SignedLog a -> SignedLog a -> SignedLog a
/ SLExp Bool
sB a
b = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (Bool -> Bool -> Bool
nxor Bool
sA Bool
sB) (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
b)
  {-# INLINE (/) #-}
  fromRational :: Rational -> SignedLog a
fromRational Rational
a = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (Rational
a Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0) (a -> SignedLog a) -> a -> SignedLog a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Num a => a -> a
abs Rational
a
  {-# INLINE fromRational #-}

-- $SignedLogToRationalTest
--
-- >>> (toRational (-3.5 :: SignedLog Double))
-- (-7) % 2

instance (RealFloat a, Ord a) => Real (SignedLog a) where
  toRational :: SignedLog a -> Rational
toRational (SLExp Bool
sA a
a) = a -> Rational
forall a. Real a => a -> Rational
toRational (a -> Rational) -> a -> Rational
forall a b. (a -> b) -> a -> b
$ Bool -> a -> a
forall a. Num a => Bool -> a -> a
multSign Bool
sA (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
exp a
a
  {-# INLINE toRational #-}

logMap :: (Floating a, Ord a) => (a -> a) -> SignedLog a -> SignedLog a
logMap :: (a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
f (SLExp Bool
sA a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0) (a -> SignedLog a) -> a -> SignedLog a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
value
  where value :: a
value = a -> a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Bool -> a -> a
forall a. Num a => Bool -> a -> a
multSign Bool
sA (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
exp a
a
{-# INLINE logMap #-}

instance RealFloat a => Floating (SignedLog a) where
  pi :: SignedLog a
pi = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True (a -> a
forall a. Floating a => a -> a
log a
forall a. Floating a => a
pi)
  {-# INLINE pi #-}
  exp :: SignedLog a -> SignedLog a
exp (SLExp Bool
sA a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True (Bool -> a -> a
forall a. Num a => Bool -> a -> a
multSign Bool
sA (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
exp a
a)
  {-# INLINE exp #-}
  log :: SignedLog a -> SignedLog a
log (SLExp Bool
True a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0) (a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
a)
  log (SLExp Bool
False a
_) = SignedLog a
forall a. Fractional a => a
nan
  {-# INLINE log #-}
  (SLExp Bool
sB a
b) ** :: SignedLog a -> SignedLog a -> SignedLog a
** (SLExp Bool
sE a
e) | Bool
sB Bool -> Bool -> Bool
|| a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
e = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sB (a
b a -> a -> a
forall a. Num a => a -> a -> a
* Bool -> a -> a
forall a. Num a => Bool -> a -> a
multSign Bool
sE (a -> a
forall a. Floating a => a -> a
exp a
e))
  SignedLog a
_ ** SignedLog a
_ = SignedLog a
forall a. Fractional a => a
nan
  {-# INLINE (**) #-}
  sqrt :: SignedLog a -> SignedLog a
sqrt (SLExp Bool
True a
a) = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
True (a
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
  sqrt (SLExp Bool
False a
_) = SignedLog a
forall a. Fractional a => a
nan
  {-# INLINE sqrt #-}
  logBase :: SignedLog a -> SignedLog a -> SignedLog a
logBase slA :: SignedLog a
slA@(SLExp Bool
_ a
a) slB :: SignedLog a
slB@(SLExp Bool
_ a
b) | SignedLog a
slA SignedLog a -> SignedLog a -> Bool
forall a. Ord a => a -> a -> Bool
>= SignedLog a
0 Bool -> Bool -> Bool
&& SignedLog a
slB SignedLog a -> SignedLog a -> Bool
forall a. Ord a => a -> a -> Bool
>= SignedLog a
0 = Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp (a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0) (a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
value)
    where value :: a
value = a -> a -> a
forall a. Floating a => a -> a -> a
logBase (a -> a
forall a. Floating a => a -> a
exp a
a) (a -> a
forall a. Floating a => a -> a
exp a
b)
  logBase SignedLog a
_ SignedLog a
_ = SignedLog a
forall a. Fractional a => a
nan
  {-# INLINE logBase #-}
  sin :: SignedLog a -> SignedLog a
sin = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
sin
  {-# INLINE sin #-}
  cos :: SignedLog a -> SignedLog a
cos = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
cos
  {-# INLINE cos #-}
  tan :: SignedLog a -> SignedLog a
tan = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
tan
  {-# INLINE tan #-}
  asin :: SignedLog a -> SignedLog a
asin = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
asin
  {-# INLINE asin #-}
  acos :: SignedLog a -> SignedLog a
acos = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
acos
  {-# INLINE acos #-}
  atan :: SignedLog a -> SignedLog a
atan = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
atan
  {-# INLINE atan #-}
  sinh :: SignedLog a -> SignedLog a
sinh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
sinh
  {-# INLINE sinh #-}
  cosh :: SignedLog a -> SignedLog a
cosh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
cosh
  {-# INLINE cosh #-}
  tanh :: SignedLog a -> SignedLog a
tanh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
tanh
  {-# INLINE tanh #-}
  asinh :: SignedLog a -> SignedLog a
asinh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
asinh
  {-# INLINE asinh #-}
  acosh :: SignedLog a -> SignedLog a
acosh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
acosh
  {-# INLINE acosh #-}
  atanh :: SignedLog a -> SignedLog a
atanh = (a -> a) -> SignedLog a -> SignedLog a
forall a.
(Floating a, Ord a) =>
(a -> a) -> SignedLog a -> SignedLog a
logMap a -> a
forall a. Floating a => a -> a
atanh
  {-# INLINE atanh #-}

-- $SignedLogProperFractionTests
--
-- >>> (properFraction (-1.5) :: (Integer, SignedLog Double))
-- (-1,-0.5)
--
-- >>> (properFraction (-0.5) :: (Integer, SignedLog Double))
-- (0,-0.5)

instance RealFloat a => RealFrac (SignedLog a) where
  properFraction :: SignedLog a -> (b, SignedLog a)
properFraction slX :: SignedLog a
slX@(SLExp Bool
sX a
x)
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = (b
0, SignedLog a
slX)
    | Bool
otherwise = case a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (a -> (b, a)) -> a -> (b, a)
forall a b. (a -> b) -> a -> b
$ Bool -> a -> a
forall a. Num a => Bool -> a -> a
multSign Bool
sX (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
exp a
x of
      (b
b,a
a) -> (b
b, Bool -> a -> SignedLog a
forall a. Bool -> a -> SignedLog a
SLExp Bool
sX (a -> SignedLog a) -> a -> SignedLog a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
a)