{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}

-- | Rational classes
module NumHask.Data.Rational
  ( Ratio (..),
    Rational,
    ToRatio (..),
    FromRatio (..),
    FromRational (..),
    reduce,
    gcd,
  )
where

import Data.Bool (bool)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word, Word16, Word32, Word64, Word8)
import GHC.Float
import GHC.Natural (Natural (..))
import qualified GHC.Real
import NumHask.Algebra.Additive
import NumHask.Algebra.Field
import NumHask.Algebra.Lattice
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import NumHask.Analysis.Metric
import NumHask.Data.Integral
import Prelude (Int, Integer, Ord (..), Ordering (..), Rational, (.))
import qualified Prelude as P

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

-- | A rational number
data Ratio a = !a :% !a deriving (Int -> Ratio a -> ShowS
[Ratio a] -> ShowS
Ratio a -> String
(Int -> Ratio a -> ShowS)
-> (Ratio a -> String) -> ([Ratio a] -> ShowS) -> Show (Ratio a)
forall a. Show a => Int -> Ratio a -> ShowS
forall a. Show a => [Ratio a] -> ShowS
forall a. Show a => Ratio a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ratio a] -> ShowS
$cshowList :: forall a. Show a => [Ratio a] -> ShowS
show :: Ratio a -> String
$cshow :: forall a. Show a => Ratio a -> String
showsPrec :: Int -> Ratio a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ratio a -> ShowS
P.Show)

instance (P.Eq a, Additive a) => P.Eq (Ratio a) where
  Ratio a
a == :: Ratio a -> Ratio a -> Bool
== Ratio a
b
    | Ratio a -> Bool
forall a. (Eq a, Additive a) => Ratio a -> Bool
isRNaN Ratio a
a Bool -> Bool -> Bool
P.|| Ratio a -> Bool
forall a. (Eq a, Additive a) => Ratio a -> Bool
isRNaN Ratio a
b = Bool
P.False
    | Bool
P.otherwise = (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
x') Bool -> Bool -> Bool
P.&& (a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
y')
    where
      (a
x :% a
y) = Ratio a
a
      (a
x' :% a
y') = Ratio a
b

-- | Has a zero denominator
isRNaN :: (P.Eq a, Additive a) => Ratio a -> P.Bool
isRNaN :: Ratio a -> Bool
isRNaN (a
x :% a
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 = Bool
P.True
  | Bool
P.otherwise = Bool
P.False

instance (P.Ord a, Multiplicative a, Additive a) => P.Ord (Ratio a) where
  (a
x :% a
y) <= :: Ratio a -> Ratio a -> Bool
<= (a
x' :% a
y') = a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.<= a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y
  (a
x :% a
y) < :: Ratio a -> Ratio a -> Bool
< (a
x' :% a
y') = a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y

instance (P.Ord a, Signed a, Integral a, Ring a) => Additive (Ratio a) where
  (a
x :% a
y) + :: Ratio a -> Ratio a -> Ratio a
+ (a
x' :% a
y')
    | a
y 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 -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
forall a. Multiplicative a => a
one (a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one) (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
P.< a
forall a. Additive a => a
zero) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Additive a => a
zero
    | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero = a
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y
    | a
y' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero = a
x' a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y'
    | Bool
P.otherwise = a -> a -> Ratio a
forall a.
(Eq a, Subtractive a, Signed a, Integral a) =>
a -> a -> Ratio a
reduce ((a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y') a -> a -> a
forall a. Additive a => a -> a -> a
+ (a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y)) (a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y')

  zero :: Ratio a
zero = a
forall a. Additive a => a
zero a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Multiplicative a => a
one

instance (P.Ord a, Signed a, Integral a, Ring a) => Subtractive (Ratio a) where
  negate :: Ratio a -> Ratio a
negate (a
x :% a
y) = a -> a
forall a. Subtractive a => a -> a
negate a
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y

instance (P.Ord a, Signed a, Integral a, Ring a, Multiplicative a) => Multiplicative (Ratio a) where
  (a
x :% a
y) * :: Ratio a -> Ratio a -> Ratio a
* (a
x' :% a
y') = a -> a -> Ratio a
forall a.
(Eq a, Subtractive a, Signed a, Integral a) =>
a -> a -> Ratio a
reduce (a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x') (a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y')

  one :: Ratio a
one = a
forall a. Multiplicative a => a
one a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Multiplicative a => a
one

instance
  (P.Ord a, Signed a, Integral a, Ring a) =>
  Divisive (Ratio a)
  where
  recip :: Ratio a -> Ratio a
recip (a
x :% a
y)
    | a -> a
forall a. Signed a => a -> a
sign a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one = a -> a
forall a. Subtractive a => a -> a
negate a
y a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a -> a
forall a. Subtractive a => a -> a
negate a
x
    | Bool
P.otherwise = a
y a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
x

instance (P.Ord a, Signed a, Integral a, Ring a) => Distributive (Ratio a)

instance (P.Ord a, Signed a, Integral a, Ring a) => Field (Ratio a)

instance (P.Ord a, Signed a, Integral a, Ring a, P.Ord b, Signed b, Integral b, Ring b, Field a, FromIntegral b a) => QuotientField (Ratio a) b where
  properFraction :: Ratio a -> (b, Ratio a)
properFraction (a
n :% a
d) = let (a
w, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d in (a -> b
forall a b. FromIntegral a b => b -> a
fromIntegral a
w, a
r a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
d)

instance
  (P.Ord a, Signed a, Integral a, Ring a, Distributive a) =>
  UpperBoundedField (Ratio a)

instance (P.Ord a, Signed a, Integral a, Field a) => LowerBoundedField (Ratio a)

instance (P.Ord a, Signed a, Integral a, Ring a) => Signed (Ratio a) where
  sign :: Ratio a -> Ratio a
sign (a
n :% a
_) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
n a
forall a. Additive a => a
zero of
      Ordering
EQ -> Ratio a
forall a. Additive a => a
zero
      Ordering
GT -> Ratio a
forall a. Multiplicative a => a
one
      Ordering
LT -> Ratio a -> Ratio a
forall a. Subtractive a => a -> a
negate Ratio a
forall a. Multiplicative a => a
one
  abs :: Ratio a -> Ratio a
abs (a
n :% a
d) = a -> a
forall a. Signed a => a -> a
abs a
n a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a -> a
forall a. Signed a => a -> a
abs a
d

instance (P.Ord a, Signed a, Integral a, Ring a) => Norm (Ratio a) (Ratio a) where
  norm :: Ratio a -> Ratio a
norm = Ratio a -> Ratio a
forall a. Signed a => a -> a
abs
  basis :: Ratio a -> Ratio a
basis = Ratio a -> Ratio a
forall a. Signed a => a -> a
sign

instance (P.Ord a, Signed a) => JoinSemiLattice (Ratio a) where
  \/ :: Ratio a -> Ratio a -> Ratio a
(\/) = Ratio a -> Ratio a -> Ratio a
forall a. Ord a => a -> a -> a
P.min

instance (P.Ord a, Signed a) => MeetSemiLattice (Ratio a) where
  /\ :: Ratio a -> Ratio a -> Ratio a
(/\) = Ratio a -> Ratio a -> Ratio a
forall a. Ord a => a -> a -> a
P.max

instance (P.Ord a, Signed a, Integral a, Ring a, MeetSemiLattice a) => Epsilon (Ratio a)

instance (FromIntegral a b, Multiplicative a) => FromIntegral (Ratio a) b where
  fromIntegral :: b -> Ratio a
fromIntegral b
x = b -> a
forall a b. FromIntegral a b => b -> a
fromIntegral b
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Multiplicative a => a
one

-- | toRatio is equivalent to `GHC.Real.Real` in base, but is polymorphic in the Integral type.
--
-- > toRatio (3.1415927 :: Float) :: Ratio Integer
-- 13176795 :% 4194304
class ToRatio a b where
  toRatio :: a -> Ratio b
  default toRatio :: (Ratio c ~ a, FromIntegral b c, ToRatio (Ratio b) b) => a -> Ratio b
  toRatio (n :% d) = Ratio b -> Ratio b
forall a b. ToRatio a b => a -> Ratio b
toRatio ((c -> b
forall a b. FromIntegral a b => b -> a
fromIntegral c
n :: b) b -> b -> Ratio b
forall a. a -> a -> Ratio a
:% c -> b
forall a b. FromIntegral a b => b -> a
fromIntegral c
d)

instance ToRatio Double Integer where
  toRatio :: Double -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Double -> Rational) -> Double -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Float Integer where
  toRatio :: Float -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Float -> Rational) -> Float -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Rational Integer where
  toRatio :: Rational -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational

instance ToRatio (Ratio Integer) Integer where
  toRatio :: Ratio Integer -> Ratio Integer
toRatio = Ratio Integer -> Ratio Integer
forall a. a -> a
P.id

instance ToRatio Int Integer where
  toRatio :: Int -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Int -> Rational) -> Int -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Integer Integer where
  toRatio :: Integer -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Integer -> Rational) -> Integer -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Natural Integer where
  toRatio :: Natural -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Natural -> Rational) -> Natural -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Int8 Integer where
  toRatio :: Int8 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Int8 -> Rational) -> Int8 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Int16 Integer where
  toRatio :: Int16 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Int16 -> Rational) -> Int16 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Int32 Integer where
  toRatio :: Int32 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Int32 -> Rational) -> Int32 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Int64 Integer where
  toRatio :: Int64 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Int64 -> Rational) -> Int64 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Word Integer where
  toRatio :: Word -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Word -> Rational) -> Word -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Word8 Integer where
  toRatio :: Word8 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Word8 -> Rational) -> Word8 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Word16 Integer where
  toRatio :: Word16 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Word16 -> Rational) -> Word16 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Word32 Integer where
  toRatio :: Word32 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Word32 -> Rational) -> Word32 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Rational
forall a. Real a => a -> Rational
P.toRational

instance ToRatio Word64 Integer where
  toRatio :: Word64 -> Ratio Integer
toRatio = Rational -> Ratio Integer
fromBaseRational (Rational -> Ratio Integer)
-> (Word64 -> Rational) -> Word64 -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Rational
forall a. Real a => a -> Rational
P.toRational

-- | `GHC.Real.Fractional` in base splits into fromRatio and Field
--
-- >>> fromRatio (5 :% 2 :: Ratio Integer) :: Double
-- 2.5
class FromRatio a b where
  fromRatio :: Ratio b -> a
  default fromRatio :: (Ratio b ~ a) => Ratio b -> a
  fromRatio = Ratio b -> a
forall a. a -> a
P.id

fromBaseRational :: P.Rational -> Ratio Integer
fromBaseRational :: Rational -> Ratio Integer
fromBaseRational (Integer
n GHC.Real.:% Integer
d) = Integer
n Integer -> Integer -> Ratio Integer
forall a. a -> a -> Ratio a
:% Integer
d

instance FromRatio Double Integer where
  fromRatio :: Ratio Integer -> Double
fromRatio (Integer
n :% Integer
d) = Integer -> Integer -> Double
rationalToDouble Integer
n Integer
d

instance FromRatio Float Integer where
  fromRatio :: Ratio Integer -> Float
fromRatio (Integer
n :% Integer
d) = Integer -> Integer -> Float
rationalToFloat Integer
n Integer
d

instance FromRatio Rational Integer where
  fromRatio :: Ratio Integer -> Rational
fromRatio (Integer
n :% Integer
d) = Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
GHC.Real.% Integer
d

-- | fromRational is special in two ways:
--
-- - numeric decimal literals (like "53.66") are interpreted as exactly "fromRational (53.66 :: GHC.Real.Ratio Integer)". The prelude version, GHC.Real.fromRational is used as default (or whatever is in scope if RebindableSyntax is set).
--
-- - The default rules in < https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-750004.3 haskell2010> specify that contraints on 'fromRational' need to be in a form @C v@, where v is a Num or a subclass of Num.
--
-- So a type synonym of `type FromRational a = FromRatio a Integer` doesn't work well with type defaulting; hence the need for a separate class.
class FromRational a where
  fromRational :: P.Rational -> a

instance FromRational Double where
  fromRational :: Rational -> Double
fromRational (Integer
n GHC.Real.:% Integer
d) = Integer -> Integer -> Double
rationalToDouble Integer
n Integer
d

instance FromRational Float where
  fromRational :: Rational -> Float
fromRational (Integer
n GHC.Real.:% Integer
d) = Integer -> Integer -> Float
rationalToFloat Integer
n Integer
d

instance FromRational (Ratio Integer) where
  fromRational :: Rational -> Ratio Integer
fromRational (Integer
n GHC.Real.:% Integer
d) = Integer
n Integer -> Integer -> Ratio Integer
forall a. a -> a -> Ratio a
:% Integer
d

-- | 'reduce' normalises a ratio by dividing both numerator and denominator by
-- their greatest common divisor.
reduce ::
  (P.Eq a, Subtractive a, Signed a, Integral a) => a -> a -> Ratio a
reduce :: a -> a -> Ratio a
reduce a
x a
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
forall a. Additive a => a
zero a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Additive a => a
zero
  | a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a
forall a. Additive a => a
zero = a
forall a. Multiplicative a => a
one a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
forall a. Additive a => a
zero
  | Bool
P.otherwise = (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
z) a -> a -> Ratio a
forall a. (Eq a, Signed a, Subtractive a) => a -> a -> Ratio a
% (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
z)
  where
    z :: a
z = a -> a -> a
forall a. (Eq a, Signed a, Integral a) => a -> a -> a
gcd a
x a
y
    a
n % :: a -> a -> Ratio a
% a
d
      | a -> a
forall a. Signed a => a -> a
sign a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
P.== a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one = a -> a
forall a. Subtractive a => a -> a
negate a
n a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a -> a
forall a. Subtractive a => a -> a
negate a
d
      | Bool
P.otherwise = a
n a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
d

-- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which
-- every common factor of @x@ and @y@ is also a factor; for example
-- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@.
-- (That is, the common divisor that is \"greatest\" in the divisibility
-- preordering.)
--
-- Note: Since for signed fixed-width integer types, @'abs' 'GHC.Enum.minBound' < 0@,
-- the result may be negative if one of the arguments is @'GHC.Enum.minBound'@ (and
-- necessarily is if the other is @0@ or @'GHC.Enum.minBound'@) for such types.
gcd :: (P.Eq a, Signed a, Integral a) => a -> a -> a
gcd :: a -> a -> a
gcd a
x a
y = a -> a -> a
forall t. (Eq t, Integral t) => t -> t -> t
gcd' (a -> a
forall a. Signed a => a -> a
abs a
x) (a -> a
forall a. Signed a => a -> a
abs a
y)
  where
    gcd' :: t -> t -> t
gcd' t
a t
b
      | t
b t -> t -> Bool
forall a. Eq a => a -> a -> Bool
P.== t
forall a. Additive a => a
zero = t
a
      | Bool
P.otherwise = t -> t -> t
gcd' t
b (t
a t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
b)