{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}
module NumHask.Algebra.Abstract.Field
( Field,
ExpField (..),
QuotientField (..),
UpperBoundedField (..),
LowerBoundedField (..),
TrigField (..),
half,
)
where
import Data.Bool (bool)
import NumHask.Algebra.Abstract.Additive
import NumHask.Algebra.Abstract.Multiplicative
import NumHask.Algebra.Abstract.Ring
import NumHask.Data.Integral
import Prelude ((.))
import qualified Prelude as P
class
(Distributive a, Subtractive a, Divisive a) =>
Field a
instance Field P.Double
instance Field P.Float
instance Field b => Field (a -> b)
class
(Field a) =>
ExpField a where
exp :: a -> a
log :: a -> a
logBase :: a -> a -> a
logBase a b = log b / log a
(**) :: a -> a -> a
(**) a b = exp (log a * b)
sqrt :: a -> a
sqrt a = a ** (one / (one + one))
instance ExpField P.Double where
exp = P.exp
log = P.log
(**) = (P.**)
instance ExpField P.Float where
exp = P.exp
log = P.log
(**) = (P.**)
instance ExpField b => ExpField (a -> b) where
exp f = exp . f
log f = log . f
logBase f f' a = logBase (f a) (f' a)
f ** f' = \a -> f a ** f' a
sqrt f = sqrt . f
class (Field a, Subtractive a, Multiplicative b, Additive b) => QuotientField a b where
properFraction :: a -> (b, a)
round :: a -> b
default round :: (P.Ord a, P.Ord b, Subtractive b, Integral b) => a -> b
round x = case properFraction x of
(n, r) ->
let m = bool (n + one) (n - one) (r P.< zero)
half_down = abs' r - (one / (one + one))
abs' a
| a P.< zero = negate a
| P.otherwise = a
in case P.compare half_down zero of
P.LT -> n
P.EQ -> bool m n (even n)
P.GT -> m
ceiling :: a -> b
default ceiling :: (P.Ord a) => a -> b
ceiling x = bool n (n + one) (r P.>= zero)
where
(n, r) = properFraction x
floor :: a -> b
default floor :: (P.Ord a, Subtractive b) => a -> b
floor x = bool n (n - one) (r P.< zero)
where
(n, r) = properFraction x
truncate :: a -> b
default truncate :: (P.Ord a) => a -> b
truncate x = bool (ceiling x) (floor x) (x P.> zero)
instance QuotientField P.Float P.Integer where
properFraction = P.properFraction
instance QuotientField P.Double P.Integer where
properFraction = P.properFraction
instance QuotientField P.Float P.Int where
properFraction = P.properFraction
instance QuotientField P.Double P.Int where
properFraction = P.properFraction
instance QuotientField b c => QuotientField (a -> b) (a -> c) where
properFraction f = (P.fst . frac, P.snd . frac)
where
frac a = properFraction @b @c (f a)
round f = round . f
ceiling f = ceiling . f
floor f = floor . f
truncate f = truncate . f
class
(Field a) =>
UpperBoundedField a where
infinity :: a
infinity = one / zero
nan :: a
nan = zero / zero
instance UpperBoundedField P.Float
instance UpperBoundedField P.Double
instance UpperBoundedField b => UpperBoundedField (a -> b) where
infinity _ = infinity
nan _ = nan
class
(Subtractive a, Field a) =>
LowerBoundedField a where
negInfinity :: a
negInfinity = negate (one / zero)
instance LowerBoundedField P.Float
instance LowerBoundedField P.Double
instance LowerBoundedField b => LowerBoundedField (a -> b) where
negInfinity _ = negInfinity
class
(Field a) =>
TrigField a where
pi :: a
sin :: a -> a
cos :: a -> a
tan :: a -> a
tan x = sin x / cos x
asin :: a -> a
acos :: a -> a
atan :: a -> a
sinh :: a -> a
cosh :: a -> a
tanh :: a -> a
tanh x = sinh x / cosh x
asinh :: a -> a
acosh :: a -> a
atanh :: a -> a
instance TrigField P.Double where
pi = P.pi
sin = P.sin
cos = P.cos
asin = P.asin
acos = P.acos
atan = P.atan
sinh = P.sinh
cosh = P.cosh
asinh = P.sinh
acosh = P.acosh
atanh = P.atanh
instance TrigField P.Float where
pi = P.pi
sin = P.sin
cos = P.cos
asin = P.asin
acos = P.acos
atan = P.atan
sinh = P.sinh
cosh = P.cosh
asinh = P.sinh
acosh = P.acosh
atanh = P.atanh
instance TrigField b => TrigField (a -> b) where
pi _ = pi
sin f = sin . f
cos f = cos . f
asin f = asin . f
acos f = acos . f
atan f = atan . f
sinh f = sinh . f
cosh f = cosh . f
asinh f = asinh . f
acosh f = acosh . f
atanh f = atanh . f
half :: (Field a) => a
half = one / two