{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}

-- | Field classes
module NumHask.Algebra.Field
  ( Field,
    ExpField (..),
    QuotientField (..),
    UpperBoundedField (..),
    LowerBoundedField (..),
    TrigField (..),
    half,
  )
where

import Data.Bool (bool)
import NumHask.Algebra.Additive (Additive (..), Subtractive (..))
import NumHask.Algebra.Multiplicative
  ( Divisive ((/)),
    Multiplicative (..),
  )
import NumHask.Algebra.Ring (Distributive, two)
import NumHask.Data.Integral (Integral, even)
import Prelude ((.))
import qualified Prelude as P

-- $setup
--
-- >>> :set -XRebindableSyntax
-- >>> :set -XFlexibleContexts
-- >>> :set -XScopedTypeVariables
-- >>> import NumHask.Prelude

-- | A <https://en.wikipedia.org/wiki/Field_(mathematics) Field> is a set
--   on which addition, subtraction, multiplication, and division are defined. It is also assumed that multiplication is distributive over addition.
--
-- A summary of the rules inherited from super-classes of Field. Floating point computation is a terrible, messy business and, in practice, only rough approximation can be achieve for association and distribution.
--
-- > zero + a == a
-- > a + zero == a
-- > ((a + b) + c) (a + (b + c))
-- > a + b == b + a
-- > a - a == zero
-- > negate a == zero - a
-- > negate a + a == zero
-- > a + negate a == zero
-- > one * a == a
-- > a * one == a
-- > ((a * b) * c) == (a * (b * c))
-- > (a * (b + c)) == (a * b + a * c)
-- > ((a + b) * c) == (a * c + b * c)
-- > a * zero == zero
-- > zero * a == zero
-- > a / a == one || a == zero
-- > recip a == one / a || a == zero
-- > recip a * a == one || a == zero
-- > a * recip a == one || a == zero
class
  (Distributive a, Subtractive a, Divisive a) =>
  Field a

instance Field P.Double

instance Field P.Float

instance Field b => Field (a -> b)

-- | A hyperbolic field class
--
-- > sqrt . (**2) == id
-- > log . exp == id
-- > for +ive b, a != 0,1: a ** logBase a b ≈ b
class
  (Field a) =>
  ExpField a
  where
  exp :: a -> a
  log :: a -> a
  logBase :: a -> a -> a
  logBase a
a a
b = a -> a
forall a. ExpField a => a -> a
log a
b a -> a -> a
forall a. Divisive a => a -> a -> a
/ a -> a
forall a. ExpField a => a -> a
log a
a
  (**) :: a -> a -> a
  (**) a
a a
b = a -> a
forall a. ExpField a => a -> a
exp (a -> a
forall a. ExpField a => a -> a
log a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b)
  sqrt :: a -> a
  sqrt a
a = a
a a -> a -> a
forall a. ExpField a => a -> a -> a
** (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))

instance ExpField P.Double where
  exp :: Double -> Double
exp = Double -> Double
forall a. Floating a => a -> a
P.exp
  log :: Double -> Double
log = Double -> Double
forall a. Floating a => a -> a
P.log
  ** :: Double -> Double -> Double
(**) = Double -> Double -> Double
forall a. Floating a => a -> a -> a
(P.**)

instance ExpField P.Float where
  exp :: Float -> Float
exp = Float -> Float
forall a. Floating a => a -> a
P.exp
  log :: Float -> Float
log = Float -> Float
forall a. Floating a => a -> a
P.log
  ** :: Float -> Float -> Float
(**) = Float -> Float -> Float
forall a. Floating a => a -> a -> a
(P.**)

instance ExpField b => ExpField (a -> b) where
  exp :: (a -> b) -> a -> b
exp a -> b
f = b -> b
forall a. ExpField a => a -> a
exp (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  log :: (a -> b) -> a -> b
log a -> b
f = b -> b
forall a. ExpField a => a -> a
log (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  logBase :: (a -> b) -> (a -> b) -> a -> b
logBase a -> b
f a -> b
f' a
a = b -> b -> b
forall a. ExpField a => a -> a -> a
logBase (a -> b
f a
a) (a -> b
f' a
a)
  a -> b
f ** :: (a -> b) -> (a -> b) -> a -> b
** a -> b
f' = \a
a -> a -> b
f a
a b -> b -> b
forall a. ExpField a => a -> a -> a
** a -> b
f' a
a
  sqrt :: (a -> b) -> a -> b
sqrt a -> b
f = b -> b
forall a. ExpField a => a -> a
sqrt (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | Conversion from a 'Field' to a 'NumHask.Algebra.Ring'
--
-- See [Field of fractions](https://en.wikipedia.org/wiki/Field_of_fractions)
--
-- > a - one < floor a <= a <= ceiling a < a + one
-- > round a == floor (a + half)
class (Field 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 a
x = case a -> (b, a)
forall a b. QuotientField a b => a -> (b, a)
properFraction a
x of
    (b
n, a
r) ->
      let m :: b
m = b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool (b
n b -> b -> b
forall a. Additive a => a -> a -> a
+ b
forall a. Multiplicative a => a
one) (b
n b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
forall a. Multiplicative a => a
one) (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Additive a => a
zero)
          half_down :: a
half_down = a -> a
forall p. (Ord p, Subtractive p) => p -> p
abs' a
r a -> a -> a
forall a. Subtractive a => a -> a -> a
- (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))
          abs' :: p -> p
abs' p
a
            | p
a p -> p -> Bool
forall a. Ord a => a -> a -> Bool
P.< p
forall a. Additive a => a
zero = p -> p
forall a. Subtractive a => a -> a
negate p
a
            | Bool
P.otherwise = p
a
       in case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare a
half_down a
forall a. Additive a => a
zero of
            Ordering
P.LT -> b
n
            Ordering
P.EQ -> b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool b
m b
n (b -> Bool
forall a. (Eq a, Integral a) => a -> Bool
even b
n)
            Ordering
P.GT -> b
m

  ceiling :: a -> b
  default ceiling :: (P.Ord a) => a -> b
  ceiling a
x = b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool b
n (b
n b -> b -> b
forall a. Additive a => a -> a -> a
+ b
forall a. Multiplicative a => a
one) (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.>= a
forall a. Additive a => a
zero)
    where
      (b
n, a
r) = a -> (b, a)
forall a b. QuotientField a b => a -> (b, a)
properFraction a
x

  floor :: a -> b
  default floor :: (P.Ord a, Subtractive b) => a -> b
  floor a
x = b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool b
n (b
n b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
forall a. Multiplicative a => a
one) (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Additive a => a
zero)
    where
      (b
n, a
r) = a -> (b, a)
forall a b. QuotientField a b => a -> (b, a)
properFraction a
x

  truncate :: a -> b
  default truncate :: (P.Ord a) => a -> b
  truncate a
x = b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool (a -> b
forall a b. QuotientField a b => a -> b
ceiling a
x) (a -> b
forall a b. QuotientField a b => a -> b
floor a
x) (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.> a
forall a. Additive a => a
zero)

instance QuotientField P.Float P.Integer where
  properFraction :: Float -> (Integer, Float)
properFraction = Float -> (Integer, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction

instance QuotientField P.Double P.Integer where
  properFraction :: Double -> (Integer, Double)
properFraction = Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction

instance QuotientField P.Float P.Int where
  properFraction :: Float -> (Int, Float)
properFraction = Float -> (Int, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction

instance QuotientField P.Double P.Int where
  properFraction :: Double -> (Int, Double)
properFraction = Double -> (Int, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction

instance QuotientField b c => QuotientField (a -> b) (a -> c) where
  properFraction :: (a -> b) -> (a -> c, a -> b)
properFraction a -> b
f = ((c, b) -> c
forall a b. (a, b) -> a
P.fst ((c, b) -> c) -> (a -> (c, b)) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (c, b)
frac, (c, b) -> b
forall a b. (a, b) -> b
P.snd ((c, b) -> b) -> (a -> (c, b)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (c, b)
frac)
    where
      frac :: a -> (c, b)
frac a
a = b -> (c, b)
forall a b. QuotientField a b => a -> (b, a)
properFraction @b @c (a -> b
f a
a)

  round :: (a -> b) -> a -> c
round a -> b
f = b -> c
forall a b. QuotientField a b => a -> b
round (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

  ceiling :: (a -> b) -> a -> c
ceiling a -> b
f = b -> c
forall a b. QuotientField a b => a -> b
ceiling (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

  floor :: (a -> b) -> a -> c
floor a -> b
f = b -> c
forall a b. QuotientField a b => a -> b
floor (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

  truncate :: (a -> b) -> a -> c
truncate a -> b
f = b -> c
forall a b. QuotientField a b => a -> b
truncate (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | A bounded field introduces the concepts of infinity and NaN.
--
-- > one / zero + infinity == infinity
-- > infinity + a == infinity
-- > zero / zero != nan
--
-- Note the tricky law that, although nan is assigned to zero/zero, they are never-the-less not equal. A committee decided this.
class
  (Field a) =>
  UpperBoundedField a
  where
  infinity :: a
  infinity = a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. Additive a => a
zero

  nan :: a
  nan = a
forall a. Additive a => a
zero a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. Additive a => a
zero

instance UpperBoundedField P.Float

instance UpperBoundedField P.Double

instance UpperBoundedField b => UpperBoundedField (a -> b) where
  infinity :: a -> b
infinity a
_ = b
forall a. UpperBoundedField a => a
infinity
  nan :: a -> b
nan a
_ = b
forall a. UpperBoundedField a => a
nan

-- | Negative infinity.
class
  (Subtractive a, Field a) =>
  LowerBoundedField a
  where
  negInfinity :: a
  negInfinity = a -> a
forall a. Subtractive a => a -> a
negate (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. Additive a => a
zero)

instance LowerBoundedField P.Float

instance LowerBoundedField P.Double

instance LowerBoundedField b => LowerBoundedField (a -> b) where
  negInfinity :: a -> b
negInfinity a
_ = b
forall a. LowerBoundedField a => a
negInfinity

-- | Trigonometric Field
class
  (Field a) =>
  TrigField a
  where
  pi :: a
  sin :: a -> a
  cos :: a -> a
  tan :: a -> a
  tan a
x = a -> a
forall a. TrigField a => a -> a
sin a
x a -> a -> a
forall a. Divisive a => a -> a -> a
/ a -> a
forall a. TrigField a => a -> a
cos a
x
  asin :: a -> a
  acos :: a -> a
  atan :: a -> a
  atan2 :: a -> a -> a
  sinh :: a -> a
  cosh :: a -> a
  tanh :: a -> a
  tanh a
x = a -> a
forall a. TrigField a => a -> a
sinh a
x a -> a -> a
forall a. Divisive a => a -> a -> a
/ a -> a
forall a. TrigField a => a -> a
cosh a
x
  asinh :: a -> a
  acosh :: a -> a
  atanh :: a -> a

instance TrigField P.Double where
  pi :: Double
pi = Double
forall a. Floating a => a
P.pi
  sin :: Double -> Double
sin = Double -> Double
forall a. Floating a => a -> a
P.sin
  cos :: Double -> Double
cos = Double -> Double
forall a. Floating a => a -> a
P.cos
  asin :: Double -> Double
asin = Double -> Double
forall a. Floating a => a -> a
P.asin
  acos :: Double -> Double
acos = Double -> Double
forall a. Floating a => a -> a
P.acos
  atan :: Double -> Double
atan = Double -> Double
forall a. Floating a => a -> a
P.atan
  atan2 :: Double -> Double -> Double
atan2 = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
P.atan2
  sinh :: Double -> Double
sinh = Double -> Double
forall a. Floating a => a -> a
P.sinh
  cosh :: Double -> Double
cosh = Double -> Double
forall a. Floating a => a -> a
P.cosh
  asinh :: Double -> Double
asinh = Double -> Double
forall a. Floating a => a -> a
P.sinh
  acosh :: Double -> Double
acosh = Double -> Double
forall a. Floating a => a -> a
P.acosh
  atanh :: Double -> Double
atanh = Double -> Double
forall a. Floating a => a -> a
P.atanh

instance TrigField P.Float where
  pi :: Float
pi = Float
forall a. Floating a => a
P.pi
  sin :: Float -> Float
sin = Float -> Float
forall a. Floating a => a -> a
P.sin
  cos :: Float -> Float
cos = Float -> Float
forall a. Floating a => a -> a
P.cos
  asin :: Float -> Float
asin = Float -> Float
forall a. Floating a => a -> a
P.asin
  acos :: Float -> Float
acos = Float -> Float
forall a. Floating a => a -> a
P.acos
  atan :: Float -> Float
atan = Float -> Float
forall a. Floating a => a -> a
P.atan
  atan2 :: Float -> Float -> Float
atan2 = Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
P.atan2
  sinh :: Float -> Float
sinh = Float -> Float
forall a. Floating a => a -> a
P.sinh
  cosh :: Float -> Float
cosh = Float -> Float
forall a. Floating a => a -> a
P.cosh
  asinh :: Float -> Float
asinh = Float -> Float
forall a. Floating a => a -> a
P.sinh
  acosh :: Float -> Float
acosh = Float -> Float
forall a. Floating a => a -> a
P.acosh
  atanh :: Float -> Float
atanh = Float -> Float
forall a. Floating a => a -> a
P.atanh

instance TrigField b => TrigField (a -> b) where
  pi :: a -> b
pi a
_ = b
forall a. TrigField a => a
pi
  sin :: (a -> b) -> a -> b
sin a -> b
f = b -> b
forall a. TrigField a => a -> a
sin (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  cos :: (a -> b) -> a -> b
cos a -> b
f = b -> b
forall a. TrigField a => a -> a
cos (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  asin :: (a -> b) -> a -> b
asin a -> b
f = b -> b
forall a. TrigField a => a -> a
asin (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  acos :: (a -> b) -> a -> b
acos a -> b
f = b -> b
forall a. TrigField a => a -> a
acos (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  atan :: (a -> b) -> a -> b
atan a -> b
f = b -> b
forall a. TrigField a => a -> a
atan (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  atan2 :: (a -> b) -> (a -> b) -> a -> b
atan2 a -> b
f a -> b
g a
x = b -> b -> b
forall a. TrigField a => a -> a -> a
atan2 (a -> b
f a
x) (a -> b
g a
x)
  sinh :: (a -> b) -> a -> b
sinh a -> b
f = b -> b
forall a. TrigField a => a -> a
sinh (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  cosh :: (a -> b) -> a -> b
cosh a -> b
f = b -> b
forall a. TrigField a => a -> a
cosh (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  asinh :: (a -> b) -> a -> b
asinh a -> b
f = b -> b
forall a. TrigField a => a -> a
asinh (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  acosh :: (a -> b) -> a -> b
acosh a -> b
f = b -> b
forall a. TrigField a => a -> a
acosh (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  atanh :: (a -> b) -> a -> b
atanh a -> b
f = b -> b
forall a. TrigField a => a -> a
atanh (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | A 'half' is a 'Field' because it requires addition, multiplication and division.
half :: (Field a) => a
half :: a
half = a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. (Multiplicative a, Additive a) => a
two