Use strict natural numbers

src/Data/Number.hs

@@ -1,8 +1,8 @@
 -- | A library for real number arithmetics
 module Data.Number
 ( -- * Classes
-  Continued(..), Number
-, Nat(..), Whole(..)
+  Continued(..)
+, Number, Natural 
   -- * Functions
 , fromList, toList
 , fromNumber, toNumber
@@ -12,8 +12,8 @@ module Data.Number
 , hom, biHom, cut
 ) where
 
+import Data.Natural
 import Data.Number.Types
 import Data.Number.Instances
 import Data.Number.Functions
 import Data.Number.Internal
-import Data.Number.Peano

src/Data/Number/Functions.hs

@@ -4,15 +4,15 @@ module Data.Number.Functions where
 import Data.Number.Types
 import Data.Number.Instances
 import Data.Number.Internal
-import Data.Number.Peano
+import Data.Natural
 import Data.Ratio
 
 -- Various --
 
 -- | Get the precision of a 'Number' (i.e. length)
-precision :: Number -> Nat
-precision E       = Z
-precision (_:|xs) = S (precision xs)
+precision :: Number -> Natural
+precision E       = 0
+precision (_:|xs) = succ (precision xs)
 
 -- | Alternative show function that pretty prints a 'Number'
 -- also doing conversions from Peano numbers
@@ -26,12 +26,12 @@ show' (M (x:|xs)) = '-' : show (toInteger x) ++ " - 1/(" ++ show' xs ++ ")"
 -- Conversion --
 
 -- | Create a 'Number' from a list of naturals
-fromList :: [Nat] -> Number
+fromList :: [Natural] -> Number
 fromList []     = E
 fromList (x:xs) = x :| fromList xs
 
 -- | Convert a 'Number' to a list of naturals (losing the sign)
-toList :: Number -> [Nat]
+toList :: Number -> [Natural]
 toList E = []
 toList (x:|xs) = x : toList xs
 
@@ -64,4 +64,4 @@ e :: Number
 e = fmap a σ where 
   a n | p == 0    = 2*q
       | otherwise = 1
-    where (q, p) = quotRem n 3
+    where (q, p) = quotRem n 3

src/Data/Number/Instances.hs

@@ -6,7 +6,7 @@ module Data.Number.Instances where
 import Data.Number.Types
 import Data.Number.Internal
 
--- | transform a number applying a function ('Nat' -> 'Nat') to each
+-- | transform a number applying a function ('Natural' -> 'Natural') to each
 -- number preserving the sign.
 instance Functor Continued where
   fmap _ E       = E

src/Data/Number/Internal.hs

@@ -11,15 +11,15 @@ module Data.Number.Internal
 ) where
 
 import Data.Number.Types
-import Data.Number.Peano
+import Data.Natural
 import Data.Ratio
 
 -- | Homographic function coefficients matrix
-type Hom   = (Whole, Whole, Whole, Whole)
+type Hom   = (Integer, Integer, Integer, Integer)
 
 -- | Bihomographic function coefficients matrix
-type BiHom = (Whole, Whole, Whole, Whole,
-              Whole, Whole, Whole, Whole)
+type BiHom = (Integer, Integer, Integer, Integer,
+              Integer, Integer, Integer, Integer)
 
 -- | Homographic function
 --
@@ -35,7 +35,7 @@ type BiHom = (Whole, Whole, Whole, Whole,
 -- explanation.
 hom :: Hom -> Number -> Number
 hom (0, 0, _, _) _ = E
-hom (a, _, c, _) E = toNumber (fromPeano a % fromPeano c)
+hom (a, _, c, _) E = toNumber (a % c)
 hom h x = case maybeEmit h of
   Just d  -> join d (hom (emit h d) x)
   Nothing -> hom (absorb h x0) x'
@@ -44,7 +44,7 @@ hom h x = case maybeEmit h of
 
 -- Homographic helpers --
 
-maybeEmit :: Hom -> Maybe Whole
+maybeEmit :: Hom -> Maybe Integer
 maybeEmit (a, b, c, d) =
   if c /= 0 && d /= 0 && r == s
     then Just r
@@ -53,11 +53,11 @@ maybeEmit (a, b, c, d) =
         s = b // d
 
 
-emit :: Hom -> Whole -> Hom
+emit :: Hom -> Integer -> Hom
 emit (a, b, c, d) x = (c, d, a - c*x, b - d*x)
 
 
-absorb :: Hom -> Whole -> Hom
+absorb :: Hom -> Integer -> Hom
 absorb (a, b, c, d) x = (a*x + b, a, c*x + d, c)
 
 
@@ -86,7 +86,7 @@ biHom h x y = case maybeBiEmit h of
 
 -- Bihomographic helpers
 
-maybeBiEmit :: BiHom -> Maybe Whole
+maybeBiEmit :: BiHom -> Maybe Integer
 maybeBiEmit (a, b, c, d,
              e, f, g, h) =
   if e /= 0 && f /= 0 && g /= 0 && h /= 0 && ratiosAgree
@@ -95,17 +95,17 @@ maybeBiEmit (a, b, c, d,
   where r = quot a e
         ratiosAgree = r == b // f && r == c // g && r == d // h
 
-biEmit :: BiHom -> Whole -> BiHom
+biEmit :: BiHom -> Integer -> BiHom
 biEmit (a, b, c, d,
         e, f, g, h) x = (e,       f,       g,       h,
                          a - e*x, b - f*x, c - g*x, d - h*x)
 
-biAbsorbX :: BiHom -> Whole -> BiHom
+biAbsorbX :: BiHom -> Integer -> BiHom
 biAbsorbX (a, b, c, d,
            e, f, g, h) x = (a*x + b, a, c*x + d, c,
                             e*x + f, e, g*x + h, g)
 
-biAbsorbY :: BiHom -> Whole -> BiHom
+biAbsorbY :: BiHom -> Integer -> BiHom
 biAbsorbY (a, b, c, d,
            e, f, g, h) y = (a*y + c, b*y + d, a, b,
                             e*y + g, f*y + h, e, f)
@@ -121,38 +121,38 @@ fromX (_, b, c, d, _, f, g, h) = abs (g*h*b - g*d*f) < abs (f*h*c - g*d*f)
 toNumber :: RealFrac a => a -> Number
 toNumber 0 = E
 toNumber x
-  | x < 0     = M (toNumber (-x))
+  | x < 0     = M (toNumber (negate x))
   | x' == 0   = x0 :| E
   | otherwise = x0 :| toNumber (recip x')
   where (x0, x') = properFraction x
 
 -- | Truncate a 'Number' to a given length @n@
-cut :: Nat -> Number -> Number
+cut :: Natural -> Number -> Number
 cut _ E          = E
 cut n (M x)      = M (cut n x)
 cut n _ | n <= 0 = E
 cut n (x :| xs)  = x :| cut (n-1) xs
 
 
--- | Split a Number into a 'Whole' (the most significant of the fraction)
+-- | Split a Number into a 'Integer' (the most significant of the fraction)
 -- and the rest of the Number. Equivalent to @(floor x, x - floor x)@
 -- for a floating point.
-split :: Number -> (Whole, Number)
+split :: Number -> (Integer, Number)
 split x = (first x, rest x)
 
 
 -- | Essentially the inverse of split
-join :: Whole -> Number -> Number
-join (Whole x0 Neg) = M . (x0 :|)
-join (Whole x0 Pos) =     (x0 :|)
+join :: Integer -> Number -> Number
+join x0 x | x0 < 0    = M (negate (fromInteger x0) :| x)
+          | otherwise =   (fromInteger x0 :| x)
 
 
--- | Extract the first natural of the fraction as a 'Whole' number
-first :: Number -> Whole
+-- | Extract the first natural of the fraction as a 'Integer' number
+first :: Number -> Integer
 first E          = 0
 first (M E)      = 0
-first (M (x:|_)) = Whole x Neg
-first (x:|_)     = Whole x Pos
+first (M (x:|_)) = negate (toInteger x)
+first (x:|_)     = toInteger x
 
 
 -- | Extract the "tail" of a 'Number' as a new 'Number'

src/Data/Number/Types.hs

@@ -1,9 +1,9 @@
 -- | Definition of the continued fraction type
 module Data.Number.Types where
 
-import Data.Number.Peano
+import Data.Natural
 
-infixr 5 :| 
+infixr 5 :|
 -- | ==Continued fraction type
 -- Represents a simple continued fraction of the form:
 --
@@ -27,4 +27,4 @@ data Continued a =
   deriving (Eq, Ord, Show, Read)
 
 -- | Real numbers datatype (a continued fraction of naturals)
-type Number = Continued Nat
+type Number = Continued Natural