Use strict natural numbers
This commit is contained in:
parent
5b677c44be
commit
e436701d7b
@ -1,8 +1,8 @@
|
|||||||
-- | A library for real number arithmetics
|
-- | A library for real number arithmetics
|
||||||
module Data.Number
|
module Data.Number
|
||||||
( -- * Classes
|
( -- * Classes
|
||||||
Continued(..), Number
|
Continued(..)
|
||||||
, Nat(..), Whole(..)
|
, Number, Natural
|
||||||
-- * Functions
|
-- * Functions
|
||||||
, fromList, toList
|
, fromList, toList
|
||||||
, fromNumber, toNumber
|
, fromNumber, toNumber
|
||||||
@ -12,8 +12,8 @@ module Data.Number
|
|||||||
, hom, biHom, cut
|
, hom, biHom, cut
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.Natural
|
||||||
import Data.Number.Types
|
import Data.Number.Types
|
||||||
import Data.Number.Instances
|
import Data.Number.Instances
|
||||||
import Data.Number.Functions
|
import Data.Number.Functions
|
||||||
import Data.Number.Internal
|
import Data.Number.Internal
|
||||||
import Data.Number.Peano
|
|
@ -4,15 +4,15 @@ module Data.Number.Functions where
|
|||||||
import Data.Number.Types
|
import Data.Number.Types
|
||||||
import Data.Number.Instances
|
import Data.Number.Instances
|
||||||
import Data.Number.Internal
|
import Data.Number.Internal
|
||||||
import Data.Number.Peano
|
import Data.Natural
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
|
|
||||||
-- Various --
|
-- Various --
|
||||||
|
|
||||||
-- | Get the precision of a 'Number' (i.e. length)
|
-- | Get the precision of a 'Number' (i.e. length)
|
||||||
precision :: Number -> Nat
|
precision :: Number -> Natural
|
||||||
precision E = Z
|
precision E = 0
|
||||||
precision (_:|xs) = S (precision xs)
|
precision (_:|xs) = succ (precision xs)
|
||||||
|
|
||||||
-- | Alternative show function that pretty prints a 'Number'
|
-- | Alternative show function that pretty prints a 'Number'
|
||||||
-- also doing conversions from Peano numbers
|
-- also doing conversions from Peano numbers
|
||||||
@ -26,12 +26,12 @@ show' (M (x:|xs)) = '-' : show (toInteger x) ++ " - 1/(" ++ show' xs ++ ")"
|
|||||||
-- Conversion --
|
-- Conversion --
|
||||||
|
|
||||||
-- | Create a 'Number' from a list of naturals
|
-- | Create a 'Number' from a list of naturals
|
||||||
fromList :: [Nat] -> Number
|
fromList :: [Natural] -> Number
|
||||||
fromList [] = E
|
fromList [] = E
|
||||||
fromList (x:xs) = x :| fromList xs
|
fromList (x:xs) = x :| fromList xs
|
||||||
|
|
||||||
-- | Convert a 'Number' to a list of naturals (losing the sign)
|
-- | Convert a 'Number' to a list of naturals (losing the sign)
|
||||||
toList :: Number -> [Nat]
|
toList :: Number -> [Natural]
|
||||||
toList E = []
|
toList E = []
|
||||||
toList (x:|xs) = x : toList xs
|
toList (x:|xs) = x : toList xs
|
||||||
|
|
||||||
|
@ -6,7 +6,7 @@ module Data.Number.Instances where
|
|||||||
import Data.Number.Types
|
import Data.Number.Types
|
||||||
import Data.Number.Internal
|
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.
|
-- number preserving the sign.
|
||||||
instance Functor Continued where
|
instance Functor Continued where
|
||||||
fmap _ E = E
|
fmap _ E = E
|
||||||
|
@ -11,15 +11,15 @@ module Data.Number.Internal
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Number.Types
|
import Data.Number.Types
|
||||||
import Data.Number.Peano
|
import Data.Natural
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
|
|
||||||
-- | Homographic function coefficients matrix
|
-- | Homographic function coefficients matrix
|
||||||
type Hom = (Whole, Whole, Whole, Whole)
|
type Hom = (Integer, Integer, Integer, Integer)
|
||||||
|
|
||||||
-- | Bihomographic function coefficients matrix
|
-- | Bihomographic function coefficients matrix
|
||||||
type BiHom = (Whole, Whole, Whole, Whole,
|
type BiHom = (Integer, Integer, Integer, Integer,
|
||||||
Whole, Whole, Whole, Whole)
|
Integer, Integer, Integer, Integer)
|
||||||
|
|
||||||
-- | Homographic function
|
-- | Homographic function
|
||||||
--
|
--
|
||||||
@ -35,7 +35,7 @@ type BiHom = (Whole, Whole, Whole, Whole,
|
|||||||
-- explanation.
|
-- explanation.
|
||||||
hom :: Hom -> Number -> Number
|
hom :: Hom -> Number -> Number
|
||||||
hom (0, 0, _, _) _ = E
|
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
|
hom h x = case maybeEmit h of
|
||||||
Just d -> join d (hom (emit h d) x)
|
Just d -> join d (hom (emit h d) x)
|
||||||
Nothing -> hom (absorb h x0) x'
|
Nothing -> hom (absorb h x0) x'
|
||||||
@ -44,7 +44,7 @@ hom h x = case maybeEmit h of
|
|||||||
|
|
||||||
-- Homographic helpers --
|
-- Homographic helpers --
|
||||||
|
|
||||||
maybeEmit :: Hom -> Maybe Whole
|
maybeEmit :: Hom -> Maybe Integer
|
||||||
maybeEmit (a, b, c, d) =
|
maybeEmit (a, b, c, d) =
|
||||||
if c /= 0 && d /= 0 && r == s
|
if c /= 0 && d /= 0 && r == s
|
||||||
then Just r
|
then Just r
|
||||||
@ -53,11 +53,11 @@ maybeEmit (a, b, c, d) =
|
|||||||
s = b // 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)
|
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)
|
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
|
-- Bihomographic helpers
|
||||||
|
|
||||||
maybeBiEmit :: BiHom -> Maybe Whole
|
maybeBiEmit :: BiHom -> Maybe Integer
|
||||||
maybeBiEmit (a, b, c, d,
|
maybeBiEmit (a, b, c, d,
|
||||||
e, f, g, h) =
|
e, f, g, h) =
|
||||||
if e /= 0 && f /= 0 && g /= 0 && h /= 0 && ratiosAgree
|
if e /= 0 && f /= 0 && g /= 0 && h /= 0 && ratiosAgree
|
||||||
@ -95,17 +95,17 @@ maybeBiEmit (a, b, c, d,
|
|||||||
where r = quot a e
|
where r = quot a e
|
||||||
ratiosAgree = r == b // f && r == c // g && r == d // h
|
ratiosAgree = r == b // f && r == c // g && r == d // h
|
||||||
|
|
||||||
biEmit :: BiHom -> Whole -> BiHom
|
biEmit :: BiHom -> Integer -> BiHom
|
||||||
biEmit (a, b, c, d,
|
biEmit (a, b, c, d,
|
||||||
e, f, g, h) x = (e, f, g, h,
|
e, f, g, h) x = (e, f, g, h,
|
||||||
a - e*x, b - f*x, c - g*x, d - h*x)
|
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,
|
biAbsorbX (a, b, c, d,
|
||||||
e, f, g, h) x = (a*x + b, a, c*x + d, c,
|
e, f, g, h) x = (a*x + b, a, c*x + d, c,
|
||||||
e*x + f, e, g*x + h, g)
|
e*x + f, e, g*x + h, g)
|
||||||
|
|
||||||
biAbsorbY :: BiHom -> Whole -> BiHom
|
biAbsorbY :: BiHom -> Integer -> BiHom
|
||||||
biAbsorbY (a, b, c, d,
|
biAbsorbY (a, b, c, d,
|
||||||
e, f, g, h) y = (a*y + c, b*y + d, a, b,
|
e, f, g, h) y = (a*y + c, b*y + d, a, b,
|
||||||
e*y + g, f*y + h, e, f)
|
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 :: RealFrac a => a -> Number
|
||||||
toNumber 0 = E
|
toNumber 0 = E
|
||||||
toNumber x
|
toNumber x
|
||||||
| x < 0 = M (toNumber (-x))
|
| x < 0 = M (toNumber (negate x))
|
||||||
| x' == 0 = x0 :| E
|
| x' == 0 = x0 :| E
|
||||||
| otherwise = x0 :| toNumber (recip x')
|
| otherwise = x0 :| toNumber (recip x')
|
||||||
where (x0, x') = properFraction x
|
where (x0, x') = properFraction x
|
||||||
|
|
||||||
-- | Truncate a 'Number' to a given length @n@
|
-- | Truncate a 'Number' to a given length @n@
|
||||||
cut :: Nat -> Number -> Number
|
cut :: Natural -> Number -> Number
|
||||||
cut _ E = E
|
cut _ E = E
|
||||||
cut n (M x) = M (cut n x)
|
cut n (M x) = M (cut n x)
|
||||||
cut n _ | n <= 0 = E
|
cut n _ | n <= 0 = E
|
||||||
cut n (x :| xs) = x :| cut (n-1) xs
|
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)@
|
-- and the rest of the Number. Equivalent to @(floor x, x - floor x)@
|
||||||
-- for a floating point.
|
-- for a floating point.
|
||||||
split :: Number -> (Whole, Number)
|
split :: Number -> (Integer, Number)
|
||||||
split x = (first x, rest x)
|
split x = (first x, rest x)
|
||||||
|
|
||||||
|
|
||||||
-- | Essentially the inverse of split
|
-- | Essentially the inverse of split
|
||||||
join :: Whole -> Number -> Number
|
join :: Integer -> Number -> Number
|
||||||
join (Whole x0 Neg) = M . (x0 :|)
|
join x0 x | x0 < 0 = M (negate (fromInteger x0) :| x)
|
||||||
join (Whole x0 Pos) = (x0 :|)
|
| otherwise = (fromInteger x0 :| x)
|
||||||
|
|
||||||
|
|
||||||
-- | Extract the first natural of the fraction as a 'Whole' number
|
-- | Extract the first natural of the fraction as a 'Integer' number
|
||||||
first :: Number -> Whole
|
first :: Number -> Integer
|
||||||
first E = 0
|
first E = 0
|
||||||
first (M E) = 0
|
first (M E) = 0
|
||||||
first (M (x:|_)) = Whole x Neg
|
first (M (x:|_)) = negate (toInteger x)
|
||||||
first (x:|_) = Whole x Pos
|
first (x:|_) = toInteger x
|
||||||
|
|
||||||
|
|
||||||
-- | Extract the "tail" of a 'Number' as a new 'Number'
|
-- | Extract the "tail" of a 'Number' as a new 'Number'
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
-- | Definition of the continued fraction type
|
-- | Definition of the continued fraction type
|
||||||
module Data.Number.Types where
|
module Data.Number.Types where
|
||||||
|
|
||||||
import Data.Number.Peano
|
import Data.Natural
|
||||||
|
|
||||||
infixr 5 :|
|
infixr 5 :|
|
||||||
-- | ==Continued fraction type
|
-- | ==Continued fraction type
|
||||||
@ -27,4 +27,4 @@ data Continued a =
|
|||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
-- | Real numbers datatype (a continued fraction of naturals)
|
-- | Real numbers datatype (a continued fraction of naturals)
|
||||||
type Number = Continued Nat
|
type Number = Continued Natural
|
||||||
|
Loading…
Reference in New Issue
Block a user