{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
module NumHask.Data.Rational
( Ratio(..)
, Rational
, ToRatio(..)
, ToRational
, toRational
, FromRatio(..)
, FromRational
, fromRational
, fromRational'
, fromBaseRational
, reduce
, gcd
)
where
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Data.Bool (bool)
import GHC.Float
import GHC.Natural (Natural(..))
import NumHask.Algebra.Abstract.Additive
import NumHask.Algebra.Abstract.Field
import NumHask.Algebra.Abstract.Multiplicative
import NumHask.Algebra.Abstract.Ring
import NumHask.Algebra.Abstract.Lattice
import NumHask.Analysis.Metric
import NumHask.Data.Integral
import Prelude (Double, Float, Int, Integer, Rational, (.))
import qualified GHC.Real
import qualified Prelude as P
data Ratio a = !a :% !a deriving (P.Show)
instance (P.Eq a, Additive a) => P.Eq (Ratio a) where
a == b
| isRNaN a P.|| isRNaN b = P.False
| P.otherwise = (x P.== x') P.&& (y P.== y')
where
(x:%y) = a
(x':%y') = b
isRNaN :: (P.Eq a, Additive a) => Ratio a -> P.Bool
isRNaN (x :% y)
| x P.== zero P.&& y P.== zero = P.True
| P.otherwise = P.False
instance (P.Ord a, Multiplicative a, Additive a) => P.Ord (Ratio a) where
(x:%y) <= (x':%y') = x * y' P.<= x' * y
(x:%y) < (x':%y') = x * y' P.< x' * y
type GCDConstraints a = (P.Ord a, Signed a, Integral a, Subtractive a)
instance (GCDConstraints a) => Additive (Ratio a) where
(x :% y) + (x' :% y')
| y P.== zero P.&& y' P.== zero = bool one (negate one) (x + x' P.< zero) :% zero
| y P.== zero = x :% y
| y' P.== zero = x' :% y'
| P.otherwise = reduce ((x * y') + (x' * y)) (y * y')
zero = zero :% one
instance (GCDConstraints a) => Subtractive (Ratio a) where
negate (x :% y) = negate x :% y
instance (GCDConstraints a) => Multiplicative (Ratio a) where
(x:%y) * (x':%y') = reduce (x * x') (y * y')
one = one :% one
instance (GCDConstraints a) =>
Divisive (Ratio a) where
recip (x :% y)
| sign x P.== negate one = negate y :% negate x
| P.otherwise = y :% x
instance (GCDConstraints a) => Distributive (Ratio a)
instance (GCDConstraints a) => IntegralDomain (Ratio a)
instance (GCDConstraints a) => Field (Ratio a)
instance (GCDConstraints a, GCDConstraints b, ToInteger a, Field a, FromIntegral b a) => QuotientField (Ratio a) b where
properFraction (n :% d) = let (w,r) = quotRem n d in (fromIntegral_ w,r:%d)
instance (GCDConstraints a, Distributive a, IntegralDomain a) =>
UpperBoundedField (Ratio a)
instance (GCDConstraints a, Field a) => LowerBoundedField (Ratio a)
instance (GCDConstraints a) => Signed (Ratio a) where
sign (n :% _)
| n P.== zero = zero
| n P.> zero = one
| P.otherwise = negate one
abs (n :% d) = abs n :% abs d
instance (GCDConstraints a) => Normed (Ratio a) (Ratio a) where
normL1 = abs
normL2 = abs
instance (GCDConstraints a) => Metric (Ratio a) (Ratio a) where
distanceL1 a b = normL1 (a - b)
distanceL2 a b = normL2 (a - b)
instance (GCDConstraints a, MeetSemiLattice a) => Epsilon (Ratio a)
instance (FromIntegral a b, Multiplicative a) => FromIntegral (Ratio a) b where
fromIntegral_ x = fromIntegral_ x :% one
class ToRatio a b where
toRatio :: a -> Ratio b
default toRatio :: (Ratio c ~ a, ToIntegral c Integer, ToRatio (Ratio b) b, FromInteger b) => a -> Ratio b
toRatio (n :% d) = toRatio ((fromIntegral n :: b) :% fromIntegral d)
type ToRational a = ToRatio a Integer
toRational :: (ToRatio a Integer) => a -> Ratio Integer
toRational = toRatio
instance ToRatio Double Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Float Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Rational Integer where
toRatio = fromBaseRational
instance ToRatio (Ratio Integer) Integer where
toRatio = P.id
instance ToRatio Int Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Integer Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Natural Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Int8 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Int16 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Int32 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Int64 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Word Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Word8 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Word16 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Word32 Integer where
toRatio = fromBaseRational . P.toRational
instance ToRatio Word64 Integer where
toRatio = fromBaseRational . P.toRational
class FromRatio a b where
fromRatio :: Ratio b -> a
default fromRatio :: (Ratio b ~ a) => Ratio b -> a
fromRatio = P.id
fromBaseRational :: P.Rational -> Ratio Integer
fromBaseRational (n GHC.Real.:% d) = n :% d
instance FromRatio Double Integer where
fromRatio (n:%d)= rationalToDouble n d
instance FromRatio Float Integer where
fromRatio (n:%d)= rationalToFloat n d
instance FromRatio Rational Integer where
fromRatio (n:%d) = n GHC.Real.% d
instance FromRatio (Ratio Integer) Integer where
fromRatio = P.id
class FromRational a where
fromRational :: P.Rational -> a
default fromRational :: (FromRatio a Integer) => P.Rational -> a
fromRational = fromRatio . fromBaseRational
instance FromRational Double
instance FromRational Float
instance FromRational Rational
fromRational' :: (FromRatio b Integer, ToRatio a Integer) => a -> b
fromRational' a = fromRatio (toRatio a :: Ratio Integer)
instance (GCDConstraints a) => JoinSemiLattice (Ratio a) where
(\/) = P.min
instance (GCDConstraints a) => MeetSemiLattice (Ratio a) where
(/\) = P.max
reduce
:: (P.Eq a, Subtractive a, Signed a, Integral a) => a -> a -> Ratio a
reduce x y
| x P.== zero P.&& y P.== zero = zero :% zero
| z P.== zero = one :% zero
| P.otherwise = (x `quot` z) % (y `quot` z)
where
z = gcd x y
n % d
| sign d P.== negate one = negate n :% negate d
| P.otherwise = n :% d
gcd :: (P.Eq a, Signed a, Integral a) => a -> a -> a
gcd x y = gcd' (abs x) (abs y)
where
gcd' a b
| b P.== zero = a
| P.otherwise = gcd' b (a `rem` b)