{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -Wall #-}

-- | Metric classes
module NumHask.Algebra.Metric
  ( Signed (..),
    Norm (..),
    distance,
    Direction (..),
    Polar (..),
    polar,
    coord,
    Epsilon (..),
    (~=),
  )
where

import Data.Bool (bool)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics (Generic)
import GHC.Natural (Natural (..))
import NumHask.Algebra.Additive (Additive (zero), Subtractive (..))
import NumHask.Algebra.Lattice (MeetSemiLattice, meetLeq)
import NumHask.Algebra.Module (MultiplicativeAction ((.*)))
import NumHask.Algebra.Multiplicative (Multiplicative (one))
import Prelude hiding
  ( Bounded (..),
    Integral (..),
    negate,
    (*),
    (-),
  )
import qualified Prelude as P

-- | 'signum' from base is not an operator name in numhask and is replaced by 'sign'.  Compare with 'Norm' where there is a change in codomain.
--
-- > abs a * sign a == a
--
-- abs zero == zero, so any value for sign zero is ok.  We choose lawful neutral:
--
-- > sign zero == zero
class
  (Additive a, Multiplicative a) =>
  Signed a
  where
  sign :: a -> a
  abs :: a -> a

instance Signed Double where
  sign :: Double -> Double
sign Double
a =
    case Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
a Double
forall a. Additive a => a
zero of
      Ordering
EQ -> Double
forall a. Additive a => a
zero
      Ordering
GT -> Double
forall a. Multiplicative a => a
one
      Ordering
LT -> Double -> Double
forall a. Subtractive a => a -> a
negate Double
forall a. Multiplicative a => a
one
  abs :: Double -> Double
abs = Double -> Double
forall a. Num a => a -> a
P.abs

instance Signed Float where
  sign :: Float -> Float
sign Float
a =
    case Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
a Float
forall a. Additive a => a
zero of
      Ordering
EQ -> Float
forall a. Additive a => a
zero
      Ordering
GT -> Float
forall a. Multiplicative a => a
one
      Ordering
LT -> Float -> Float
forall a. Subtractive a => a -> a
negate Float
forall a. Multiplicative a => a
one
  abs :: Float -> Float
abs = Float -> Float
forall a. Num a => a -> a
P.abs

instance Signed Int where
  sign :: Int -> Int
sign Int
a =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
forall a. Additive a => a
zero of
      Ordering
EQ -> Int
forall a. Additive a => a
zero
      Ordering
GT -> Int
forall a. Multiplicative a => a
one
      Ordering
LT -> Int -> Int
forall a. Subtractive a => a -> a
negate Int
forall a. Multiplicative a => a
one
  abs :: Int -> Int
abs = Int -> Int
forall a. Num a => a -> a
P.abs

instance Signed Integer where
  sign :: Integer -> Integer
sign Integer
a =
    case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
a Integer
forall a. Additive a => a
zero of
      Ordering
EQ -> Integer
forall a. Additive a => a
zero
      Ordering
GT -> Integer
forall a. Multiplicative a => a
one
      Ordering
LT -> Integer -> Integer
forall a. Subtractive a => a -> a
negate Integer
forall a. Multiplicative a => a
one
  abs :: Integer -> Integer
abs = Integer -> Integer
forall a. Num a => a -> a
P.abs

instance Signed Natural where
  sign :: Natural -> Natural
sign Natural
a =
    case Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
a Natural
forall a. Additive a => a
zero of
      Ordering
EQ -> Natural
forall a. Additive a => a
zero
      Ordering
GT -> Natural
forall a. Multiplicative a => a
one
      Ordering
LT -> Natural -> Natural
forall a. Subtractive a => a -> a
negate Natural
forall a. Multiplicative a => a
one
  abs :: Natural -> Natural
abs = Natural -> Natural
forall a. a -> a
id

instance Signed Int8 where
  sign :: Int8 -> Int8
sign Int8
a =
    case Int8 -> Int8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int8
a Int8
forall a. Additive a => a
zero of
      Ordering
EQ -> Int8
forall a. Additive a => a
zero
      Ordering
GT -> Int8
forall a. Multiplicative a => a
one
      Ordering
LT -> Int8 -> Int8
forall a. Subtractive a => a -> a
negate Int8
forall a. Multiplicative a => a
one
  abs :: Int8 -> Int8
abs = Int8 -> Int8
forall a. Num a => a -> a
P.abs

instance Signed Int16 where
  sign :: Int16 -> Int16
sign Int16
a =
    case Int16 -> Int16 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int16
a Int16
forall a. Additive a => a
zero of
      Ordering
EQ -> Int16
forall a. Additive a => a
zero
      Ordering
GT -> Int16
forall a. Multiplicative a => a
one
      Ordering
LT -> Int16 -> Int16
forall a. Subtractive a => a -> a
negate Int16
forall a. Multiplicative a => a
one
  abs :: Int16 -> Int16
abs = Int16 -> Int16
forall a. Num a => a -> a
P.abs

instance Signed Int32 where
  sign :: Int32 -> Int32
sign Int32
a =
    case Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
a Int32
forall a. Additive a => a
zero of
      Ordering
EQ -> Int32
forall a. Additive a => a
zero
      Ordering
GT -> Int32
forall a. Multiplicative a => a
one
      Ordering
LT -> Int32 -> Int32
forall a. Subtractive a => a -> a
negate Int32
forall a. Multiplicative a => a
one
  abs :: Int32 -> Int32
abs = Int32 -> Int32
forall a. Num a => a -> a
P.abs

instance Signed Int64 where
  sign :: Int64 -> Int64
sign Int64
a =
    case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
a Int64
forall a. Additive a => a
zero of
      Ordering
EQ -> Int64
forall a. Additive a => a
zero
      Ordering
GT -> Int64
forall a. Multiplicative a => a
one
      Ordering
LT -> Int64 -> Int64
forall a. Subtractive a => a -> a
negate Int64
forall a. Multiplicative a => a
one
  abs :: Int64 -> Int64
abs = Int64 -> Int64
forall a. Num a => a -> a
P.abs

instance Signed Word where
  sign :: Word -> Word
sign Word
a = Word -> Word -> Bool -> Word
forall a. a -> a -> Bool -> a
bool Word
forall a. Multiplicative a => a
one Word
forall a. Additive a => a
zero (Word
a Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
forall a. Additive a => a
zero)
  abs :: Word -> Word
abs = Word -> Word
forall a. Num a => a -> a
P.abs

instance Signed Word8 where
  sign :: Word8 -> Word8
sign Word8
a = Word8 -> Word8 -> Bool -> Word8
forall a. a -> a -> Bool -> a
bool Word8
forall a. Multiplicative a => a
one Word8
forall a. Additive a => a
zero (Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Additive a => a
zero)
  abs :: Word8 -> Word8
abs = Word8 -> Word8
forall a. Num a => a -> a
P.abs

instance Signed Word16 where
  sign :: Word16 -> Word16
sign Word16
a = Word16 -> Word16 -> Bool -> Word16
forall a. a -> a -> Bool -> a
bool Word16
forall a. Multiplicative a => a
one Word16
forall a. Additive a => a
zero (Word16
a Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Additive a => a
zero)
  abs :: Word16 -> Word16
abs = Word16 -> Word16
forall a. Num a => a -> a
P.abs

instance Signed Word32 where
  sign :: Word32 -> Word32
sign Word32
a = Word32 -> Word32 -> Bool -> Word32
forall a. a -> a -> Bool -> a
bool Word32
forall a. Multiplicative a => a
one Word32
forall a. Additive a => a
zero (Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Additive a => a
zero)
  abs :: Word32 -> Word32
abs = Word32 -> Word32
forall a. Num a => a -> a
P.abs

instance Signed Word64 where
  sign :: Word64 -> Word64
sign Word64
a = Word64 -> Word64 -> Bool -> Word64
forall a. a -> a -> Bool -> a
bool Word64
forall a. Multiplicative a => a
one Word64
forall a. Additive a => a
zero (Word64
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
forall a. Additive a => a
zero)
  abs :: Word64 -> Word64
abs = Word64 -> Word64
forall a. Num a => a -> a
P.abs

-- | Norm is a slight generalisation of Signed. The class has the same shape but allows the codomain to be different to the domain.
--
-- > norm a >= zero
-- > norm zero == zero
-- > a == norm a .* basis a
-- > norm (basis a) == one
class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b where
  -- | or length, or ||v||
  norm :: a -> b

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

instance Norm Double Double where
  norm :: Double -> Double
norm = Double -> Double
forall a. Num a => a -> a
P.abs
  basis :: Double -> Double
basis = Double -> Double
forall a. Num a => a -> a
P.signum

instance Norm Float Float where
  norm :: Float -> Float
norm = Float -> Float
forall a. Num a => a -> a
P.abs
  basis :: Float -> Float
basis = Float -> Float
forall a. Num a => a -> a
P.signum

instance Norm Int Int where
  norm :: Int -> Int
norm = Int -> Int
forall a. Num a => a -> a
P.abs
  basis :: Int -> Int
basis = Int -> Int
forall a. Num a => a -> a
P.signum

instance Norm Integer Integer where
  norm :: Integer -> Integer
norm = Integer -> Integer
forall a. Num a => a -> a
P.abs
  basis :: Integer -> Integer
basis = Integer -> Integer
forall a. Num a => a -> a
P.signum

instance Norm Natural Natural where
  norm :: Natural -> Natural
norm = Natural -> Natural
forall a. Num a => a -> a
P.abs
  basis :: Natural -> Natural
basis = Natural -> Natural
forall a. Num a => a -> a
P.signum

instance Norm Int8 Int8 where
  norm :: Int8 -> Int8
norm = Int8 -> Int8
forall a. Num a => a -> a
P.abs
  basis :: Int8 -> Int8
basis = Int8 -> Int8
forall a. Num a => a -> a
P.signum

instance Norm Int16 Int16 where
  norm :: Int16 -> Int16
norm = Int16 -> Int16
forall a. Num a => a -> a
P.abs
  basis :: Int16 -> Int16
basis = Int16 -> Int16
forall a. Num a => a -> a
P.signum

instance Norm Int32 Int32 where
  norm :: Int32 -> Int32
norm = Int32 -> Int32
forall a. Num a => a -> a
P.abs
  basis :: Int32 -> Int32
basis = Int32 -> Int32
forall a. Num a => a -> a
P.signum

instance Norm Int64 Int64 where
  norm :: Int64 -> Int64
norm = Int64 -> Int64
forall a. Num a => a -> a
P.abs
  basis :: Int64 -> Int64
basis = Int64 -> Int64
forall a. Num a => a -> a
P.signum

instance Norm Word Word where
  norm :: Word -> Word
norm = Word -> Word
forall a. Num a => a -> a
P.abs
  basis :: Word -> Word
basis = Word -> Word
forall a. Num a => a -> a
P.signum

instance Norm Word8 Word8 where
  norm :: Word8 -> Word8
norm = Word8 -> Word8
forall a. Num a => a -> a
P.abs
  basis :: Word8 -> Word8
basis = Word8 -> Word8
forall a. Num a => a -> a
P.signum

instance Norm Word16 Word16 where
  norm :: Word16 -> Word16
norm = Word16 -> Word16
forall a. Num a => a -> a
P.abs
  basis :: Word16 -> Word16
basis = Word16 -> Word16
forall a. Num a => a -> a
P.signum

instance Norm Word32 Word32 where
  norm :: Word32 -> Word32
norm = Word32 -> Word32
forall a. Num a => a -> a
P.abs
  basis :: Word32 -> Word32
basis = Word32 -> Word32
forall a. Num a => a -> a
P.signum

instance Norm Word64 Word64 where
  norm :: Word64 -> Word64
norm = Word64 -> Word64
forall a. Num a => a -> a
P.abs
  basis :: Word64 -> Word64
basis = Word64 -> Word64
forall a. Num a => a -> a
P.signum

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

-- | Convert between a "co-ordinated" or "higher-kinded" number and representations of an angle. Typically thought of as polar co-ordinate conversion.
--
-- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system)
--
-- > ray . angle == basis
-- > norm (ray x) == one
class (Additive coord, Multiplicative coord, Additive dir, Multiplicative dir) => Direction coord dir | coord -> dir where
  angle :: coord -> dir
  ray :: dir -> coord

-- | Something that has a magnitude and a direction.
data Polar mag dir = Polar {Polar mag dir -> mag
magnitude :: !mag, Polar mag dir -> dir
direction :: !dir}
  deriving (Polar mag dir -> Polar mag dir -> Bool
(Polar mag dir -> Polar mag dir -> Bool)
-> (Polar mag dir -> Polar mag dir -> Bool) -> Eq (Polar mag dir)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall mag dir.
(Eq mag, Eq dir) =>
Polar mag dir -> Polar mag dir -> Bool
/= :: Polar mag dir -> Polar mag dir -> Bool
$c/= :: forall mag dir.
(Eq mag, Eq dir) =>
Polar mag dir -> Polar mag dir -> Bool
== :: Polar mag dir -> Polar mag dir -> Bool
$c== :: forall mag dir.
(Eq mag, Eq dir) =>
Polar mag dir -> Polar mag dir -> Bool
Eq, Int -> Polar mag dir -> ShowS
[Polar mag dir] -> ShowS
Polar mag dir -> String
(Int -> Polar mag dir -> ShowS)
-> (Polar mag dir -> String)
-> ([Polar mag dir] -> ShowS)
-> Show (Polar mag dir)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall mag dir.
(Show mag, Show dir) =>
Int -> Polar mag dir -> ShowS
forall mag dir. (Show mag, Show dir) => [Polar mag dir] -> ShowS
forall mag dir. (Show mag, Show dir) => Polar mag dir -> String
showList :: [Polar mag dir] -> ShowS
$cshowList :: forall mag dir. (Show mag, Show dir) => [Polar mag dir] -> ShowS
show :: Polar mag dir -> String
$cshow :: forall mag dir. (Show mag, Show dir) => Polar mag dir -> String
showsPrec :: Int -> Polar mag dir -> ShowS
$cshowsPrec :: forall mag dir.
(Show mag, Show dir) =>
Int -> Polar mag dir -> ShowS
Show, (forall x. Polar mag dir -> Rep (Polar mag dir) x)
-> (forall x. Rep (Polar mag dir) x -> Polar mag dir)
-> Generic (Polar mag dir)
forall x. Rep (Polar mag dir) x -> Polar mag dir
forall x. Polar mag dir -> Rep (Polar mag dir) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mag dir x. Rep (Polar mag dir) x -> Polar mag dir
forall mag dir x. Polar mag dir -> Rep (Polar mag dir) x
$cto :: forall mag dir x. Rep (Polar mag dir) x -> Polar mag dir
$cfrom :: forall mag dir x. Polar mag dir -> Rep (Polar mag dir) x
Generic)

-- | Convert from a number to a Polar.
polar :: (Norm coord mag, Direction coord dir) => coord -> Polar mag dir
polar :: coord -> Polar mag dir
polar coord
z = mag -> dir -> Polar mag dir
forall mag dir. mag -> dir -> Polar mag dir
Polar (coord -> mag
forall a b. Norm a b => a -> b
norm coord
z) (coord -> dir
forall coord dir. Direction coord dir => coord -> dir
angle coord
z)

-- | Convert from a Polar to a (coordinated aka higher-kinded) number.
coord :: (MultiplicativeAction coord mag, Direction coord dir) => Polar mag dir -> coord
coord :: Polar mag dir -> coord
coord (Polar mag
m dir
d) = mag
m mag -> coord -> coord
forall m a. MultiplicativeAction m a => a -> m -> m
.* dir -> coord
forall coord dir. Direction coord dir => dir -> coord
ray dir
d

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

  nearZero :: a -> Bool
  nearZero a
a = a
forall a. Epsilon a => a
epsilon a -> a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` a
a Bool -> Bool -> Bool
&& a
forall a. Epsilon a => a
epsilon a -> a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` a -> a
forall a. Subtractive a => a -> a
negate a
a

  aboutEqual :: a -> a -> Bool
  aboutEqual a
a a
b = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b

infixl 4 ~=

-- | About equal.
(~=) :: (Epsilon a) => a -> a -> Bool
~= :: a -> a -> Bool
(~=) = a -> a -> Bool
forall a. Epsilon 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