{-# LANGUAGE DeriveDataTypeable, CPP #-}
module MagicHaskeller.FastRatio where
#if __GLASGOW_HASKELL__ >= 706
import Prelude hiding(Ratio, Rational, (%))
#else
import Prelude hiding(Rational)
#endif
import qualified Data.Ratio
import Data.Typeable
import Data.Bits
-- import Test.QuickCheck hiding (choose)
-- import GHC.Integer.GMP.Internals

-- So, the integral type is totally ignored!
data Ratio a = !Integer :% !Integer deriving Typeable

type Rational = Ratio Integer

(%) :: Integral a => a -> a -> Ratio a
a
x % :: a -> a -> Ratio a
% a
y = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% a -> Integer
forall a. Integral a => a -> Integer
toInteger a
y
numerator, denominator :: Integral a => Ratio a -> a
numerator :: Ratio a -> a
numerator   (Integer
n:%Integer
d) = let (Integer
n':%Integer
_ ) = Integer -> Integer -> Ratio Any
forall a. Integer -> Integer -> Ratio a
reduce Integer
n Integer
d in Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
forall a. Num a => a -> a
signum Integer
d
denominator :: Ratio a -> a
denominator (Integer
n:%Integer
d) = let (Integer
_ :%Integer
d') = Integer -> Integer -> Ratio Any
forall a. Integer -> Integer -> Ratio a
reduce Integer
n Integer
d in Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
d'

notANumber :: Ratio a
notANumber = Integer
0Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:%Integer
0

reduce :: Integer -> Integer -> Ratio a
reduce Integer
_ Integer
0 = Ratio a
forall a. Ratio a
notANumber
reduce Integer
x Integer
y = (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
d) Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% (Integer
y Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
d)
  where d :: Integer
d = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd Integer
x Integer
y

choose :: Ratio a -> Ratio a
-- choose = id

choose :: Ratio a -> Ratio a
choose v :: Ratio a
v@(Integer
n:%Integer
d) = if (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Integer
forall a. Num a => a -> a
abs Integer
d) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0x3FFFFFFFFFFFFFFF then 
                    Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
reduce Integer
n Integer
d else Ratio a
v

instance Ord (Ratio a)  where
  Integer
x:%Integer
y <= :: Ratio a -> Ratio a -> Bool
<= Integer
x':%Integer
y' =  case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
0 (Integer -> Ordering) -> Integer -> Ordering
forall a b. (a -> b) -> a -> b
$ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' of 
                          Ordering
EQ -> Bool
False
                          Ordering
LT -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
                          Ordering
GT -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
  Integer
x:%Integer
y < :: Ratio a -> Ratio a -> Bool
<  Integer
x':%Integer
y' =  case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
0 (Integer -> Ordering) -> Integer -> Ordering
forall a b. (a -> b) -> a -> b
$ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' of 
                          Ordering
EQ -> Bool
False
                          Ordering
LT -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
                          Ordering
GT -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
  compare :: Ratio a -> Ratio a -> Ordering
compare (Integer
x:%Integer
y) (Integer
x':%Integer
y') = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
0 (Integer -> Ordering) -> Integer -> Ordering
forall a b. (a -> b) -> a -> b
$ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y' of 
                              Ordering
EQ -> Ordering
EQ -- This conflicts the definition of (==) and (<=).
                                       -- compare is used for the random-testing filters, while (==) is used by the predicate filter.
                                       -- (But actually, compare is also used for the sortBy....)
                              Ordering
LT -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y')  (Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)
                              Ordering
GT -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)  (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y')
  
instance Eq (Ratio a)  where
  Integer
x:%Integer
y == :: Ratio a -> Ratio a -> Bool
== Integer
x':%Integer
y' = (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y') Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
x'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y
  Integer
x:%Integer
y /= :: Ratio a -> Ratio a -> Bool
/= Integer
x':%Integer
y' = (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y') Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
x'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y

instance Integral a => Num (Ratio a)  where
  (Integer
x:%Integer
y) + :: Ratio a -> Ratio a -> Ratio a
+ (Integer
x':%Integer
y') = Ratio a -> Ratio a
forall a. Ratio a -> Ratio a
choose (Ratio a -> Ratio a) -> Ratio a -> Ratio a
forall a b. (a -> b) -> a -> b
$ (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
x'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y) Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y')
  (Integer
x:%Integer
y) - :: Ratio a -> Ratio a -> Ratio a
- (Integer
x':%Integer
y') = Ratio a -> Ratio a
forall a. Ratio a -> Ratio a
choose (Ratio a -> Ratio a) -> Ratio a -> Ratio a
forall a b. (a -> b) -> a -> b
$ (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y) Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y')
  (Integer
x:%Integer
y) * :: Ratio a -> Ratio a -> Ratio a
* (Integer
x':%Integer
y') = Ratio a -> Ratio a
forall a. Ratio a -> Ratio a
choose (Ratio a -> Ratio a) -> Ratio a -> Ratio a
forall a b. (a -> b) -> a -> b
$ (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x')      Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y')
  negate :: Ratio a -> Ratio a
negate     (Integer
x:%Integer
y) = (-Integer
x)Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:%Integer
y
  abs :: Ratio a -> Ratio a
abs        (Integer
x:%Integer
y) = Integer -> Integer
forall a. Num a => a -> a
abs Integer
x Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Integer -> Integer
forall a. Num a => a -> a
abs Integer
y
  signum :: Ratio a -> Ratio a
signum     (Integer
x:%Integer
0) = Ratio a
forall a. Ratio a
notANumber
  signum     (Integer
x:%Integer
y) = Integer -> Integer
forall a. Num a => a -> a
signum (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Integer
1
  fromInteger :: Integer -> Ratio a
fromInteger Integer
x     =  Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
x Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Integer
1

instance Integral a => Fractional (Ratio a)  where
  Integer
x:%Integer
y / :: Ratio a -> Ratio a -> Ratio a
/ Integer
x':%Integer
y' = if Integer
y' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Ratio a
forall a. Ratio a
notANumber else Ratio a -> Ratio a
forall a. Ratio a -> Ratio a
choose (Ratio a -> Ratio a) -> Ratio a -> Ratio a
forall a b. (a -> b) -> a -> b
$ (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y') Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
x')
  recip :: Ratio a -> Ratio a
recip (Integer
x:%Integer
y) | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = Ratio a
forall a. Ratio a
notANumber
               | Bool
otherwise = Integer
yInteger -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:%Integer
x
  fromRational :: Rational -> Ratio a
fromRational Rational
r = Rational -> Integer
forall a. Ratio a -> a
Data.Ratio.numerator Rational
r Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Rational -> Integer
forall a. Ratio a -> a
Data.Ratio.denominator Rational
r

instance Integral a => RealFrac (Ratio a)  where
  properFraction :: Ratio a -> (b, Ratio a)
properFraction (Integer
x:%Integer
y) = (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
q, Integer
r Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Integer
y)
    where (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
x Integer
y

instance (Show a, Integral a) => Show (Ratio a)  where
    showsPrec :: Int -> Ratio a -> ShowS
showsPrec Int
p Ratio a
r
      =  Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
         Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
8 (Ratio a -> a
forall a. Integral a => Ratio a -> a
numerator Ratio a
r) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> ShowS
showString String
" % " 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
8 (Ratio a -> a
forall a. Integral a => Ratio a -> a
denominator Ratio a
r)
instance Integral a => Real (Ratio a) where
    toRational :: Ratio a -> Rational
toRational (Integer
x:%Integer
y) = Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
Data.Ratio.% Integer
y

instance Integral a => Enum (Ratio a)  where
    succ :: Ratio a -> Ratio a
succ Ratio a
x              =  Ratio a
x Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
+ Ratio a
1
    pred :: Ratio a -> Ratio a
pred Ratio a
x              =  Ratio a
x Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
- Ratio a
1

    toEnum :: Int -> Ratio a
toEnum Int
n            =  Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Integer -> Integer -> Ratio a
forall a. Integer -> Integer -> Ratio a
:% Integer
1
    fromEnum :: Ratio a -> Int
fromEnum            =  Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Ratio a -> Integer) -> Ratio a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
{-
    enumFrom            =  numericEnumFrom
    enumFromThen        =  numericEnumFromThen
    enumFromTo          =  numericEnumFromTo
    enumFromThenTo      =  numericEnumFromThenTo
-}

{- properties held. 
prop_LE a b c d = c/=0 && d/=0 ==> let r1 = a%c <= b%d
                                       r2 = a Data.Ratio.% c <= b Data.Ratio.% d
                                   in r1 == r2
prop_LT a b c d = c/=0 && d/=0 ==> let r1 = a%c < b%d
                                       r2 = a Data.Ratio.% c < b Data.Ratio.% d
                                   in r1 == r2
prop_EQ a b c d = c/=0 && d/=0 ==> let r1 = a%c == b%d
                                       r2 = a Data.Ratio.% c == b Data.Ratio.% d
                                   in r1 == r2

prop_plus a b c d = c/=0 && d/=0 ==> let r1 = a%c + b%d
                                         r2 = a Data.Ratio.% c + b Data.Ratio.% d
                                     in toRational r1 == r2
prop_minus a b c d = c/=0 && d/=0 ==> let r1 = a%c - b%d
                                          r2 = a Data.Ratio.% c - b Data.Ratio.% d
                                      in r1 == fromRational r2
prop_times a b c d = c/=0 && d/=0 ==> let r1 = a%c * b%d
                                          r2 = (a Data.Ratio.% c) * (b Data.Ratio.% d)
                                     in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_negate a b = b/=0 ==> let r1 = negate $ a%b
                               r2 = negate $ a Data.Ratio.% b
                           in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_abs a b = b/=0 ==> let r1 = abs $ a%b
                            r2 = abs $ a Data.Ratio.% b
                        in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_signum a b = b/=0 ==> let r1 = signum $ a%b
                               r2 = signum $ a Data.Ratio.% b
                           in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_fromInteger a b = let r1 = fromInteger a
                           r2 = fromInteger a
                       in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2

prop_div a b c d = b/=0 && c/=0 && d/=0 ==> let r1 = a%c / b%d
                                                r2 = (a Data.Ratio.% c) / (b Data.Ratio.% d)
                                            in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_recip a b = a/=0 && b/=0 ==> let r1 = recip $ a%b
                                      r2 = recip $ a Data.Ratio.% b
                                  in numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_properFraction a b = b/=0 ==> let (i1,r1) = properFraction $ a%b
                                       (i2,r2) = properFraction $ a Data.Ratio.% b
                                   in i1 == i2 && numerator r1 == Data.Ratio.numerator r2 && denominator r1 == Data.Ratio.denominator r2
prop_showsPrec p a b = b/=0 ==> let  r1 = showsPrec p $ a%b
                                     r2 = showsPrec p $ a Data.Ratio.% b
                                 in r1 [] == r2 []
-}