{-# 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 Prelude qualified as P

-- $setup
--
-- >>> :m -Prelude
-- >>> :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:
--
-- @since 0.11
--
-- > \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.
--
-- @since 0.11
type Absolute a = (Basis a, Mag a ~ a)

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

-- | Basis where the domain, magnitude codomain and basis codomain are the same.
--
-- @since 0.11
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 = a -> a
a -> Mag a
forall a. Basis a => a -> Mag a
magnitude

-- | The sign of a number.
--
-- @since 0.11
--
-- >>> 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 = a -> a
a -> Base a
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 = Double -> Double
Double -> Mag Double
forall a. Num a => a -> a
P.abs
  basis :: Double -> Base Double
basis = Double -> Double
Double -> Base Double
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 = Float -> Float
Float -> Mag Float
forall a. Num a => a -> a
P.abs
  basis :: Float -> Base Float
basis = Float -> Float
Float -> Base Float
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 = Int -> Int
Int -> Mag Int
forall a. Num a => a -> a
P.abs
  basis :: Int -> Base Int
basis = Int -> Int
Int -> Base Int
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 = Integer -> Integer
Integer -> Mag Integer
forall a. Num a => a -> a
P.abs
  basis :: Integer -> Base Integer
basis = Integer -> Integer
Integer -> Base Integer
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 = Natural -> Natural
Natural -> Mag Natural
forall a. Num a => a -> a
P.abs
  basis :: Natural -> Base Natural
basis = Natural -> Natural
Natural -> Base Natural
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 = Int8 -> Int8
Int8 -> Mag Int8
forall a. Num a => a -> a
P.abs
  basis :: Int8 -> Base Int8
basis = Int8 -> Int8
Int8 -> Base Int8
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 = Int16 -> Int16
Int16 -> Mag Int16
forall a. Num a => a -> a
P.abs
  basis :: Int16 -> Base Int16
basis = Int16 -> Int16
Int16 -> Base Int16
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 = Int32 -> Int32
Int32 -> Mag Int32
forall a. Num a => a -> a
P.abs
  basis :: Int32 -> Base Int32
basis = Int32 -> Int32
Int32 -> Base Int32
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 = Int64 -> Int64
Int64 -> Mag Int64
forall a. Num a => a -> a
P.abs
  basis :: Int64 -> Base Int64
basis = Int64 -> Int64
Int64 -> Base Int64
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 = Word -> Word
Word -> Mag Word
forall a. Num a => a -> a
P.abs
  basis :: Word -> Base Word
basis = Word -> Word
Word -> Base Word
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 = Word8 -> Word8
Word8 -> Mag Word8
forall a. Num a => a -> a
P.abs
  basis :: Word8 -> Base Word8
basis = Word8 -> Word8
Word8 -> Base Word8
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 = Word16 -> Word16
Word16 -> Mag Word16
forall a. Num a => a -> a
P.abs
  basis :: Word16 -> Base Word16
basis = Word16 -> Word16
Word16 -> Base Word16
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 = Word32 -> Word32
Word32 -> Mag Word32
forall a. Num a => a -> a
P.abs
  basis :: Word32 -> Base Word32
basis = Word32 -> Word32
Word32 -> Base Word32
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 = Word64 -> Word64
Word64 -> Mag Word64
forall a. Num a => a -> a
P.abs
  basis :: Word64 -> Base Word64
basis = Word64 -> Word64
Word64 -> Base Word64
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 = a -> Mag a
forall a. Basis a => a -> Mag a
magnitude (a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b)

-- | Convert between a "co-ordinated" or "higher-kinded" number and a direction.
--
-- @since 0.7
--
-- > 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.
--
-- @since 0.7
--
-- 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 x. Polar a -> Rep (Polar a) x)
-> (forall x. Rep (Polar a) x -> Polar a) -> Generic (Polar a)
forall x. Rep (Polar a) x -> Polar a
forall x. Polar a -> Rep (Polar a) x
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
$cfrom :: forall a x. Polar a -> Rep (Polar a) x
from :: forall x. Polar a -> Rep (Polar a) x
$cto :: forall a x. Rep (Polar a) x -> Polar a
to :: forall x. Rep (Polar a) x -> Polar a
Generic, Int -> Polar a -> ShowS
[Polar a] -> ShowS
Polar a -> String
(Int -> Polar a -> ShowS)
-> (Polar a -> String) -> ([Polar a] -> ShowS) -> Show (Polar a)
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
$cshowsPrec :: forall a. Show a => Int -> Polar a -> ShowS
showsPrec :: Int -> Polar a -> ShowS
$cshow :: forall a. Show a => Polar a -> String
show :: Polar a -> String
$cshowList :: forall a. Show a => [Polar a] -> ShowS
showList :: [Polar a] -> ShowS
Show, Polar a -> Polar a -> Bool
(Polar a -> Polar a -> Bool)
-> (Polar a -> Polar a -> Bool) -> Eq (Polar a)
forall a. Eq a => Polar a -> Polar a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: 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 = Polar a -> a
Polar a -> Mag (Polar a)
forall a. Polar a -> a
radial
  basis :: Polar a -> Base (Polar a)
basis = Polar a -> a
Polar a -> Base (Polar a)
forall a. Polar a -> a
azimuth

-- | Convert a higher-kinded number that has direction, to a 'Polar'
--
-- @since 0.7
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 = Mag a -> Mag a -> Polar (Mag a)
forall a. a -> a -> Polar a
Polar (a -> Mag a
forall a. Basis a => a -> Mag a
magnitude a
x) (Base a -> Dir (Base a)
forall coord. Direction coord => coord -> Dir coord
angle (a -> Base a
forall a. Basis a => a -> Base a
basis a
x))

-- | Convert a Polar to a (higher-kinded) number that has a direction.
--
-- @since 0.07
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 = Polar (Dir m) -> Dir m
forall a. Polar a -> a
radial Polar (Scalar m)
Polar (Dir m)
x Scalar m -> m -> m
forall m. MultiplicativeAction m => Scalar m -> m -> m
*| Dir m -> m
forall coord. Direction coord => Dir coord -> coord
ray (Polar (Dir m) -> Dir m
forall a. Polar a -> a
azimuth Polar (Scalar m)
Polar (Dir m)
x)

-- | A small number, especially useful for approximate equality.
class
  (Eq a, Additive a) =>
  Epsilon a
  where
  epsilon :: a
  epsilon = a
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 = a
forall a. Epsilon a => a
epsilon a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Epsilon a => a
epsilon Bool -> Bool -> Bool
&& a
forall a. Epsilon a => a
epsilon a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a -> a
forall a. Subtractive a => a -> a
negate a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
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 = a -> Bool
forall a. (Epsilon a, Lattice a, Subtractive a) => a -> Bool
nearZero (a
a a -> 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
(~=) = 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.
--
-- @since 0.11
newtype EuclideanPair a = EuclideanPair {forall a. EuclideanPair a -> (a, a)
euclidPair :: (a, a)}
  deriving stock
    ( (forall x. EuclideanPair a -> Rep (EuclideanPair a) x)
-> (forall x. Rep (EuclideanPair a) x -> EuclideanPair a)
-> Generic (EuclideanPair a)
forall x. Rep (EuclideanPair a) x -> EuclideanPair a
forall x. EuclideanPair a -> Rep (EuclideanPair a) x
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
$cfrom :: forall a x. EuclideanPair a -> Rep (EuclideanPair a) x
from :: forall x. EuclideanPair a -> Rep (EuclideanPair a) x
$cto :: forall a x. Rep (EuclideanPair a) x -> EuclideanPair a
to :: forall x. Rep (EuclideanPair a) x -> EuclideanPair a
Generic,
      EuclideanPair a -> EuclideanPair a -> Bool
(EuclideanPair a -> EuclideanPair a -> Bool)
-> (EuclideanPair a -> EuclideanPair a -> Bool)
-> Eq (EuclideanPair a)
forall a. Eq a => EuclideanPair a -> EuclideanPair a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: EuclideanPair a -> EuclideanPair a -> Bool
Eq,
      Int -> EuclideanPair a -> ShowS
[EuclideanPair a] -> ShowS
EuclideanPair a -> String
(Int -> EuclideanPair a -> ShowS)
-> (EuclideanPair a -> String)
-> ([EuclideanPair a] -> ShowS)
-> Show (EuclideanPair a)
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
$cshowsPrec :: forall a. Show a => Int -> EuclideanPair a -> ShowS
showsPrec :: Int -> EuclideanPair a -> ShowS
$cshow :: forall a. Show a => EuclideanPair a -> String
show :: EuclideanPair a -> String
$cshowList :: forall a. Show a => [EuclideanPair a] -> ShowS
showList :: [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)) = (b, b) -> EuclideanPair b
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 = (a, a) -> EuclideanPair a
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) = (b, b) -> EuclideanPair b
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')) = (c, c) -> EuclideanPair c
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
(+) = (a -> a -> a)
-> EuclideanPair a -> EuclideanPair a -> EuclideanPair a
forall a b c.
(a -> b -> c)
-> EuclideanPair a -> EuclideanPair b -> EuclideanPair c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Additive a => a -> a -> a
(+)
  zero :: EuclideanPair a
zero = a -> EuclideanPair a
forall a. a -> EuclideanPair a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Additive a => a
zero

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

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

instance
  (Subtractive a, Divisive a) =>
  Divisive (EuclideanPair a)
  where
  recip :: EuclideanPair a -> EuclideanPair a
recip = (a -> a) -> EuclideanPair a -> EuclideanPair a
forall a b. (a -> b) -> EuclideanPair a -> EuclideanPair b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
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)) = a -> a -> a
forall a. TrigField a => a -> a -> a
atan2 a
y a
x
  ray :: Dir (EuclideanPair a) -> EuclideanPair a
ray Dir (EuclideanPair a)
x = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> a
forall a. TrigField a => a -> a
cos a
Dir (EuclideanPair a)
x, a -> a
forall a. TrigField a => a -> a
sin a
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)) = a -> a
forall a. ExpField a => a -> a
sqrt (a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y a -> a -> a
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 = EuclideanPair a -> Mag (EuclideanPair a)
forall a. Basis a => a -> Mag a
magnitude EuclideanPair a
p in EuclideanPair a -> EuclideanPair a -> Bool -> EuclideanPair a
forall a. a -> a -> Bool -> a
bool (EuclideanPair a
p EuclideanPair a -> Scalar (EuclideanPair a) -> EuclideanPair a
forall m. DivisiveAction m => m -> Scalar m -> m
|/ Scalar (EuclideanPair a)
Mag (EuclideanPair a)
m) EuclideanPair a
forall a. Additive a => a
zero (a
Mag (EuclideanPair a)
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero)

instance
  (Epsilon a) =>
  Epsilon (EuclideanPair a)
  where
  epsilon :: EuclideanPair a
epsilon = a -> EuclideanPair a
forall a. a -> EuclideanPair a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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')) = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
x a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ a
x', a
y a -> a -> a
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')) = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
x a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
x', a
y a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
y')

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

instance (BoundedMeetSemiLattice a) => BoundedMeetSemiLattice (EuclideanPair a) where
  top :: EuclideanPair a
top = a -> EuclideanPair a
forall a. a -> EuclideanPair a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
Scalar (EuclideanPair a)
s a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x, a
Scalar (EuclideanPair a)
s a -> a -> a
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 = (a -> a) -> EuclideanPair a -> EuclideanPair a
forall a b. (a -> b) -> EuclideanPair a -> EuclideanPair b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Scalar (EuclideanPair a)
-> Scalar (EuclideanPair a) -> Scalar (EuclideanPair a)
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)) = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> a
forall a. ExpField a => a -> a
exp a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. TrigField a => a -> a
cos a
y, a -> a
forall a. ExpField a => a -> a
exp a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. TrigField a => a -> a
sin a
y)
  log :: EuclideanPair a -> EuclideanPair a
log (EuclideanPair (a
x, a
y)) = (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a -> a
forall a. ExpField a => a -> a
log (a -> a
forall a. ExpField a => a -> a
sqrt (a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y)), a -> a -> a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.> a
forall a. Additive a => a
zero = a -> a
forall a. TrigField a => a -> a
atan (a
y a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
x)
        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.> a
forall a. Additive a => a
zero = a
forall a. TrigField a => a
pi 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)
        | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Multiplicative a => a
one Bool -> Bool -> Bool
P.&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.> a
forall a. Multiplicative a => a
one = a
forall a. TrigField a => a
pi a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. TrigField a => a -> a
atan (a
y a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
x)
        | (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.<= a
forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Additive a => a
zero) Bool -> Bool -> Bool
|| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Additive a => a
zero) =
            a -> a
forall a. Subtractive a => a -> a
negate (a -> a -> a
atan2' (a -> a
forall a. Subtractive a => a -> a
negate a
y) a
x)
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero = a
forall a. TrigField a => a
pi -- must be after the previous test on zero y
        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero Bool -> Bool -> Bool
P.&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero = a
y -- must be after the other double zero tests
        | Bool
P.otherwise = a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y -- x or y is a NaN, return a NaN (via +)

instance (QuotientField a, Subtractive 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)) =
    ((Whole a, Whole a) -> EuclideanPair (Whole a)
forall a. (a, a) -> EuclideanPair a
EuclideanPair (Whole a
xwhole, Whole a
ywhole), (a, a) -> EuclideanPair a
forall a. (a, a) -> EuclideanPair a
EuclideanPair (a
xfrac, a
yfrac))
    where
      (Whole a
xwhole, a
xfrac) = a -> (Whole a, a)
forall a. QuotientField a => a -> (Whole a, a)
properFraction a
x
      (Whole a
ywhole, a
yfrac) = a -> (Whole a, a)
forall a. QuotientField a => a -> (Whole a, a)
properFraction a
y

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