From 414ec2104159fe5c6c8fdb63384f589a1b813ea1 Mon Sep 17 00:00:00 2001 From: rnhmjoj Date: Mon, 1 Jun 2015 22:55:25 +0200 Subject: [PATCH] Add preliminary Haddock docs --- number.cabal | 2 +- src/Data/Number.hs | 15 +++++++++++---- src/Data/Number/Functions.hs | 24 +++++++++++++++++++++--- src/Data/Number/Instances.hs | 11 +++++++++++ src/Data/Number/Internal.hs | 18 +++++++++++++++++- src/Data/Number/Types.hs | 17 ++++++++++++++--- 6 files changed, 75 insertions(+), 12 deletions(-) diff --git a/number.cabal b/number.cabal index a4dcb08..61d9540 100644 --- a/number.cabal +++ b/number.cabal @@ -1,6 +1,6 @@ name: number version: 0.1.0.0 -synopsis: A datatype for real numbers +synopsis: A library for real numbers description: Data.Number is an attempt to give an almost complete diff --git a/src/Data/Number.hs b/src/Data/Number.hs index d6feee9..8460c15 100644 --- a/src/Data/Number.hs +++ b/src/Data/Number.hs @@ -1,8 +1,15 @@ +-- | A library for real number arithmetics module Data.Number -( module Data.Number.Types -, module Data.Number.Functions -, module Data.Number.Instances -, Nat(..) +( -- * Classes + Continued(..), Number +, Nat(..), Whole(..) + -- * Functions +, fromList, toList +, fromNumber, toNumber + -- * Constants +, σ, φ, π, e + -- * Internals +, operator, cut ) where import Data.Number.Types diff --git a/src/Data/Number/Functions.hs b/src/Data/Number/Functions.hs index 1894628..ca2ea1f 100644 --- a/src/Data/Number/Functions.hs +++ b/src/Data/Number/Functions.hs @@ -1,3 +1,4 @@ +-- | Common functions and constants module Data.Number.Functions where import Data.Number.Types @@ -8,10 +9,13 @@ import Data.Number.Peano -- Various -- +-- | Get the precision of a 'Number' (i.e. length) precision :: Number -> Nat precision E = Z precision (_:|xs) = S (precision xs) +-- | Alternative show function that pretty prints a 'Number' +-- also doing conversions from Peano numbers show' :: Number -> String show' E = "0" show' (x:|E) = show (toInteger x) @@ -21,10 +25,12 @@ show' (M (x:|xs)) = '-' : show (toInteger x) ++ " - 1/(" ++ show' xs ++ ")" -- Conversion -- +-- | Create a 'Number' from a list of naturals fromList :: [Nat] -> Number fromList [] = E fromList (x:xs) = x :| fromList xs +-- | Convert a 'Number' to a list of naturals (losing the sign) toList :: Number -> [Nat] toList E = [] toList (x:|xs) = x : toList xs @@ -32,16 +38,28 @@ toList (x:|xs) = x : toList xs -- constants -- -φ :: Number -φ = 1 :| φ - +-- | The infinite continued fraction whose terms are naturals numbers +-- +-- \[0, 1, 2, 3, 4,...\] = 0.6977746... σ :: Number σ = σ' 0 where σ' n = n :| σ' (succ n) +-- | The golden ratio +-- +-- φ = (1 + √5)/2 = 1.6180339... +φ :: Number +φ = 1 :| φ + +-- | Pi: the ratio of a circle's circumference to its diameter +-- +-- π = 3.1415926... π :: Number π = toNumber pi +-- | Euler's number: the base of the natural logarithm +-- +-- e = 2.7182818... e :: Number e = fmap a σ where a n | p == 0 = 2*q diff --git a/src/Data/Number/Instances.hs b/src/Data/Number/Instances.hs index 9bca10d..1ff0f53 100644 --- a/src/Data/Number/Instances.hs +++ b/src/Data/Number/Instances.hs @@ -1,3 +1,4 @@ +-- | Class instances for the continued fraction datatype {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Data.Number.Instances where @@ -5,21 +6,27 @@ module Data.Number.Instances where import Data.Number.Types import Data.Number.Internal +-- | transform a number applying a function ('Nat' -> 'Nat') to each +-- number preserving the sign. instance Functor Continued where fmap _ E = E fmap f (M x) = M (fmap f x) fmap f (x:|xs) = f x :| fmap f xs +-- | Basic Foldable instance implemented exactly as a list. instance Foldable Continued where foldr f z E = z foldr f z (M x) = foldr f z x foldr f z (x:|xs) = f x (foldr f z xs) +-- | Same as above. instance Traversable Continued where traverse _ E = pure E traverse f (M x) = traverse f x traverse f (x:|xs) = (:|) <$> f x <*> traverse f xs +-- | The sign is given by the first number of the fraction. +-- Other number are always considered positive. instance Num Number where (+) = operator (0, 1, 1, 0, 1, 0, 0, 0) (-) = operator (0, 1, -1, 0, 1, 0, 0, 0) @@ -37,9 +44,11 @@ instance Num Number where signum (M _) = -1 signum _ = 1 +-- | Allows conversion to a rational instance Real Number where toRational = fromNumber +-- | Allows division between 'Number's and conversion from a rational instance Fractional Number where (/) = operator (0, 1, 0, 0, 0, 0, 1, 0) fromRational = toNumber @@ -47,12 +56,14 @@ instance Fractional Number where -- Helpers -- +-- | Convert a 'Number' into a 'RealFrac' number fromNumber :: RealFrac a => Number -> a fromNumber E = 0 fromNumber (M x) = negate (fromNumber x) fromNumber (x :| E) = fromIntegral x fromNumber (x :| xs) = fromIntegral x + 1 / (fromNumber xs) +-- | Convert a 'RealFrac' number into a 'Number' toNumber :: (Show a, RealFrac a) => a -> Number toNumber 0 = E toNumber x0 diff --git a/src/Data/Number/Internal.hs b/src/Data/Number/Internal.hs index 3516baf..a29b759 100644 --- a/src/Data/Number/Internal.hs +++ b/src/Data/Number/Internal.hs @@ -1,3 +1,4 @@ +-- | Data.Number internals module Data.Number.Internal ( operator , cut @@ -11,9 +12,17 @@ import Data.Number.Peano import Data.Ratio +-- | Operator Matrix type Matrix = (Whole, Whole, Whole, Whole, Whole, Whole, Whole, Whole) - +-- | Continued fraction operator (implements Gosper's arithmetics) +-- +-- Given two 'Number' @x@, @y@ and the operator matrix +-- @\@ +-- calculates @z = (a + bx + cy + dxy) / (e + fx + gy + hxy)@ +-- +-- See for a complete +-- explanation. operator :: Matrix -> Number -> Number -> Number operator c x y = case operator' c x y False of @@ -43,6 +52,7 @@ operator' (a,b,c,d,e,f,g,h) x y end | otherwise = abs (b%f - a%e) > abs (c%g - a%e) +-- | Truncate a 'Number' to a given length @n@ cut :: Nat -> Number -> Number cut _ E = E cut n (M x) = M (cut n x) @@ -50,10 +60,14 @@ 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) +-- and the rest of the Number. Equivalent to @(floor x, x - floor x)@ +-- for a floating point. split :: Number -> (Whole, Number) split x = (first x, rest x) +-- | Extract the first natural of the fraction as a 'Whole' number first :: Number -> Whole first E = 0 first (M E) = 0 @@ -61,6 +75,8 @@ first (M (x:|_)) = Whole x Neg first (x:|_) = Whole x Pos +-- | Extract the "tail" of a 'Number' as a new 'Number' +-- Equivalent to @(x - floor x)@ for a floating point. rest :: Number -> Number rest E = E rest (M E) = E diff --git a/src/Data/Number/Types.hs b/src/Data/Number/Types.hs index 141f273..cf50ceb 100644 --- a/src/Data/Number/Types.hs +++ b/src/Data/Number/Types.hs @@ -1,9 +1,20 @@ +-- | Definition of the continued fraction type module Data.Number.Types where import Data.Number.Peano -infixr 5 :| -data Continued a = M (Continued a) | a :| (Continued a) | E +infixr 5 :| +-- | ==Continued fraction type +-- represents a simple continued fraction of the form: +-- @[a0, a1, a2,...] = a0 + 1\/(a1 + 1\/(a2 + 1\/...))@ +-- +-- == /Cons/ operator +-- @n :| x @ equivalent to @n@ + 1/@x@ +data Continued a = + M (Continued a) -- ^Negative number + | a :| (Continued a) -- ^Positive number + | E -- ^Zero deriving (Eq, Ord, Show, Read) -type Number = Continued Nat \ No newline at end of file +-- | Real numbers datatype (a continued fraction of naturals) +type Number = Continued Nat