Merge pull request #29 from anttih/ratio

Remove Rational newtype, move reducing to Ratio

Author: anttih

README.md

@@ -23,12 +23,30 @@ You can turn a `Rational` to a `Number`:
 0.3
 ```
 
+## Other Ratios
+
+`Rational` is just a type alias for `Ratio Int` and you might want to use
+`Ratio` with other than `Int`. The type you choose must however be an `EuclideanRing`.
+
+For example, one limitation with `Rational` is that it can easily overflow
+the 32-bit PureScript `Int`. You can get around this problem by using
+[`BigInt`](https://pursuit.purescript.org/packages/purescript-bigints/3.1.0/docs/Data.BigInt#t:BigInt).
+
+```
+> import Data.Ratio ((%), reduce)
+> import Data.BigInt (fromInt, fromString)
+> :type fromInt 1 % fromInt 3
+Ratio BigInt
+> reduce <$> fromString "10" <*> fromString "857981209301293808359384092830482"
+(Just fromString "5" % fromString "428990604650646904179692046415241")
+```
+
 ## Installation
 
 ```
 bower install purescript-rationals
 ```
 
-## Documentation
+## API documentation
 
 Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-rationals/).

src/Data/Ratio.purs

@@ -1,45 +1,63 @@
 module Data.Ratio
-  ( Ratio(Ratio)
+  ( Ratio
+  , reduce
+  , (%)
   , numerator
   , denominator
-  , gcd
   ) where
 
-import Prelude ( class CommutativeRing, class Eq, class EuclideanRing
-               , class Field, class Ring, class Semiring
-               , one, zero, (*), (+), (-)
-               , class Show, show, (<>)
-               )
-import Prelude ( gcd ) as Prelude
+import Prelude
+import Data.Ord (abs, signum)
 
 data Ratio a = Ratio a a
 
 instance showRatio :: Show a => Show (Ratio a) where
-  show (Ratio a b) = "(Ratio " <> show a <> " " <> show b <> ")"
-
-instance semiringRatio :: Semiring a => Semiring (Ratio a) where
+  show (Ratio a b) = show a <> " % " <> show b
+
+instance eqRatio :: Eq a => Eq (Ratio a) where
+  eq (Ratio a b) (Ratio c d) = a == c && b == d
+
+instance ordRatio :: (Ord a, EuclideanRing a) => Ord (Ratio a) where
+  compare x y =
+    case x - y of
+      Ratio n d ->
+        if n == zero
+          then EQ
+          else case n > zero, d > zero of
+            true, true -> GT
+            false, false -> GT
+            _, _ -> LT
+
+instance semiringRatio :: (Ord a, EuclideanRing a) => Semiring (Ratio a) where
   one = Ratio one one
-  mul (Ratio a b) (Ratio c d) = Ratio (a * c) (b * d)
+  mul (Ratio a b) (Ratio c d) = reduce (a * c) (b * d)
   zero = Ratio zero one
-  add (Ratio a b) (Ratio c d) = Ratio ((a * d) + (b * c)) (b * d)
+  add (Ratio a b) (Ratio c d) = reduce ((a * d) + (b * c)) (b * d)
 
-instance ringRatio :: Ring a => Ring (Ratio a) where
-  sub (Ratio a b) (Ratio c d) = Ratio ((a * d) - (b * c)) (b * d)
+instance ringRatio :: (Ord a, EuclideanRing a) => Ring (Ratio a) where
+  sub (Ratio a b) (Ratio c d) = reduce ((a * d) - (b * c)) (b * d)
 
-instance commutativeRingRatio :: CommutativeRing a => CommutativeRing (Ratio a)
+instance commutativeRingRatio :: (Ord a, EuclideanRing a) => CommutativeRing (Ratio a)
 
-instance euclideanRingRatio :: (CommutativeRing a, Semiring a) => EuclideanRing (Ratio a) where
+instance euclideanRingRatio :: (Ord a, EuclideanRing a) => EuclideanRing (Ratio a) where
   degree _ = 1
-  div (Ratio a b) (Ratio c d) = Ratio (a * d) (b * c)
+  div (Ratio a b) (Ratio c d) = reduce (a * d) (b * c)
   mod _ _ = zero
 
-instance fieldRatio :: Field a => Field (Ratio a)
+instance fieldRatio :: (Ord a, EuclideanRing a) => Field (Ratio a)
+
+reduce :: forall a. Ord a => EuclideanRing a => a -> a -> Ratio a
+reduce n d =
+  let
+    g = gcd n d
+    d' = d / g
+  in
+    Ratio ((n / g) * signum d') (abs d')
+
+infixl 7 reduce as %
 
 numerator :: forall a. Ratio a -> a
 numerator (Ratio a _) = a
 
 denominator :: forall a. Ratio a -> a
 denominator (Ratio _ b) = b
-
-gcd :: forall a. Eq a => EuclideanRing a => Ratio a -> a
-gcd (Ratio m n) = Prelude.gcd m n

src/Data/Rational.purs

@@ -1,64 +1,18 @@
 module Data.Rational
   ( Rational
-  , runRational
-  , rational
-  , (%)
   , toNumber
   , fromInt
+  , module Data.Ratio
   ) where
 
 import Prelude
 import Data.Int as Int
-import Data.Ord (signum)
-import Data.Ratio (Ratio(Ratio))
+import Data.Ratio (Ratio, (%), numerator, denominator)
 
-newtype Rational = Rational (Ratio Int)
-
-runRational :: Rational -> Ratio Int
-runRational (Rational ratio) = ratio
-
-instance showRational :: Show Rational where
-  show (Rational (Ratio a b)) = show a <> " % " <> show b
-
-instance eqRational :: Eq Rational where
-  eq x y = eq' (reduce x) (reduce y)
-    where
-    eq' (Rational (Ratio a' b')) (Rational (Ratio c' d')) = a' == c' && b' == d'
-
-instance ordRational :: Ord Rational where
-  compare (Rational x) (Rational y) = case x / y of Ratio a b -> compare a b
-
-instance semiringRational :: Semiring Rational where
-  one = Rational one
-  mul (Rational a) (Rational b) = reduce $ Rational $ a `mul` b
-  zero = Rational zero
-  add (Rational a) (Rational b) = reduce $ Rational $ a `add` b
-
-instance ringRational :: Ring Rational where
-  sub (Rational a) (Rational b) = reduce $ Rational $ a `sub` b
-
-instance commutativeRingRational :: CommutativeRing Rational
-
-instance euclideanRingRational :: EuclideanRing Rational where
-  degree (Rational a) = degree a
-  div (Rational a) (Rational b) = Rational $ a `div` b
-  mod _ _ = Rational zero
-
-instance fieldRational :: Field Rational
-
-infixl 7 rational as %
-
-rational :: Int -> Int -> Rational
-rational x y = reduce $ Rational $ Ratio x y
+type Rational = Ratio Int
 
 toNumber :: Rational -> Number
-toNumber (Rational (Ratio a b)) = Int.toNumber a / Int.toNumber b
+toNumber x = Int.toNumber (numerator x) / Int.toNumber (denominator x)
 
 fromInt :: Int -> Rational
-fromInt i = Rational $ Ratio i 1
-
-reduce :: Rational -> Rational
-reduce (Rational (Ratio a b)) =
-  let g = gcd a b
-      b' = b / g
-  in Rational $ Ratio ((a / g) * signum b') (degree b')
+fromInt i = i % 1

test/Main.purs

@@ -7,7 +7,8 @@ import Control.Monad.Eff.Console (CONSOLE, log)
 import Control.Monad.Eff.Random (RANDOM)
 import Control.Monad.Eff.Exception (EXCEPTION)
 
-import Data.Rational (Rational, (%))
+import Data.Ratio ((%))
+import Data.Rational (Rational)
 
 import Test.StrongCheck (Result, quickCheck', (===))
 import Test.StrongCheck.Arbitrary (class Arbitrary)
@@ -21,6 +22,7 @@ newtype TestRational = TestRational Rational
 
 derive newtype instance commutativeRingTestRational :: CommutativeRing TestRational
 derive newtype instance eqTestRational :: Eq TestRational
+derive newtype instance euclideanRingTestRational :: EuclideanRing TestRational
 derive newtype instance fieldTestRational :: Field TestRational
 derive newtype instance ordTestRational :: Ord TestRational
 derive newtype instance ringTestRational :: Ring TestRational
@@ -32,6 +34,16 @@ int = chooseInt (-999) 999
 nonZeroInt :: Gen Int
 nonZeroInt = int `suchThat` notEq 0
 
+newtype SmallInt = SmallInt Int
+  
+instance arbitrarySmallInt :: Arbitrary SmallInt where
+  arbitrary = SmallInt <$> int
+
+newtype NonZeroInt = NonZeroInt Int
+
+instance arbitraryNonZeroInt :: Arbitrary NonZeroInt where
+  arbitrary = NonZeroInt <$> nonZeroInt
+
 instance arbitraryTestRational :: Arbitrary TestRational where
   arbitrary = compose TestRational <<< (%) <$> int <*> nonZeroInt
 
@@ -41,6 +53,9 @@ testRational = Proxy
 newtype TestRatNonZero = TestRatNonZero Rational
 
 derive newtype instance eqTestRatNonZero :: Eq TestRatNonZero
+derive newtype instance semiringTestRatNonZero :: Semiring TestRatNonZero
+derive newtype instance ringTestRatNonZero :: Ring TestRatNonZero
+derive newtype instance commutativeRingTestRatNonZero :: CommutativeRing TestRatNonZero
 derive newtype instance euclideanRingTestRatNonZero :: EuclideanRing TestRatNonZero
 
 instance arbitraryTestRatNonZero :: Arbitrary TestRatNonZero where
@@ -62,7 +77,14 @@ main = checkLaws "Rational" do
   log "Checking 'Remainder' law for MuduloSemiring"
   quickCheck' 1000 remainder
 
+  log "Checking `reduce`"
+  quickCheck' 1000 reducing
+
     where
 
     remainder :: TestRatNonZero -> TestRatNonZero -> Result
     remainder (TestRatNonZero a) (TestRatNonZero b) = a / b * b + (a `mod` b) === a
+
+    reducing :: NonZeroInt -> NonZeroInt -> SmallInt -> NonZeroInt -> Result
+    reducing (NonZeroInt a) (NonZeroInt b) (SmallInt n) (NonZeroInt d)
+      = (a * n) % (a * d) === (b * n) % (b * d)