diff --git a/src/Data/Number.hs b/src/Data/Number.hs index fcd1ec0..e263d59 100644 --- a/src/Data/Number.hs +++ b/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 \ No newline at end of file diff --git a/src/Data/Number/Functions.hs b/src/Data/Number/Functions.hs index 941f134..d6961ef 100644 --- a/src/Data/Number/Functions.hs +++ b/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 \ No newline at end of file + where (q, p) = quotRem n 3 diff --git a/src/Data/Number/Instances.hs b/src/Data/Number/Instances.hs index 39e036f..35abe2c 100644 --- a/src/Data/Number/Instances.hs +++ b/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 diff --git a/src/Data/Number/Internal.hs b/src/Data/Number/Internal.hs index 665c633..6dbb848 100644 --- a/src/Data/Number/Internal.hs +++ b/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' diff --git a/src/Data/Number/Types.hs b/src/Data/Number/Types.hs index 846d95b..92395b5 100644 --- a/src/Data/Number/Types.hs +++ b/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