{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-type-equality-out-of-scope #-}

-- | Metric classes
module NumHask.Algebra.Metric
  ( Basis (..),
    Absolute,
    Sign,
    EndoBased,
    abs,
    signum,
    distance,
    Direction (..),
    Polar (..),
    polar,
    coord,
    Epsilon (..),
    nearZero,
    aboutEqual,
    (~=),
    EuclideanPair (..),
  )
where

import Control.Applicative
import Data.Bool
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics
import GHC.Natural (Natural (..))
import NumHask.Algebra.Action
import NumHask.Algebra.Additive
import NumHask.Algebra.Field
import NumHask.Algebra.Lattice
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import Prelude (Double, Eq (..), Float, Functor (..), Int, Integer, Ord, Show, Word, fromRational)
import qualified Prelude as P

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

-- | 'Basis' encapsulates the notion of magnitude (intuitively the quotienting of a higher-kinded number to a scalar one) and the basis on which the magnitude quotienting was performed. An instance needs to satisfy these laws:
--
-- > \a -> magnitude a >= zero
-- > \a -> magnitude zero == zero
-- > \a -> a == magnitude a *| basis a
-- > \a -> magnitude (basis a) == one
--
-- The names chosen are meant to represent the spiritual idea of a basis rather than a specific mathematics. See https://en.wikipedia.org/wiki/Basis_(linear_algebra) & https://en.wikipedia.org/wiki/Norm_(mathematics) for some mathematical motivations.
--
-- >>> magnitude (-0.5 :: Double)
-- 0.5
--
-- >>> basis (-0.5 :: Double)
-- -1.0
class (Distributive (Mag a)) => Basis a where
  type Mag a :: Type
  type Base a :: Type

  -- | or length, or ||v||
  magnitude :: a -> Mag a

  -- | or direction, or v-hat
  basis :: a -> Base a

-- | Basis where the domain and magnitude codomain are the same.
type Absolute a = (Basis a, Mag a ~ a)

-- | Basis where the domain and basis codomain are the same.
type Sign a = (Basis a, Base a ~ a)

-- | Basis where the domain, magnitude codomain and basis codomain are the same.
type EndoBased a = (Basis a, Mag a ~ a, Base a ~ a)

-- | The absolute value of a number.
--
-- prop> \a -> abs a * signum a ~= a
--
--
-- >>> abs (-1)
-- 1
abs :: (Absolute a) => a -> a
abs :: forall a. Absolute a => a -> a
abs = forall a. Basis a => a -> Mag a
magnitude

-- | The sign of a number.
--
-- >>> signum (-1)
-- -1
--
-- @abs zero == zero@, so any value for @signum zero@ is ok.  We choose lawful neutral:
--
-- >>> signum zero == zero
-- True
signum :: (Sign a) => a -> a
signum :: forall a. Sign a => a -> a
signum = forall a. Basis a => a -> Base a
basis

instance Basis Double where
  type Mag Double = Double
  type Base Double = Double
  magnitude :: Double -> Mag Double
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Double -> Base Double
basis = forall a. Num a => a -> a
P.signum

instance Basis Float where
  type Mag Float = Float
  type Base Float = Float
  magnitude :: Float -> Mag Float
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Float -> Base Float
basis = forall a. Num a => a -> a
P.signum

instance Basis Int where
  type Mag Int = Int
  type Base Int = Int
  magnitude :: Int -> Mag Int
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Int -> Base Int
basis = forall a. Num a => a -> a
P.signum

instance Basis Integer where
  type Mag Integer = Integer
  type Base Integer = Integer
  magnitude :: Integer -> Mag Integer
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Integer -> Base Integer
basis = forall a. Num a => a -> a
P.signum

instance Basis Natural where
  type Mag Natural = Natural
  type Base Natural = Natural
  magnitude :: Natural -> Mag Natural
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Natural -> Base Natural
basis = forall a. Num a => a -> a
P.signum

instance Basis Int8 where
  type Mag Int8 = Int8
  type Base Int8 = Int8
  magnitude :: Int8 -> Mag Int8
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Int8 -> Base Int8
basis = forall a. Num a => a -> a
P.signum

instance Basis Int16 where
  type Mag Int16 = Int16
  type Base Int16 = Int16
  magnitude :: Int16 -> Mag Int16
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Int16 -> Base Int16
basis = forall a. Num a => a -> a
P.signum

instance Basis Int32 where
  type Mag Int32 = Int32
  type Base Int32 = Int32
  magnitude :: Int32 -> Mag Int32
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Int32 -> Base Int32
basis = forall a. Num a => a -> a
P.signum

instance Basis Int64 where
  type Mag Int64 = Int64
  type Base Int64 = Int64
  magnitude :: Int64 -> Mag Int64
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Int64 -> Base Int64
basis = forall a. Num a => a -> a
P.signum

instance Basis Word where
  type Mag Word = Word
  type Base Word = Word
  magnitude :: Word -> Mag Word
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Word -> Base Word
basis = forall a. Num a => a -> a
P.signum

instance Basis Word8 where
  type Mag Word8 = Word8
  type Base Word8 = Word8
  magnitude :: Word8 -> Mag Word8
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Word8 -> Base Word8
basis = forall a. Num a => a -> a
P.signum

instance Basis Word16 where
  type Mag Word16 = Word16
  type Base Word16 = Word16
  magnitude :: Word16 -> Mag Word16
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Word16 -> Base Word16
basis = forall a. Num a => a -> a
P.signum

instance Basis Word32 where
  type Mag Word32 = Word32
  type Base Word32 = Word32
  magnitude :: Word32 -> Mag Word32
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Word32 -> Base Word32
basis = forall a. Num a => a -> a
P.signum

instance Basis Word64 where
  type Mag Word64 = Word64
  type Base Word64 = Word64
  magnitude :: Word64 -> Mag Word64
magnitude = forall a. Num a => a -> a
P.abs
  basis :: Word64 -> Base Word64
basis = forall a. Num a => a -> a
P.signum

-- | Distance, which combines the Subtractive notion of difference, with Basis.
--
-- > distance a b >= zero
-- > distance a a == zero
-- > distance a b *| basis (a - b) == a - b
distance :: (Basis a, Subtractive a) => a -> a -> Mag a
distance :: forall a. (Basis a, Subtractive a) => a -> a -> Mag a
distance a
a a
b = forall a. Basis a => a -> Mag a
magnitude (a
a forall a. Subtractive a => a -> a -> a
- a
b)

-- | Convert between a "co-ordinated" or "higher-kinded" number and a direction.
--
--
-- > ray . angle == basis
-- > magnitude (ray x) == one
class (Distributive coord, Distributive (Dir coord)) => Direction coord where
  type Dir coord :: Type
  angle :: coord -> Dir coord
  ray :: Dir coord -> coord

-- | Something that has a magnitude and a direction, with both expressed as the same type.
--
-- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system)
data Polar a = Polar {forall a. Polar a -> a
radial :: a, forall a. Polar a -> a
azimuth :: a}
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Polar a) x -> Polar a
forall a x. Polar a -> Rep (Polar a) x
$cto :: forall a x. Rep (Polar a) x -> Polar a
$cfrom :: forall a x. Polar a -> Rep (Polar a) x
Generic, Int -> Polar a -> ShowS
forall a. Show a => Int -> Polar a -> ShowS
forall a. Show a => [Polar a] -> ShowS
forall a. Show a => Polar a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Polar a] -> ShowS
$cshowList :: forall a. Show a => [Polar a] -> ShowS
show :: Polar a -> String
$cshow :: forall a. Show a => Polar a -> String
showsPrec :: Int -> Polar a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Polar a -> ShowS
Show, Polar a -> Polar a -> Bool
forall a. Eq a => Polar a -> Polar a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Polar a -> Polar a -> Bool
$c/= :: forall a. Eq a => Polar a -> Polar a -> Bool
== :: Polar a -> Polar a -> Bool
$c== :: forall a. Eq a => Polar a -> Polar a -> Bool
Eq)

instance (Additive a, Multiplicative a) => Basis (Polar a) where
  type Mag (Polar a) = a
  type Base (Polar a) = a
  magnitude :: Polar a -> Mag (Polar a)
magnitude = forall a. Polar a -> a
radial
  basis :: Polar a -> Base (Polar a)
basis = forall a. Polar a -> a
azimuth

-- | Convert a higher-kinded number that has direction, to a 'Polar'
polar :: (Dir (Base a) ~ Mag a, Basis a, Direction (Base a)) => a -> Polar (Mag a)
polar :: forall a.
(Dir (Base a) ~ Mag a, Basis a, Direction (Base a)) =>
a -> Polar (Mag a)
polar a
x = forall a. a -> a -> Polar a
Polar (forall a. Basis a => a -> Mag a
magnitude a
x) (forall coord. Direction coord => coord -> Dir coord
angle (forall a. Basis a => a -> Base a
basis a
x))

-- | Convert a Polar to a (higher-kinded) number that has a direction.
coord :: (Scalar m ~ Dir m, MultiplicativeAction m, Direction m) => Polar (Scalar m) -> m
coord :: forall m.
(Scalar m ~ Dir m, MultiplicativeAction m, Direction m) =>
Polar (Scalar m) -> m
coord Polar (Scalar m)
x = forall a. Polar a -> a
radial Polar (Scalar m)
x forall m. MultiplicativeAction m => Scalar m -> m -> m
*| forall coord. Direction coord => Dir coord -> coord
ray (forall a. Polar a -> a
azimuth Polar (Scalar m)
x)

-- | A small number, especially useful for approximate equality.
class
  (Eq a, Additive a) =>
  Epsilon a
  where
  epsilon :: a
  epsilon = forall a. Additive a => a
zero

-- | Note that the constraint is Lattice rather than Ord allowing broader usage.
--
-- >>> nearZero (epsilon :: Double)
-- True
--
-- >>> nearZero (epsilon :: EuclideanPair Double)
-- True
nearZero :: (Epsilon a, Lattice a, Subtractive a) => a -> Bool
nearZero :: forall a. (Epsilon a, Lattice a, Subtractive a) => a -> Bool
nearZero a
a = forall a. Epsilon a => a
epsilon forall a. MeetSemiLattice a => a -> a -> a
/\ a
a forall a. Eq a => a -> a -> Bool
== forall a. Epsilon a => a
epsilon Bool -> Bool -> Bool
&& forall a. Epsilon a => a
epsilon forall a. MeetSemiLattice a => a -> a -> a
/\ forall a. Subtractive a => a -> a
negate a
a forall a. Eq a => a -> a -> Bool
== forall a. Epsilon a => a
epsilon

-- | Approximate equality
--
-- >>> aboutEqual zero (epsilon :: Double)
-- True
aboutEqual :: (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool
aboutEqual :: forall a. (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool
aboutEqual a
a a
b = forall a. (Epsilon a, Lattice a, Subtractive a) => a -> Bool
nearZero (a
a forall a. Subtractive a => a -> a -> a
- a
b)

infixl 4 ~=

-- | About equal operator.
--
-- >>> (1.0 + epsilon) ~= (1.0 :: Double)
-- True
(~=) :: (Epsilon a) => (Lattice a, Subtractive a) => a -> a -> Bool
~= :: forall a. (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool
(~=) = forall a. (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool
aboutEqual

-- | 1e-14
instance Epsilon Double where
  epsilon :: Double
epsilon = Double
1e-14

-- | 1e-6
instance Epsilon Float where
  epsilon :: Float
epsilon = Float
1e-6

-- | 0
instance Epsilon Int

instance Epsilon Integer

instance Epsilon Int8

instance Epsilon Int16

instance Epsilon Int32

instance Epsilon Int64

instance Epsilon Word

instance Epsilon Word8

instance Epsilon Word16

instance Epsilon Word32

instance Epsilon Word64

-- | Two dimensional cartesian coordinates.
newtype EuclideanPair a = EuclideanPair {forall a. EuclideanPair a -> (a, a)
euclidPair :: (a, a)}
  deriving stock
    ( forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EuclideanPair a) x -> EuclideanPair a
forall a x. EuclideanPair a -> Rep (EuclideanPair a) x
$cto :: forall a x. Rep (EuclideanPair a) x -> EuclideanPair a
$cfrom :: forall a x. EuclideanPair a -> Rep (EuclideanPair a) x
Generic,
      EuclideanPair a -> EuclideanPair a -> Bool
forall a. Eq a => EuclideanPair a -> EuclideanPair a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EuclideanPair a -> EuclideanPair a -> Bool
$c/= :: forall a. Eq a => EuclideanPair a -> EuclideanPair a -> Bool
== :: EuclideanPair a -> EuclideanPair a -> Bool
$c== :: forall a. Eq a => EuclideanPair a -> EuclideanPair a -> Bool
Eq,
      Int -> EuclideanPair a -> ShowS
forall a. Show a => Int -> EuclideanPair a -> ShowS
forall a. Show a => [EuclideanPair a] -> ShowS
forall a. Show a => EuclideanPair a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EuclideanPair a] -> ShowS
$cshowList :: forall a. Show a => [EuclideanPair a] -> ShowS
show :: EuclideanPair a -> String
$cshow :: forall a. Show a => EuclideanPair a -> String
showsPrec :: Int -> EuclideanPair a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EuclideanPair a -> ShowS
Show
    )

instance Functor EuclideanPair where
  fmap :: forall a b. (a -> b) -> EuclideanPair a -> EuclideanPair b
fmap a -> b
f (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> b
f a
x, a -> b
f a
y)

instance Applicative EuclideanPair where
  pure :: forall a. a -> EuclideanPair a
pure a
x = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
x, a
x)
  EuclideanPair (a -> b
fx, a -> b
fy) <*> :: forall a b.
EuclideanPair (a -> b) -> EuclideanPair a -> EuclideanPair b
<*> EuclideanPair (a
x, a
y) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> b
fx a
x, a -> b
fy a
y)
  liftA2 :: forall a b c.
(a -> b -> c)
-> EuclideanPair a -> EuclideanPair b -> EuclideanPair c
liftA2 a -> b -> c
f (EuclideanPair (a
x, a
y)) (EuclideanPair (b
x', b
y')) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> b -> c
f a
x b
x', a -> b -> c
f a
y b
y')

instance (Additive a) => Additive (EuclideanPair a) where
  + :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Additive a => a -> a -> a
(+)
  zero :: EuclideanPair a
zero = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Additive a => a
zero

instance (Subtractive a) => Subtractive (EuclideanPair a) where
  negate :: EuclideanPair a -> EuclideanPair a
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Subtractive a => a -> a
negate

instance
  (Multiplicative a) =>
  Multiplicative (EuclideanPair a)
  where
  * :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Multiplicative a => a -> a -> a
(*)
  one :: EuclideanPair a
one = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Multiplicative a => a
one

instance
  (Subtractive a, Divisive a) =>
  Divisive (EuclideanPair a)
  where
  recip :: EuclideanPair a -> EuclideanPair a
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Divisive a => a -> a
recip

instance (TrigField a) => Direction (EuclideanPair a) where
  type Dir (EuclideanPair a) = a
  angle :: EuclideanPair a -> Dir (EuclideanPair a)
angle (EuclideanPair (a
x, a
y)) = forall a. TrigField a => a -> a -> a
atan2 a
y a
x
  ray :: Dir (EuclideanPair a) -> EuclideanPair a
ray Dir (EuclideanPair a)
x = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. TrigField a => a -> a
cos Dir (EuclideanPair a)
x, forall a. TrigField a => a -> a
sin Dir (EuclideanPair a)
x)

instance
  (ExpField a, Eq a) =>
  Basis (EuclideanPair a)
  where
  type Mag (EuclideanPair a) = a
  type Base (EuclideanPair a) = EuclideanPair a

  magnitude :: EuclideanPair a -> Mag (EuclideanPair a)
magnitude (EuclideanPair (a
x, a
y)) = forall a. ExpField a => a -> a
sqrt (a
x forall a. Multiplicative a => a -> a -> a
* a
x forall a. Additive a => a -> a -> a
+ a
y forall a. Multiplicative a => a -> a -> a
* a
y)
  basis :: EuclideanPair a -> Base (EuclideanPair a)
basis EuclideanPair a
p = let m :: Mag (EuclideanPair a)
m = forall a. Basis a => a -> Mag a
magnitude EuclideanPair a
p in forall a. a -> a -> Bool -> a
bool (EuclideanPair a
p forall m. DivisiveAction m => m -> Scalar m -> m
|/ Mag (EuclideanPair a)
m) forall a. Additive a => a
zero (Mag (EuclideanPair a)
m forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
zero)

instance
  (Epsilon a) =>
  Epsilon (EuclideanPair a)
  where
  epsilon :: EuclideanPair a
epsilon = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Epsilon a => a
epsilon

instance (JoinSemiLattice a) => JoinSemiLattice (EuclideanPair a) where
  \/ :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a
(\/) (EuclideanPair (a
x, a
y)) (EuclideanPair (a
x', a
y')) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
x forall a. JoinSemiLattice a => a -> a -> a
\/ a
x', a
y forall a. JoinSemiLattice a => a -> a -> a
\/ a
y')

instance (MeetSemiLattice a) => MeetSemiLattice (EuclideanPair a) where
  /\ :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a
(/\) (EuclideanPair (a
x, a
y)) (EuclideanPair (a
x', a
y')) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
x forall a. MeetSemiLattice a => a -> a -> a
/\ a
x', a
y forall a. MeetSemiLattice a => a -> a -> a
/\ a
y')

instance (BoundedJoinSemiLattice a) => BoundedJoinSemiLattice (EuclideanPair a) where
  bottom :: EuclideanPair a
bottom = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. BoundedJoinSemiLattice a => a
bottom

instance (BoundedMeetSemiLattice a) => BoundedMeetSemiLattice (EuclideanPair a) where
  top :: EuclideanPair a
top = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. BoundedMeetSemiLattice a => a
top

instance (Multiplicative a) => MultiplicativeAction (EuclideanPair a) where
  type Scalar (EuclideanPair a) = a
  |* :: EuclideanPair a -> Scalar (EuclideanPair a) -> EuclideanPair a
(|*) (EuclideanPair (a
x, a
y)) Scalar (EuclideanPair a)
s = forall a. (a, a) -> EuclideanPair a
EuclideanPair (Scalar (EuclideanPair a)
s forall a. Multiplicative a => a -> a -> a
* a
x, Scalar (EuclideanPair a)
s forall a. Multiplicative a => a -> a -> a
* a
y)

instance (Divisive a) => DivisiveAction (EuclideanPair a) where
  |/ :: EuclideanPair a -> Scalar (EuclideanPair a) -> EuclideanPair a
(|/) EuclideanPair a
e Scalar (EuclideanPair a)
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Divisive a => a -> a -> a
/ Scalar (EuclideanPair a)
s) EuclideanPair a
e

instance (Ord a, TrigField a, ExpField a) => ExpField (EuclideanPair a) where
  exp :: EuclideanPair a -> EuclideanPair a
exp (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. ExpField a => a -> a
exp a
x forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a -> a
cos a
y, forall a. ExpField a => a -> a
exp a
x forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a -> a
sin a
y)
  log :: EuclideanPair a -> EuclideanPair a
log (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. ExpField a => a -> a
log (forall a. ExpField a => a -> a
sqrt (a
x forall a. Multiplicative a => a -> a -> a
* a
x forall a. Additive a => a -> a -> a
+ a
y forall a. Multiplicative a => a -> a -> a
* a
y)), forall {a}. (Ord a, TrigField a) => a -> a -> a
atan2' a
y a
x)
    where
      atan2' :: a -> a -> a
atan2' a
y a
x
        | a
x forall a. Ord a => a -> a -> Bool
P.> forall a. Additive a => a
zero = forall a. TrigField a => a -> a
atan (a
y forall a. Divisive a => a -> a -> a
/ a
x)
        | a
x forall a. Eq a => a -> a -> Bool
P.== forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y forall a. Ord a => a -> a -> Bool
P.> forall a. Additive a => a
zero = forall a. TrigField a => a
pi forall a. Divisive a => a -> a -> a
/ (forall a. Multiplicative a => a
one forall a. Additive a => a -> a -> a
+ forall a. Multiplicative a => a
one)
        | a
x forall a. Ord a => a -> a -> Bool
P.< forall a. Multiplicative a => a
one Bool -> Bool -> Bool
P.&& a
y forall a. Ord a => a -> a -> Bool
P.> forall a. Multiplicative a => a
one = forall a. TrigField a => a
pi forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a -> a
atan (a
y forall a. Divisive a => a -> a -> a
/ a
x)
        | (a
x forall a. Ord a => a -> a -> Bool
P.<= forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y forall a. Ord a => a -> a -> Bool
P.< forall a. Additive a => a
zero) Bool -> Bool -> Bool
|| (a
x forall a. Ord a => a -> a -> Bool
P.< forall a. Additive a => a
zero) =
            forall a. Subtractive a => a -> a
negate (a -> a -> a
atan2' (forall a. Subtractive a => a -> a
negate a
y) a
x)
        | a
y forall a. Eq a => a -> a -> Bool
P.== forall a. Additive a => a
zero = forall a. TrigField a => a
pi -- must be after the previous test on zero y
        | a
x forall a. Eq a => a -> a -> Bool
P.== forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y forall a. Eq a => a -> a -> Bool
P.== forall a. Additive a => a
zero = a
y -- must be after the other double zero tests
        | Bool
P.otherwise = a
x forall a. Additive a => a -> a -> a
+ a
y -- x or y is a NaN, return a NaN (via +)

instance (Eq (Whole a), Ring (Whole a), QuotientField a) => QuotientField (EuclideanPair a) where
  type Whole (EuclideanPair a) = EuclideanPair (Whole a)

  properFraction :: EuclideanPair a -> (Whole (EuclideanPair a), EuclideanPair a)
properFraction (EuclideanPair (a
x, a
y)) =
    (forall a. (a, a) -> EuclideanPair a
EuclideanPair (Whole a
xwhole, Whole a
ywhole), forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
xfrac, a
yfrac))
    where
      (Whole a
xwhole, a
xfrac) = forall a. QuotientField a => a -> (Whole a, a)
properFraction a
x
      (Whole a
ywhole, a
yfrac) = forall a. QuotientField a => a -> (Whole a, a)
properFraction a
y

  round :: (Eq (Whole (EuclideanPair a)), Ring (Whole (EuclideanPair a))) =>
EuclideanPair a -> Whole (EuclideanPair a)
round (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a.
(QuotientField a, Eq (Whole a), Ring (Whole a)) =>
a -> Whole a
round a
x, forall a.
(QuotientField a, Eq (Whole a), Ring (Whole a)) =>
a -> Whole a
round a
y)
  ceiling :: Distributive (Whole (EuclideanPair a)) =>
EuclideanPair a -> Whole (EuclideanPair a)
ceiling (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling a
x, forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling a
y)
  floor :: Ring (Whole (EuclideanPair a)) =>
EuclideanPair a -> Whole (EuclideanPair a)
floor (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor a
x, forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor a
y)
  truncate :: Ring (Whole (EuclideanPair a)) =>
EuclideanPair a -> Whole (EuclideanPair a)
truncate (EuclideanPair (a
x, a
y)) = forall a. (a, a) -> EuclideanPair a
EuclideanPair (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
truncate a
x, forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
truncate a
y)