{-# LANGUAGE MultiParamTypeClasses #-}
module Algebra.Morphism.Ratio where

import Algebra.Classes
import Prelude (Ord(..), Eq(..),Integer,Show(..), error, otherwise, (.), Int, ($))
import Text.Show (showParen, showString)
import qualified Data.Ratio
------------------------------------------------------------------------
-- Divide by zero and arithmetic overflow
------------------------------------------------------------------------

-- We put them here because they are needed relatively early
-- in the libraries before the Exception type has been defined yet.

{-# NOINLINE divZeroError #-}
divZeroError :: a
divZeroError :: forall a. a
divZeroError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"division by zero"

{-# NOINLINE ratioZeroDenominatorError #-}
ratioZeroDenominatorError :: a
ratioZeroDenominatorError :: forall a. a
ratioZeroDenominatorError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"ratioZeroDenomException"

{-# NOINLINE overflowError #-}
overflowError :: a
overflowError :: forall a. a
overflowError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"overflowException"

{-# NOINLINE underflowError #-}
underflowError :: a
underflowError :: forall a. a
underflowError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"underflowException"


data  Ratio a = !a :% !a  deriving Ratio a -> Ratio a -> Bool
(Ratio a -> Ratio a -> Bool)
-> (Ratio a -> Ratio a -> Bool) -> Eq (Ratio a)
forall a. Eq a => Ratio a -> Ratio a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Ratio a -> Ratio a -> Bool
== :: Ratio a -> Ratio a -> Bool
$c/= :: forall a. Eq a => Ratio a -> Ratio a -> Bool
/= :: Ratio a -> Ratio a -> Bool
Eq -- ^ @since 2.01

type Rational = Ratio Integer

--------------------------------------------------------------
-- Instances for @Ratio@
--------------------------------------------------------------

-- | @since 2.0.1
instance  (Integral a)  => Ord (Ratio a)  where
    {-# SPECIALIZE instance Ord Rational #-}
    (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
<= 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
<  a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y

-- | @since 2.0.1
instance  EuclideanDomain a  => Additive (Ratio a)  where
  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
  (a
x:%a
y) + :: Ratio a -> Ratio a -> Ratio a
+ (a
x':%a
y')   =  a -> a -> Ratio a
forall a. EuclideanDomain a => a -> a -> Ratio a
reduce (a
xa -> 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
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y')

instance EuclideanDomain a => Multiplicative (Ratio a) where
  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
  (a
x:%a
y) * :: Ratio a -> Ratio a -> Ratio a
* (a
x':%a
y')   =  a -> a -> Ratio a
forall a. EuclideanDomain 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')

instance EuclideanDomain a => Group (Ratio a) where
    (a
x:%a
y) - :: Ratio a -> Ratio a -> Ratio a
- (a
x':%a
y')   =  a -> a -> Ratio a
forall a. EuclideanDomain a => a -> a -> Ratio a
reduce (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y' a -> a -> a
forall a. Group a => a -> a -> a
- a
x'a -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y) (a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y')
    negate :: Ratio a -> Ratio a
negate (a
x:%a
y)       =  (a -> a
forall a. Group a => a -> a
negate a
x) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y

    -- abs (x:%y)          =  abs x :% y
    -- signum (x:%_)       =  signum x :% 1
    -- fromInteger x       =  fromInteger x :% 1

instance EuclideanDomain a => AbelianAdditive (Ratio a)
instance EuclideanDomain a => Ring (Ratio a)
instance EuclideanDomain a => Scalable (Ratio a) (Ratio a) where
  *^ :: Ratio a -> Ratio a -> Ratio a
(*^) = Ratio a -> Ratio a -> Ratio a
forall a. Multiplicative a => a -> a -> a
(*)
  
-- | @since 2.0.1
instance  (EuclideanDomain a)  => Division (Ratio a)  where
    {-# SPECIALIZE instance Division Rational #-}
    (a
x:%a
y) / :: Ratio a -> Ratio a -> Ratio a
/ (a
x':%a
y')   =  (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y') a -> a -> Ratio a
forall a. EuclideanDomain a => a -> a -> Ratio a
% (a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x')
    -- recip (x:%y)
    --     | isZero x =  ratioZeroDenominatorError
    --     | x < 0         = negate y :% negate x
    --     | otherwise     = y :% x

instance EuclideanDomain a => Field (Ratio a) where
    fromRational :: Rational -> Ratio a
fromRational Rational
x =  Integer -> a
forall a. Ring a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
Data.Ratio.numerator Rational
x) a -> a -> Ratio a
forall a. EuclideanDomain a => a -> a -> Ratio a
% Integer -> a
forall a. Ring a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
Data.Ratio.denominator Rational
x)

-- | @since 2.0.1
-- instance  (Integral a)  => Real (Ratio a)  where
--     {-# SPECIALIZE instance Real Rational #-}
--     toRational (x:%y)   =  toInteger x :% toInteger y

-- -- | @since 2.0.1
-- instance  (Integral a)  => RealFrac (Ratio a)  where
--     {-# SPECIALIZE instance RealFrac Rational #-}
--     properFraction (x:%y) = (fromInteger (toInteger q), r:%y)
--                           where (q,r) = quotRem x y
--     round r =
--       let
--         (n, f) = properFraction r
--         x = if r < 0 then -1 else 1
--       in
--         case (compare (abs f) 0.5, odd n) of
--           (LT, _) -> n
--           (EQ, False) -> n
--           (EQ, True) -> n + x
--           (GT, _) -> n + x

-- | @since 2.0.1
instance  (Show a)  => Show (Ratio a)  where
    {-# SPECIALIZE instance Show Rational #-}
    showsPrec :: Int -> Ratio a -> ShowS
showsPrec Int
p (a
x:%a
y)  =  Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ratioPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                           Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
ratioPrec1 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           [Char] -> ShowS
showString [Char]
" % " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
ratioPrec1 a
y



-- | 'reduce' is a subsidiary function used only in this module.
-- It normalises a ratio by dividing both numerator and denominator by
-- their greatest common divisor.
reduce ::  (EuclideanDomain a) => a -> a -> Ratio a
{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}
reduce :: forall a. EuclideanDomain a => a -> a -> Ratio a
reduce a
x a
y | a -> Bool
forall r. DecidableZero r => r -> Bool
isZero a
y = Ratio a
forall a. a
ratioZeroDenominatorError
           | Bool
otherwise = (a
x a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`quot` a
d) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% (a
y a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`quot` a
d)
             where d :: a
d = a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
gcd a
x a
y

(%) :: EuclideanDomain a => a -> a -> Ratio a
a
x % :: forall a. EuclideanDomain a => a -> a -> Ratio a
% a
y =  a -> a -> Ratio a
forall a. EuclideanDomain a => a -> a -> Ratio a
reduce (a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
sign) a
a
  where (a
a,a
sign) = a -> (a, a)
forall a. EuclideanDomain a => a -> (a, a)
normalize a
y

ratioPrec, ratioPrec1 :: Int
ratioPrec :: Int
ratioPrec  = Int
7  -- Precedence of ':%' constructor
ratioPrec1 :: Int
ratioPrec1 = Int
ratioPrec Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1