{-# LANGUAGE CPP #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Data.Approximate.Type
  ( Approximate(Approximate)
  , HasApproximate(..)
  , exact
  , zero
  , one
  , withMin, withMax
  ) where

import Control.Applicative
import Control.DeepSeq
import Control.Lens
import Control.Monad
import Data.Binary as Binary
import Data.Bytes.Serial as Bytes
import Data.Copointed
import Data.Data
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
#endif
import Data.Functor.Apply
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..))
import Data.Monoid
import Data.Pointed
import Data.SafeCopy
import Data.Serialize as Serialize
import Data.Vector.Generic as G
import Data.Vector.Generic.Mutable as M
import Data.Vector.Unboxed as U
import GHC.Generics
import Numeric.Log

-- | An approximate number, with a likely interval, an expected value and a lower bound on the @log@ of probability that the answer falls in the interval.
--
-- /NB:/ The probabilities associated with confidence are stored in the @log@ domain.
data Approximate a = Approximate
  { Approximate a -> Log Double
_confidence :: {-# UNPACK #-} !(Log Double)
  , Approximate a -> a
_lo, Approximate a -> a
_estimate, Approximate a -> a
_hi :: a
  } deriving (Approximate a -> Approximate a -> Bool
(Approximate a -> Approximate a -> Bool)
-> (Approximate a -> Approximate a -> Bool) -> Eq (Approximate a)
forall a. Eq a => Approximate a -> Approximate a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Approximate a -> Approximate a -> Bool
$c/= :: forall a. Eq a => Approximate a -> Approximate a -> Bool
== :: Approximate a -> Approximate a -> Bool
$c== :: forall a. Eq a => Approximate a -> Approximate a -> Bool
Eq,Int -> Approximate a -> ShowS
[Approximate a] -> ShowS
Approximate a -> String
(Int -> Approximate a -> ShowS)
-> (Approximate a -> String)
-> ([Approximate a] -> ShowS)
-> Show (Approximate a)
forall a. Show a => Int -> Approximate a -> ShowS
forall a. Show a => [Approximate a] -> ShowS
forall a. Show a => Approximate a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Approximate a] -> ShowS
$cshowList :: forall a. Show a => [Approximate a] -> ShowS
show :: Approximate a -> String
$cshow :: forall a. Show a => Approximate a -> String
showsPrec :: Int -> Approximate a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Approximate a -> ShowS
Show,ReadPrec [Approximate a]
ReadPrec (Approximate a)
Int -> ReadS (Approximate a)
ReadS [Approximate a]
(Int -> ReadS (Approximate a))
-> ReadS [Approximate a]
-> ReadPrec (Approximate a)
-> ReadPrec [Approximate a]
-> Read (Approximate a)
forall a. Read a => ReadPrec [Approximate a]
forall a. Read a => ReadPrec (Approximate a)
forall a. Read a => Int -> ReadS (Approximate a)
forall a. Read a => ReadS [Approximate a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Approximate a]
$creadListPrec :: forall a. Read a => ReadPrec [Approximate a]
readPrec :: ReadPrec (Approximate a)
$creadPrec :: forall a. Read a => ReadPrec (Approximate a)
readList :: ReadS [Approximate a]
$creadList :: forall a. Read a => ReadS [Approximate a]
readsPrec :: Int -> ReadS (Approximate a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Approximate a)
Read,Typeable,Typeable (Approximate a)
DataType
Constr
Typeable (Approximate a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Approximate a -> c (Approximate a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Approximate a))
-> (Approximate a -> Constr)
-> (Approximate a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Approximate a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Approximate a)))
-> ((forall b. Data b => b -> b) -> Approximate a -> Approximate a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Approximate a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Approximate a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Approximate a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Approximate a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Approximate a -> m (Approximate a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Approximate a -> m (Approximate a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Approximate a -> m (Approximate a))
-> Data (Approximate a)
Approximate a -> DataType
Approximate a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Approximate a))
(forall b. Data b => b -> b) -> Approximate a -> Approximate a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Approximate a -> c (Approximate a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Approximate a)
forall a. Data a => Typeable (Approximate a)
forall a. Data a => Approximate a -> DataType
forall a. Data a => Approximate a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Approximate a -> Approximate a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Approximate a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Approximate a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Approximate a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Approximate a -> c (Approximate a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Approximate a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Approximate 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) -> Approximate a -> u
forall u. (forall d. Data d => d -> u) -> Approximate a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Approximate a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Approximate a -> c (Approximate a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Approximate a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Approximate a))
$cApproximate :: Constr
$tApproximate :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
gmapMp :: (forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
gmapM :: (forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> Approximate a -> m (Approximate a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Approximate a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Approximate a -> u
gmapQ :: (forall d. Data d => d -> u) -> Approximate a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Approximate a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Approximate a -> r
gmapT :: (forall b. Data b => b -> b) -> Approximate a -> Approximate a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Approximate a -> Approximate a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Approximate a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Approximate a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Approximate a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Approximate a))
dataTypeOf :: Approximate a -> DataType
$cdataTypeOf :: forall a. Data a => Approximate a -> DataType
toConstr :: Approximate a -> Constr
$ctoConstr :: forall a. Data a => Approximate a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Approximate a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Approximate a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Approximate a -> c (Approximate a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Approximate a -> c (Approximate a)
$cp1Data :: forall a. Data a => Typeable (Approximate a)
Data,(forall x. Approximate a -> Rep (Approximate a) x)
-> (forall x. Rep (Approximate a) x -> Approximate a)
-> Generic (Approximate a)
forall x. Rep (Approximate a) x -> Approximate a
forall x. Approximate a -> Rep (Approximate a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Approximate a) x -> Approximate a
forall a x. Approximate a -> Rep (Approximate a) x
$cto :: forall a x. Rep (Approximate a) x -> Approximate a
$cfrom :: forall a x. Approximate a -> Rep (Approximate a) x
Generic)

makeClassy ''Approximate

instance Binary a => Binary (Approximate a) where
  put :: Approximate a -> Put
put (Approximate Log Double
p a
l a
m a
h) = Log Double -> Put
forall t. Binary t => t -> Put
Binary.put Log Double
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
Binary.put a
l Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
Binary.put a
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
Binary.put a
h
  get :: Get (Approximate a)
get = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double -> a -> a -> a -> Approximate a)
-> Get (Log Double) -> Get (a -> a -> a -> Approximate a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Log Double)
forall t. Binary t => Get t
Binary.get Get (a -> a -> a -> Approximate a)
-> Get a -> Get (a -> a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
Binary.get Get (a -> a -> Approximate a) -> Get a -> Get (a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
Binary.get Get (a -> Approximate a) -> Get a -> Get (Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
Binary.get

instance Serialize a => Serialize (Approximate a) where
  put :: Putter (Approximate a)
put (Approximate Log Double
p a
l a
m a
h) = Putter (Log Double)
forall t. Serialize t => Putter t
Serialize.put Log Double
p PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall t. Serialize t => Putter t
Serialize.put a
l PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall t. Serialize t => Putter t
Serialize.put a
m PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall t. Serialize t => Putter t
Serialize.put a
h
  get :: Get (Approximate a)
get = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double -> a -> a -> a -> Approximate a)
-> Get (Log Double) -> Get (a -> a -> a -> Approximate a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Log Double)
forall t. Serialize t => Get t
Serialize.get Get (a -> a -> a -> Approximate a)
-> Get a -> Get (a -> a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Serialize t => Get t
Serialize.get Get (a -> a -> Approximate a) -> Get a -> Get (a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Serialize t => Get t
Serialize.get Get (a -> Approximate a) -> Get a -> Get (Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Serialize t => Get t
Serialize.get

instance (Serialize a, Typeable a) => SafeCopy (Approximate a) where
  -- safecopy-0.10.0 changed its default implementations for these methods.
  -- The implementations below are copied from the pre-0.10.0 defaults.
  errorTypeName :: Proxy (Approximate a) -> String
errorTypeName Proxy (Approximate a)
_ = String
"<unknown type>"
  getCopy :: Contained (Get (Approximate a))
getCopy = Get (Approximate a) -> Contained (Get (Approximate a))
forall a. a -> Contained a
contain Get (Approximate a)
forall t. Serialize t => Get t
Serialize.get
  putCopy :: Approximate a -> Contained (PutM ())
putCopy = PutM () -> Contained (PutM ())
forall a. a -> Contained a
contain (PutM () -> Contained (PutM ()))
-> (Approximate a -> PutM ())
-> Approximate a
-> Contained (PutM ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Approximate a -> PutM ()
forall t. Serialize t => Putter t
Serialize.put

instance Hashable a => Hashable (Approximate a)
instance Hashable1 Approximate where
    liftHashWithSalt :: (Int -> a -> Int) -> Int -> Approximate a -> Int
liftHashWithSalt Int -> a -> Int
h Int
s (Approximate Log Double
c a
low a
est a
high) =
        Int -> Log Double -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Log Double
c Int -> a -> Int
`h` a
low Int -> a -> Int
`h` a
est Int -> a -> Int
`h` a
high

instance Serial a => Serial (Approximate a)

instance Serial1 Approximate where
  serializeWith :: (a -> m ()) -> Approximate a -> m ()
serializeWith a -> m ()
f (Approximate Log Double
p a
l a
m a
h) = Log Double -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Log Double
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
l m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
m m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
h
  deserializeWith :: m a -> m (Approximate a)
deserializeWith m a
m = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double -> a -> a -> a -> Approximate a)
-> m (Log Double) -> m (a -> a -> a -> Approximate a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Log Double)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (a -> a -> a -> Approximate a)
-> m a -> m (a -> a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
m m (a -> a -> Approximate a) -> m a -> m (a -> Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
m m (a -> Approximate a) -> m a -> m (Approximate a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
m

-- instance Storable a => Storable (Approximate a) where
--  sizeOf _ = sizeOf (undefined :: Double) + sizeOf (undefined :: a) * 3 --?

instance Unbox a => Unbox (Approximate a)

newtype instance U.MVector s (Approximate a) = MV_Approximate (U.MVector s (Log Double,a,a,a))
newtype instance U.Vector (Approximate a) = V_Approximate (U.Vector (Log Double,a,a,a))

instance Unbox a => M.MVector U.MVector (Approximate a) where
  basicLength :: MVector s (Approximate a) -> Int
basicLength (MV_Approximate v) = MVector s (Log Double, a, a, a) -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s (Log Double, a, a, a)
v
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int
-> Int -> MVector s (Approximate a) -> MVector s (Approximate a)
basicUnsafeSlice Int
i Int
n (MV_Approximate v) = MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
forall s a.
MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
MV_Approximate (MVector s (Log Double, a, a, a) -> MVector s (Approximate a))
-> MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MVector s (Log Double, a, a, a)
-> MVector s (Log Double, a, a, a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s (Log Double, a, a, a)
v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: MVector s (Approximate a) -> MVector s (Approximate a) -> Bool
basicOverlaps (MV_Approximate v1) (MV_Approximate v2) = MVector s (Log Double, a, a, a)
-> MVector s (Log Double, a, a, a) -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s (Log Double, a, a, a)
v1 MVector s (Log Double, a, a, a)
v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (Approximate a))
basicUnsafeNew Int
n = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Approximate a)
forall s a.
MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
MV_Approximate (MVector (PrimState m) (Log Double, a, a, a)
 -> MVector (PrimState m) (Approximate a))
-> m (MVector (PrimState m) (Log Double, a, a, a))
-> m (MVector (PrimState m) (Approximate a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> m (MVector (PrimState m) (Log Double, a, a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeReplicate :: Int -> Approximate a -> m (MVector (PrimState m) (Approximate a))
basicUnsafeReplicate Int
n (Approximate Log Double
p a
l a
m a
h) = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Approximate a)
forall s a.
MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
MV_Approximate (MVector (PrimState m) (Log Double, a, a, a)
 -> MVector (PrimState m) (Approximate a))
-> m (MVector (PrimState m) (Log Double, a, a, a))
-> m (MVector (PrimState m) (Approximate a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int
-> (Log Double, a, a, a)
-> m (MVector (PrimState m) (Log Double, a, a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n (Log Double
p,a
l,a
m,a
h)
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeRead :: MVector (PrimState m) (Approximate a) -> Int -> m (Approximate a)
basicUnsafeRead (MV_Approximate v) Int
i = (\(Log Double
p,a
l,a
m,a
h) -> Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p a
l a
m a
h) ((Log Double, a, a, a) -> Approximate a)
-> m (Log Double, a, a, a) -> m (Approximate a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) (Log Double, a, a, a)
-> Int -> m (Log Double, a, a, a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) (Log Double, a, a, a)
v Int
i
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: MVector (PrimState m) (Approximate a)
-> Int -> Approximate a -> m ()
basicUnsafeWrite (MV_Approximate v) Int
i (Approximate Log Double
p a
l a
m a
h) = MVector (PrimState m) (Log Double, a, a, a)
-> Int -> (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) (Log Double, a, a, a)
v Int
i (Log Double
p,a
l,a
m,a
h)
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: MVector (PrimState m) (Approximate a) -> m ()
basicClear (MV_Approximate v) = MVector (PrimState m) (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) (Log Double, a, a, a)
v
  {-# INLINE basicClear #-}
  basicSet :: MVector (PrimState m) (Approximate a) -> Approximate a -> m ()
basicSet (MV_Approximate v) (Approximate Log Double
p a
l a
m a
h) = MVector (PrimState m) (Log Double, a, a, a)
-> (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) (Log Double, a, a, a)
v (Log Double
p,a
l,a
m,a
h)
  {-# INLINE basicSet #-}
  basicUnsafeCopy :: MVector (PrimState m) (Approximate a)
-> MVector (PrimState m) (Approximate a) -> m ()
basicUnsafeCopy (MV_Approximate v1) (MV_Approximate v2) = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) (Log Double, a, a, a)
v1 MVector (PrimState m) (Log Double, a, a, a)
v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: MVector (PrimState m) (Approximate a)
-> MVector (PrimState m) (Approximate a) -> m ()
basicUnsafeMove (MV_Approximate v1) (MV_Approximate v2) = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) (Log Double, a, a, a)
v1 MVector (PrimState m) (Log Double, a, a, a)
v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: MVector (PrimState m) (Approximate a)
-> Int -> m (MVector (PrimState m) (Approximate a))
basicUnsafeGrow (MV_Approximate v) Int
n = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Approximate a)
forall s a.
MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
MV_Approximate (MVector (PrimState m) (Log Double, a, a, a)
 -> MVector (PrimState m) (Approximate a))
-> m (MVector (PrimState m) (Log Double, a, a, a))
-> m (MVector (PrimState m) (Approximate a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) (Log Double, a, a, a)
-> Int -> m (MVector (PrimState m) (Log Double, a, a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) (Log Double, a, a, a)
v Int
n
  {-# INLINE basicUnsafeGrow #-}
#if MIN_VERSION_vector(0,11,0)
  basicInitialize :: MVector (PrimState m) (Approximate a) -> m ()
basicInitialize (MV_Approximate v) = MVector (PrimState m) (Log Double, a, a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) (Log Double, a, a, a)
v
  {-# INLINE basicInitialize #-}
#endif

instance Unbox a => G.Vector U.Vector (Approximate a) where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (Approximate a)
-> m (Vector (Approximate a))
basicUnsafeFreeze (MV_Approximate v) = Vector (Log Double, a, a, a) -> Vector (Approximate a)
forall a. Vector (Log Double, a, a, a) -> Vector (Approximate a)
V_Approximate (Vector (Log Double, a, a, a) -> Vector (Approximate a))
-> m (Vector (Log Double, a, a, a)) -> m (Vector (Approximate a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector (PrimState m) (Log Double, a, a, a)
-> m (Vector (Log Double, a, a, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) (Log Double, a, a, a)
Mutable Vector (PrimState m) (Log Double, a, a, a)
v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: Vector (Approximate a)
-> m (Mutable Vector (PrimState m) (Approximate a))
basicUnsafeThaw (V_Approximate v) = MVector (PrimState m) (Log Double, a, a, a)
-> MVector (PrimState m) (Approximate a)
forall s a.
MVector s (Log Double, a, a, a) -> MVector s (Approximate a)
MV_Approximate (MVector (PrimState m) (Log Double, a, a, a)
 -> MVector (PrimState m) (Approximate a))
-> m (MVector (PrimState m) (Log Double, a, a, a))
-> m (MVector (PrimState m) (Approximate a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (Log Double, a, a, a)
-> m (Mutable Vector (PrimState m) (Log Double, a, a, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector (Log Double, a, a, a)
v
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector (Approximate a) -> Int
basicLength (V_Approximate v) = Vector (Log Double, a, a, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector (Log Double, a, a, a)
v
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Approximate a) -> Vector (Approximate a)
basicUnsafeSlice Int
i Int
n (V_Approximate v) = Vector (Log Double, a, a, a) -> Vector (Approximate a)
forall a. Vector (Log Double, a, a, a) -> Vector (Approximate a)
V_Approximate (Vector (Log Double, a, a, a) -> Vector (Approximate a))
-> Vector (Log Double, a, a, a) -> Vector (Approximate a)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Vector (Log Double, a, a, a)
-> Vector (Log Double, a, a, a)
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector (Log Double, a, a, a)
v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector (Approximate a) -> Int -> m (Approximate a)
basicUnsafeIndexM (V_Approximate v) Int
i
                = (\(Log Double
p,a
l,a
m,a
h) -> Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p a
l a
m a
h) ((Log Double, a, a, a) -> Approximate a)
-> m (Log Double, a, a, a) -> m (Approximate a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (Log Double, a, a, a) -> Int -> m (Log Double, a, a, a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector (Log Double, a, a, a)
v Int
i
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: Mutable Vector (PrimState m) (Approximate a)
-> Vector (Approximate a) -> m ()
basicUnsafeCopy (MV_Approximate mv) (V_Approximate v) = Mutable Vector (PrimState m) (Log Double, a, a, a)
-> Vector (Log Double, a, a, a) -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) (Log Double, a, a, a)
Mutable Vector (PrimState m) (Log Double, a, a, a)
mv Vector (Log Double, a, a, a)
v
  {-# INLINE basicUnsafeCopy #-}
  elemseq :: Vector (Approximate a) -> Approximate a -> b -> b
elemseq Vector (Approximate a)
_ (Approximate Log Double
p a
l a
m a
h) b
z
     = Vector (Log Double) -> Log Double -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (Vector (Log Double)
forall a. HasCallStack => a
undefined :: U.Vector (Log Double)) Log Double
p
     (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: U.Vector a) a
l
     (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: U.Vector a) a
m
     (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: U.Vector a) a
h b
z
  {-# INLINE elemseq #-}

instance NFData a => NFData (Approximate a) where
  rnf :: Approximate a -> ()
rnf (Approximate Log Double
_ a
l a
m a
h) = a -> ()
forall a. NFData a => a -> ()
rnf a
l () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
m () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
h

instance Functor Approximate where
  fmap :: (a -> b) -> Approximate a -> Approximate b
fmap a -> b
f (Approximate Log Double
p a
l a
m a
h) = Log Double -> b -> b -> b -> Approximate b
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p (a -> b
f a
l) (a -> b
f a
m) (a -> b
f a
h)
  {-# INLINE fmap #-}

instance Foldable Approximate where
  foldMap :: (a -> m) -> Approximate a -> m
foldMap a -> m
f (Approximate Log Double
_ a
l a
m a
h) = a -> m
f a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
m m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
h
  {-# INLINE foldMap #-}

instance Traversable Approximate where
  traverse :: (a -> f b) -> Approximate a -> f (Approximate b)
traverse a -> f b
f (Approximate Log Double
p a
l a
m a
h) = Log Double -> b -> b -> b -> Approximate b
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p (b -> b -> b -> Approximate b)
-> f b -> f (b -> b -> Approximate b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
l f (b -> b -> Approximate b) -> f b -> f (b -> Approximate b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
m f (b -> Approximate b) -> f b -> f (Approximate b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
h
  {-# INLINE traverse #-}

instance Copointed Approximate where
  copoint :: Approximate a -> a
copoint (Approximate Log Double
_ a
_ a
a a
_) = a
a
  {-# INLINE copoint #-}

instance Pointed Approximate where
  point :: a -> Approximate a
point a
a = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
1 a
a a
a a
a
  {-# INLINE point #-}

instance Apply Approximate where
  Approximate Log Double
p a -> b
lf a -> b
mf a -> b
hf <.> :: Approximate (a -> b) -> Approximate a -> Approximate b
<.> Approximate Log Double
q a
la a
ma a
ha = Log Double -> b -> b -> b -> Approximate b
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a -> b
lf a
la) (a -> b
mf a
ma) (a -> b
hf a
ha)
  {-# INLINE (<.>) #-}

instance Applicative Approximate where
  pure :: a -> Approximate a
pure a
a = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
1 a
a a
a a
a
  {-# INLINE pure #-}
  Approximate Log Double
p a -> b
lf a -> b
mf a -> b
hf <*> :: Approximate (a -> b) -> Approximate a -> Approximate b
<*> Approximate Log Double
q a
la a
ma a
ha = Log Double -> b -> b -> b -> Approximate b
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a -> b
lf a
la) (a -> b
mf a
ma) (a -> b
hf a
ha)
  {-# INLINE (<*>) #-}

withMin :: Ord a => a -> Approximate a -> Approximate a
withMin :: a -> Approximate a -> Approximate a
withMin a
b r :: Approximate a
r@(Approximate Log Double
p a
l a
m a
h)
  | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
l    = Approximate a
r
  | Bool
otherwise = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p a
b (a -> a -> a
forall a. Ord a => a -> a -> a
max a
b a
m) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
b a
h)
{-# INLINE withMin #-}

withMax :: Ord a => a -> Approximate a -> Approximate a
withMax :: a -> Approximate a -> Approximate a
withMax a
b r :: Approximate a
r@(Approximate Log Double
p a
l a
m a
h)
  | a
h a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b = Approximate a
r
  | Bool
otherwise = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p (a -> a -> a
forall a. Ord a => a -> a -> a
min a
l a
b) (a -> a -> a
forall a. Ord a => a -> a -> a
min a
m a
b) a
b
{-# INLINE withMax #-}

instance (Ord a, Num a) => Num (Approximate a) where
  + :: Approximate a -> Approximate a -> Approximate a
(+) = (a -> a -> a) -> Approximate a -> Approximate a -> Approximate a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (+) #-}
  Approximate a
m * :: Approximate a -> Approximate a -> Approximate a
* Approximate a
n
    | Getting Any (Approximate a) () -> Approximate a -> Bool
forall s a. Getting Any s a -> s -> Bool
is Getting Any (Approximate a) ()
forall a. (Num a, Eq a) => Prism' (Approximate a) ()
zero Approximate a
n Bool -> Bool -> Bool
|| Getting Any (Approximate a) () -> Approximate a -> Bool
forall s a. Getting Any s a -> s -> Bool
is Getting Any (Approximate a) ()
forall a. (Num a, Eq a) => Prism' (Approximate a) ()
one Approximate a
m = Approximate a
m
    | Getting Any (Approximate a) () -> Approximate a -> Bool
forall s a. Getting Any s a -> s -> Bool
is Getting Any (Approximate a) ()
forall a. (Num a, Eq a) => Prism' (Approximate a) ()
zero Approximate a
m Bool -> Bool -> Bool
|| Getting Any (Approximate a) () -> Approximate a -> Bool
forall s a. Getting Any s a -> s -> Bool
is Getting Any (Approximate a) ()
forall a. (Num a, Eq a) => Prism' (Approximate a) ()
one Approximate a
n = Approximate a
n
    | Bool
otherwise = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Approximate a
mApproximate a
-> Getting (Log Double) (Approximate a) (Log Double) -> Log Double
forall s a. s -> Getting a s a -> a
^.Getting (Log Double) (Approximate a) (Log Double)
forall c a. HasApproximate c a => Lens' c (Log Double)
confidence Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Approximate a
nApproximate a
-> Getting (Log Double) (Approximate a) (Log Double) -> Log Double
forall s a. s -> Getting a s a -> a
^.Getting (Log Double) (Approximate a) (Log Double)
forall c a. HasApproximate c a => Lens' c (Log Double)
confidence) ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Prelude.minimum [a]
extrema) (Approximate a
mApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
estimate a -> a -> a
forall a. Num a => a -> a -> a
* Approximate a
nApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
estimate) ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Prelude.maximum [a]
extrema) where
      extrema :: [a]
extrema = a -> a -> a
forall a. Num a => a -> a -> a
(*) (a -> a -> a) -> [a] -> [a -> a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Approximate a
mApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
lo,Approximate a
mApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
hi] [a -> a] -> [a] -> [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Approximate a
nApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
lo,Approximate a
nApproximate a -> Getting a (Approximate a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (Approximate a) a
forall c a. HasApproximate c a => Lens' c a
hi]
  {-# INLINE (*) #-}
  negate :: Approximate a -> Approximate a
negate (Approximate Log Double
p a
l a
m a
h) = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p (-a
h) (-a
m) (-a
l)
  {-# INLINE negate #-}
  Approximate Log Double
p a
la a
ma a
ha - :: Approximate a -> Approximate a -> Approximate a
- Approximate Log Double
q a
lb a
mb a
hb = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a
la a -> a -> a
forall a. Num a => a -> a -> a
- a
hb) (a
ma a -> a -> a
forall a. Num a => a -> a -> a
- a
mb) (a
ha a -> a -> a
forall a. Num a => a -> a -> a
- a
lb)
  {-# INLINE (-) #-}
  abs :: Approximate a -> Approximate a
abs (Approximate Log Double
p a
la a
ma a
ha) = Log Double -> a -> a -> a -> Approximate a
forall a. Log Double -> a -> a -> a -> Approximate a
Approximate Log Double
p (a -> a -> a
forall a. Ord a => a -> a -> a
min a
lb a
hb) (a -> a
forall a. Num a => a -> a
abs a
ma) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
lb a
hb) where
    lb :: a
lb = a -> a
forall a. Num a => a -> a
abs a
la
    hb :: a
hb = a -> a
forall a. Num a => a -> a
abs a
ha
  {-# INLINE abs #-}
  signum :: Approximate a -> Approximate a
signum = (a -> a) -> Approximate a -> Approximate a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
  {-# INLINE signum #-}
  fromInteger :: Integer -> Approximate a
fromInteger = a -> Approximate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Approximate a) -> (Integer -> a) -> Integer -> Approximate a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

exact :: Eq a => Prism' (Approximate a) a
exact :: Prism' (Approximate a) a
exact = (a -> Approximate a)
-> (Approximate a -> Either (Approximate a) a)
-> Prism' (Approximate a) a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a -> Approximate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Approximate a -> Either (Approximate a) a)
 -> Prism' (Approximate a) a)
-> (Approximate a -> Either (Approximate a) a)
-> Prism' (Approximate a) a
forall a b. (a -> b) -> a -> b
$ \ Approximate a
s -> case Approximate a
s of
  Approximate (Exp Double
lp) a
a a
b a
c | Double
lp Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c -> a -> Either (Approximate a) a
forall a b. b -> Either a b
Right a
b
  Approximate a
_ -> Approximate a -> Either (Approximate a) a
forall a b. a -> Either a b
Left Approximate a
s
{-# INLINE exact #-}

zero :: (Num a, Eq a) => Prism' (Approximate a) ()
zero :: Prism' (Approximate a) ()
zero = p a (f a) -> p (Approximate a) (f (Approximate a))
forall a. Eq a => Prism' (Approximate a) a
exact(p a (f a) -> p (Approximate a) (f (Approximate a)))
-> (p () (f ()) -> p a (f a))
-> p () (f ())
-> p (Approximate a) (f (Approximate a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Prism' a ()
forall a. Eq a => a -> Prism' a ()
only a
0
{-# INLINE zero #-}

one :: (Num a, Eq a) => Prism' (Approximate a) ()
one :: Prism' (Approximate a) ()
one = p a (f a) -> p (Approximate a) (f (Approximate a))
forall a. Eq a => Prism' (Approximate a) a
exact(p a (f a) -> p (Approximate a) (f (Approximate a)))
-> (p () (f ()) -> p a (f a))
-> p () (f ())
-> p (Approximate a) (f (Approximate a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Prism' a ()
forall a. Eq a => a -> Prism' a ()
only a
1
{-# INLINE one #-}

is :: Getting Any s a -> s -> Bool
is :: Getting Any s a -> s -> Bool
is = Getting Any s a -> s -> Bool
forall s a. Getting Any s a -> s -> Bool
has
{-# INLINE is #-}