-- | Provides the 'MetricSpace' typeclass.
--
-- @since 0.1
module Numeric.Algebra.MetricSpace
  ( MetricSpace (..),
    diffℝ,
  )
where

import Data.Complex (Complex, magnitude)
import Data.Fixed (Fixed, HasResolution)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Constraint, Type)
import Data.Ratio (Ratio)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Float (float2Double)
import GHC.Natural (Natural)

-- | Defines a metric space. A metric is a function
-- \(d : M \times M \to \mathbb{R}\) s.t. for all \(x, y, z \in M\):
--
-- * \(d(x, x) = 0\)
-- * __Positivity__: If \(x \ne y\), then \(d(x, y) > 0\)
-- * __Symmetry__: \(d(x, y) = d(y, x)\)
-- * __Triangle equality__: \(d(x, z) \le d(x, y) + d(y, z) \)
--
-- @since 0.1
type MetricSpace :: Type -> Constraint
class MetricSpace s where
  -- | @since 0.1
  diffR :: s -> s -> Double

-- | Unicode alias for 'diffR', with U+211D.
--
-- @since 0.1
diffℝ :: (MetricSpace a) => a -> a -> Double
diffℝ :: forall a. MetricSpace a => a -> a -> Double
diffℝ = a -> a -> Double
forall a. MetricSpace a => a -> a -> Double
diffR

-- | @since 0.1
instance MetricSpace Double where
  diffR :: Double -> Double -> Double
diffR Double
x Double
y = Double -> Double
forall a. Num a => a -> a
abs (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Float where
  diffR :: Float -> Float -> Double
diffR Float
x Float
y = Float -> Double
float2Double (Float -> Double) -> Float -> Double
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
abs (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Int where
  diffR :: Int -> Int -> Double
diffR Int
x Int
y = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Int8 where
  diffR :: Int8 -> Int8 -> Double
diffR Int8
x Int8
y = Int8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Double) -> Int8 -> Double
forall a b. (a -> b) -> a -> b
$ Int8 -> Int8
forall a. Num a => a -> a
abs (Int8
y Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Int16 where
  diffR :: Int16 -> Int16 -> Double
diffR Int16
x Int16
y = Int16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Double) -> Int16 -> Double
forall a b. (a -> b) -> a -> b
$ Int16 -> Int16
forall a. Num a => a -> a
abs (Int16
y Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Int32 where
  diffR :: Int32 -> Int32 -> Double
diffR Int32
x Int32
y = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32
forall a. Num a => a -> a
abs (Int32
y Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Int64 where
  diffR :: Int64 -> Int64 -> Double
diffR Int64
x Int64
y = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
abs (Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Integer where
  diffR :: Integer -> Integer -> Double
diffR Integer
x Integer
y = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Word where
  diffR :: Word -> Word -> Double
diffR = Word -> Word -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Word8 where
  diffR :: Word8 -> Word8 -> Double
diffR = Word8 -> Word8 -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Word16 where
  diffR :: Word16 -> Word16 -> Double
diffR = Word16 -> Word16 -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Word32 where
  diffR :: Word32 -> Word32 -> Double
diffR = Word32 -> Word32 -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Word64 where
  diffR :: Word64 -> Word64 -> Double
diffR = Word64 -> Word64 -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace Natural where
  diffR :: Natural -> Natural -> Double
diffR = Natural -> Natural -> Double
forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace (Ratio Integer) where
  diffR :: Ratio Integer -> Ratio Integer -> Double
diffR Ratio Integer
x Ratio Integer
y = Ratio Integer -> Double
forall a. Fractional a => Ratio Integer -> a
fromRational (Ratio Integer -> Double) -> Ratio Integer -> Double
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> Ratio Integer
forall a. Num a => a -> a
abs (Ratio Integer
y Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
- Ratio Integer
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance MetricSpace (Ratio Natural) where
  diffR :: Ratio Natural -> Ratio Natural -> Double
diffR Ratio Natural
x Ratio Natural
y
    | Ratio Natural
x Ratio Natural -> Ratio Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Ratio Natural
y = Ratio Natural -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Ratio Natural -> Double) -> Ratio Natural -> Double
forall a b. (a -> b) -> a -> b
$ Ratio Natural
y Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Num a => a -> a -> a
- Ratio Natural
x
    | Bool
otherwise = Ratio Natural -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Ratio Natural -> Double) -> Ratio Natural -> Double
forall a b. (a -> b) -> a -> b
$ Ratio Natural
x Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Num a => a -> a -> a
- Ratio Natural
y
  {-# INLINE diffR #-}

-- | @since 0.1
instance (RealFloat a) => MetricSpace (Complex a) where
  -- NOTE: magnitude === abs except the latter adds an (+ 0i) imaginary part,
  -- to keep the type the same. Thus this agrees with the usual complex
  -- metric in terms of its norm.
  diffR :: Complex a -> Complex a -> Double
diffR Complex a
x Complex a
y = a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> Double) -> a -> Double
forall a b. (a -> b) -> a -> b
$ Complex a -> a
forall a. RealFloat a => Complex a -> a
magnitude (Complex a
y Complex a -> Complex a -> Complex a
forall a. Num a => a -> a -> a
- Complex a
x)
  {-# INLINE diffR #-}

-- | @since 0.1
instance (HasResolution k) => MetricSpace (Fixed k) where
  diffR :: Fixed k -> Fixed k -> Double
diffR Fixed k
x Fixed k
y = Fixed k -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Fixed k -> Double) -> Fixed k -> Double
forall a b. (a -> b) -> a -> b
$ Fixed k -> Fixed k
forall a. Num a => a -> a
abs (Fixed k
y Fixed k -> Fixed k -> Fixed k
forall a. Num a => a -> a -> a
- Fixed k
x)
  {-# INLINE diffR #-}

diffNonNeg :: (Integral a, Num b) => a -> a -> b
diffNonNeg :: forall a b. (Integral a, Num b) => a -> a -> b
diffNonNeg a
x a
y
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
x)
  | Bool
otherwise = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y