From 3868c8ecba9479ffb24063cb3972cea960a7d1e4 Mon Sep 17 00:00:00 2001 From: ross Date: Fri, 23 Jul 2004 11:34:33 +0000 Subject: [PATCH] [project @ 2004-07-23 11:34:31 by ross] docs only --- Data/Complex.hs | 40 ++++++++++++++++++++----- Data/Ratio.hs | 16 ++++++---- GHC/Float.lhs | 18 +++++++----- GHC/Read.lhs | 1 + GHC/Real.lhs | 20 +++++++++++-- Numeric.hs | 87 ++++++++++++++++++++++++++++++++++++++++++++++--------- 6 files changed, 146 insertions(+), 36 deletions(-) diff --git a/Data/Complex.hs b/Data/Complex.hs index 621b48e..20448c7 100644 --- a/Data/Complex.hs +++ b/Data/Complex.hs @@ -13,17 +13,21 @@ ----------------------------------------------------------------------------- module Data.Complex - ( Complex((:+)) - + ( + -- * Rectangular form + Complex((:+)) + , realPart -- :: (RealFloat a) => Complex a -> a , imagPart -- :: (RealFloat a) => Complex a -> a - , conjugate -- :: (RealFloat a) => Complex a -> Complex a + -- * Polar form , mkPolar -- :: (RealFloat a) => a -> a -> Complex a , cis -- :: (RealFloat a) => a -> Complex a , polar -- :: (RealFloat a) => Complex a -> (a,a) , magnitude -- :: (RealFloat a) => Complex a -> a , phase -- :: (RealFloat a) => Complex a -> a - + -- * Conjugate + , conjugate -- :: (RealFloat a) => Complex a -> Complex a + -- Complex instances: -- -- (RealFloat a) => Eq (Complex a) @@ -52,32 +56,52 @@ infix 6 :+ -- ----------------------------------------------------------------------------- -- The Complex type -data (RealFloat a) => Complex a = !a :+ !a deriving (Eq, Read, Show) - +-- | Complex numbers are an algebraic type. +-- +-- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@, +-- but oriented in the positive real direction, whereas @'signum' z@ +-- has the phase of @z@, but unit magnitude. +data (RealFloat a) => Complex a + = !a :+ !a -- ^ forms a complex number from its real and imaginary + -- rectangular components. + deriving (Eq, Read, Show) -- ----------------------------------------------------------------------------- -- Functions over Complex -realPart, imagPart :: (RealFloat a) => Complex a -> a +-- | Extracts the real part of a complex number. +realPart :: (RealFloat a) => Complex a -> a realPart (x :+ _) = x + +-- | Extracts the imaginary part of a complex number. +imagPart :: (RealFloat a) => Complex a -> a imagPart (_ :+ y) = y +-- | The conjugate of a complex number. {-# SPECIALISE conjugate :: Complex Double -> Complex Double #-} conjugate :: (RealFloat a) => Complex a -> Complex a conjugate (x:+y) = x :+ (-y) +-- | Form a complex number from polar components of magnitude and phase. {-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-} mkPolar :: (RealFloat a) => a -> a -> Complex a mkPolar r theta = r * cos theta :+ r * sin theta +-- | @'cis' t@ is a complex value with magnitude @1@ +-- and phase @t@ (modulo @2*'pi'@). {-# SPECIALISE cis :: Double -> Complex Double #-} cis :: (RealFloat a) => a -> Complex a cis theta = cos theta :+ sin theta +-- | The function 'polar' takes a complex number and +-- returns a (magnitude, phase) pair in canonical form: +-- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@; +-- if the magnitude is zero, then so is the phase. {-# SPECIALISE polar :: Complex Double -> (Double,Double) #-} polar :: (RealFloat a) => Complex a -> (a,a) polar z = (magnitude z, phase z) +-- | The nonnegative magnitude of a complex number. {-# SPECIALISE magnitude :: Complex Double -> Double #-} magnitude :: (RealFloat a) => Complex a -> a magnitude (x:+y) = scaleFloat k @@ -85,6 +109,8 @@ magnitude (x:+y) = scaleFloat k where k = max (exponent x) (exponent y) mk = - k +-- | The phase of a complex number, in the range @(-'pi', 'pi']@. +-- If the magnitude is zero, then so is the phase. {-# SPECIALISE phase :: Complex Double -> Double #-} phase :: (RealFloat a) => Complex a -> a phase (0 :+ 0) = 0 -- SLPJ July 97 from John Peterson diff --git a/Data/Ratio.hs b/Data/Ratio.hs index 5c9c953..f819343 100644 --- a/Data/Ratio.hs +++ b/Data/Ratio.hs @@ -50,11 +50,17 @@ import Ratio (Ratio(..), (%), numerator, denominator, approxRational) -- ----------------------------------------------------------------------------- -- approxRational --- @approxRational@, applied to two real fractional numbers x and epsilon, --- returns the simplest rational number within epsilon of x. A rational --- number n%d in reduced form is said to be simpler than another n'%d' if --- abs n <= abs n' && d <= d'. Any real interval contains a unique --- simplest rational; here, for simplicity, we assume a closed rational +-- | 'approxRational', applied to two real fractional numbers @x@ and @epsilon@, +-- returns the simplest rational number within @epsilon@ of @x@. +-- A rational number @y@ is said to be simpler than another @y'@ if +-- +-- * @'abs' ('numerator' y) <= 'abs' ('numerator' y')@, and +-- +-- * @'denominator' y <= 'denominator' y'@. +-- +-- Any real interval contains a unique simplest rational. + +-- Implementation details: Here, for simplicity, we assume a closed rational -- interval. If such an interval includes at least one whole number, then -- the simplest rational is the absolutely least whole number. Otherwise, -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d diff --git a/GHC/Float.lhs b/GHC/Float.lhs index c133f09..f1779fc 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -443,6 +443,9 @@ instance Enum Double where \begin{code} +-- | Show a signed 'RealFloat' value to full precision +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. showFloat :: (RealFloat a) => a -> ShowS showFloat x = showString (formatRealFloat FFGeneric Nothing x) @@ -534,21 +537,19 @@ roundTo base d is = -- by R.G. Burger and R.K. Dybvig in PLDI 96. -- This version uses a much slower logarithm estimator. It should be improved. --- | @floatToDigits@ takes a base and a non-negative RealFloat number, +-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number, -- and returns a list of digits and an exponent. --- In particular, if x>=0, and +-- In particular, if @x>=0@, and -- --- @ --- floatToDigits base x = ([d1,d2,...,dn], e) --- @ +-- > floatToDigits base x = ([d1,d2,...,dn], e) -- -- then -- --- (1) n >= 1 +-- (1) @n >= 1@ -- --- (2) x = 0.d1d2...dn * (base**e) +-- (2) @x = 0.d1d2...dn * (base**e)@ -- --- (3) 0 <= di <= base-1 +-- (3) @0 <= di <= base-1@ floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) @@ -679,6 +680,7 @@ fromRat x = x' Now, here's Lennart's code (which works) \begin{code} +-- | Converts a 'Rational' value into any type in class 'RealFloat'. {-# SPECIALISE fromRat :: Rational -> Double, Rational -> Float #-} fromRat :: (RealFloat a) => Rational -> a diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 2b9c448..1e213b5 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -175,6 +175,7 @@ lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; readLitChar :: ReadS Char -- As defined by H98 readLitChar = readP_to_S L.lexChar +-- | Reads a non-empty string of decimal digits. lexDigits :: ReadS String lexDigits = readP_to_S (P.munch1 isDigit) diff --git a/GHC/Real.lhs b/GHC/Real.lhs index b71d679..8986456 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -40,6 +40,7 @@ default () -- Double isn't available yet, %********************************************************* \begin{code} +-- | Rational numbers, with numerator and denominator of some 'Integral' type. data (Integral a) => Ratio a = !a :% !a deriving (Eq) -- | Arbitrary-precision rational numbers, represented as a ratio of @@ -61,9 +62,19 @@ notANumber = 0 :% 0 \begin{code} +-- | Forms the ratio of two integral numbers. {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-} (%) :: (Integral a) => a -> a -> Ratio a -numerator, denominator :: (Integral a) => Ratio a -> a + +-- | Extract the numerator of the ratio in reduced form: +-- the numerator and denominator have no common factor and the denominator +-- is positive. +numerator :: (Integral a) => Ratio a -> a + +-- | Extract the denominator of the ratio in reduced form: +-- the numerator and denominator have no common factor and the denominator +-- is positive. +denominator :: (Integral a) => Ratio a -> a \end{code} \tr{reduce} is a subsidiary function used only in this module . @@ -310,7 +321,12 @@ realToFrac = fromRational . toRational %********************************************************* \begin{code} -showSigned :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS +-- | Converts a possibly-negative 'Real' value to a string. +showSigned :: (Real a) + => (a -> ShowS) -- ^ a function that can show unsigned values + -> Int -- ^ the precedence of the enclosing context + -> a -- ^ the value to show + -> ShowS showSigned showPos p x | x < 0 = showParen (p > 6) (showChar '-' . showPos (-x)) | otherwise = showPos x diff --git a/Numeric.hs b/Numeric.hs index d14c591..89ac0ca 100644 --- a/Numeric.hs +++ b/Numeric.hs @@ -10,24 +10,18 @@ -- Portability : portable -- -- Odds and ends, mostly functions for reading and showing --- RealFloat-like kind of values. +-- 'RealFloat'-like kind of values. -- ----------------------------------------------------------------------------- module Numeric ( - fromRat, -- :: (RealFloat a) => Rational -> a - showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS - readSigned, -- :: (Real a) => ReadS a -> ReadS a + -- * Showing - readInt, -- :: (Integral a) => a -> (Char -> Bool) - -- -> (Char -> Int) -> ReadS a - readDec, -- :: (Integral a) => ReadS a - readOct, -- :: (Integral a) => ReadS a - readHex, -- :: (Integral a) => ReadS a + showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS - showInt, -- :: Integral a => a -> ShowS showIntAtBase, -- :: Integral a => a -> (a -> Char) -> a -> ShowS + showInt, -- :: Integral a => a -> ShowS showHex, -- :: Integral a => a -> ShowS showOct, -- :: Integral a => a -> ShowS @@ -35,11 +29,31 @@ module Numeric ( showFFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS showGFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS showFloat, -- :: (RealFloat a) => a -> ShowS + + floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int) + + -- * Reading + + -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase', + -- and 'readDec' is the \`dual\' of 'showInt'. + -- The inconsistent naming is a historical accident. + + readSigned, -- :: (Real a) => ReadS a -> ReadS a + + readInt, -- :: (Integral a) => a -> (Char -> Bool) + -- -> (Char -> Int) -> ReadS a + readDec, -- :: (Integral a) => ReadS a + readOct, -- :: (Integral a) => ReadS a + readHex, -- :: (Integral a) => ReadS a + readFloat, -- :: (RealFloat a) => ReadS a - floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int) lexDigits, -- :: ReadS String + -- * Miscellaneous + + fromRat, -- :: (RealFloat a) => Rational -> a + ) where #ifdef __GLASGOW_HASKELL__ @@ -65,14 +79,29 @@ import Hugs.Numeric -- ----------------------------------------------------------------------------- -- Reading -readInt :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a +-- | Reads an /unsigned/ 'Integral' value in an arbitrary base. +readInt :: Num a + => a -- ^ the base + -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base + -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int' + -> ReadS a readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit) -readOct, readDec, readHex :: Num a => ReadS a +-- | Read an unsigned number in octal notation. +readOct :: Num a => ReadS a readOct = readP_to_S L.readOctP + +-- | Read an unsigned number in decimal notation. +readDec :: Num a => ReadS a readDec = readP_to_S L.readDecP + +-- | Read an unsigned number in hexadecimal notation. +-- Both upper or lower case letters are allowed. +readHex :: Num a => ReadS a readHex = readP_to_S L.readHexP +-- | Reads an /unsigned/ 'RealFrac' value, +-- expressed in decimal scientific notation. readFloat :: RealFrac a => ReadS a readFloat = readP_to_S readFloatP @@ -87,6 +116,8 @@ readFloatP = -- It's turgid to have readSigned work using list comprehensions, -- but it's specified as a ReadS to ReadS transformer -- With a bit of luck no one will use it. + +-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value. readSigned :: (Real a) => ReadS a -> ReadS a readSigned readPos = readParen False read' where read' r = read'' r ++ @@ -102,6 +133,7 @@ readSigned readPos = readParen False read' -- ----------------------------------------------------------------------------- -- Showing +-- | Show /non-negative/ 'Integral' numbers in base 10. showInt :: Integral a => a -> ShowS showInt n cs | n < 0 = error "Numeric.showInt: can't show negative numbers" @@ -129,8 +161,29 @@ showInt n cs Maybe Int -> Float -> ShowS, Maybe Int -> Double -> ShowS #-} +-- | Show a signed 'RealFloat' value +-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). +-- +-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation (e.g. @245000@, @0.0015@). +-- +-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. +-- +-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing', +-- the value is shown to full precision; if @digs@ is @'Just' d@, +-- then at most @d@ digits after the decimal point are shown. showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS showEFloat d x = showString (formatRealFloat FFExponent d x) @@ -141,6 +194,8 @@ showGFloat d x = showString (formatRealFloat FFGeneric d x) -- --------------------------------------------------------------------------- -- Integer printing functions +-- | Shows a /non-negative/ 'Integral' number using the base specified by the +-- first argument, and the character representation specified by the second. showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS showIntAtBase base toChr n r | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base) @@ -155,6 +210,10 @@ showIntAtBase base toChr n r c = toChr (fromIntegral d) r' = c : r -showHex, showOct :: Integral a => a -> ShowS +-- | Show /non-negative/ 'Integral' numbers in base 16. +showHex :: Integral a => a -> ShowS showHex = showIntAtBase 16 intToDigit + +-- | Show /non-negative/ 'Integral' numbers in base 8. +showOct :: Integral a => a -> ShowS showOct = showIntAtBase 8 intToDigit -- 1.7.10.4