variable-precision (empty) → 0.1
raw patch · 10 files changed
+794/−0 lines, 10 filesdep +basedep +floatshowdep +type-level-natural-numbersetup-changed
Dependencies added: base, floatshow, type-level-natural-number
Files
- LICENSE +30/−0
- Numeric/VariablePrecision/Complex.hs +105/−0
- Numeric/VariablePrecision/Float.hs +282/−0
- Numeric/VariablePrecision/Float/Aliases.hs +93/−0
- Numeric/VariablePrecision/Precision.hs +87/−0
- Numeric/VariablePrecision/Precision/Reify.hs +53/−0
- Setup.hs +2/−0
- TODO +32/−0
- TypeLevel/NaturalNumber/ExtraNumbers.hs +58/−0
- variable-precision.cabal +52/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Claude Heiland-Allen++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Numeric/VariablePrecision/Complex.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{- |+Module : Numeric.VariablePrecision.Complex+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : provisional+Portability : DeriveDataTypeable, GeneralizedNewtypeDeriving++Newtype wrapper around 'Data.Complex'. When both of 'Data.Complex' and+this module need to be imported, use qualified imports.++-}+module Numeric.VariablePrecision.Complex+ ( VComplex(..)+ , (.+)+ , fromComplex+ , withComplex+ , realPart+ , imagPart+ , conjugate+ , magnitude+ , magnitude2+ , phase+ , polar+ , cis+ , mkPolar+ , module Numeric.VariablePrecision.Float+ ) where++import Data.Data (Data())+import Data.Typeable (Typeable())+import qualified Data.Complex as X++import Numeric.VariablePrecision.Float++-- | Newtype wrapper around 'X.Complex' so that instances can be written+-- for 'HasPrecision' and 'VariablePrecision'. +newtype VComplex p = C{ toComplex :: X.Complex (VFloat p) }+ deriving (Eq, Num, Fractional, Floating, Data, Typeable)++-- | Alike to 'X.:+', constructs a complex number from a real part and+-- an imaginary part.+(.+) :: VFloat p -> VFloat p -> VComplex p+x .+ y = C (x X.:+ y)+infix 6 .+++instance HasPrecision VComplex+instance VariablePrecision VComplex where+ adjustPrecision (C (x X.:+ y)) = C (adjustPrecision x X.:+ adjustPrecision y)++-- | Convert 'X.Complex' to 'VComplex'.+fromComplex :: X.Complex (VFloat p) -> VComplex p+fromComplex = C++-- | Lift an operation on 'X.Complex' to one on 'VComplex'.+withComplex :: (X.Complex (VFloat p) -> X.Complex (VFloat q)) -> (VComplex p -> VComplex q)+withComplex f = fromComplex . f . toComplex++instance NaturalNumber p => Show (VComplex p) where+ showsPrec p (C c) = showsPrec p c++instance NaturalNumber p => Read (VComplex p) where+ readsPrec p = map (first C) . readsPrec p+ where first f (a, b) = (f a, b)++-- | Unit at phase.+cis :: NaturalNumber p => VFloat p -> VComplex p+cis = fromComplex . X.cis++-- | From polar form.+mkPolar :: NaturalNumber p => VFloat p -> VFloat p -> VComplex p+mkPolar r t = fromComplex (X.mkPolar r t)++-- | Conjugate.+conjugate :: NaturalNumber p => VComplex p -> VComplex p+conjugate = withComplex X.conjugate++-- | Imaginary part.+imagPart :: NaturalNumber p => VComplex p -> VFloat p+imagPart = X.imagPart . toComplex++-- | Real part.+realPart :: NaturalNumber p => VComplex p -> VFloat p+realPart = X.realPart . toComplex++-- | Phase.+phase :: NaturalNumber p => VComplex p -> VFloat p+phase = X.phase . toComplex++-- | Polar form.+polar :: NaturalNumber p => VComplex p -> (VFloat p, VFloat p)+polar = X.polar . toComplex++-- | Magnitude.+magnitude :: NaturalNumber p => VComplex p -> VFloat p+magnitude = X.magnitude . toComplex++-- | Magnitude squared.+magnitude2 :: NaturalNumber p => VComplex p -> VFloat p+magnitude2 = magnitude2' . toComplex++magnitude2' :: Num r => X.Complex r -> r+magnitude2' (x X.:+ y) = x * x + y * y
+ Numeric/VariablePrecision/Float.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}+{- |+Module : Numeric.VariablePrecision.Float+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : provisional+Portability : BangPatterns, DeriveDataTypeable++Variable precision software floating point based on @(Integer, Int)@ as+used by 'decodeFloat'.++Accuracy has not been extensively verified, and termination of numerical+algorithms has not been proven.++'floatRange' is arbitrarily limited to mitigate the problems that+occur when enormous integers might be needed during some number+type conversions (worst case consequence: program abort in gmp).++No support for infinities, NaNs, negative zero or denormalization:++ * exponent overflow throws an error instead of resulting in infinity,++ * exponent underflow traces a warning and results in zero instead of+ resulting in a denormalized number.++Some operations throw errors instead of resulting in an infinity or NaN:++ * @'recip' 0@,++ * @x '/' 0@,++ * @'sqrt' x | x < 0@,++ * @'log' x | x <= 0@.++The 'Floating' instance so far only implements algorithms for:++ * 'pi',++ * 'sqrt',++ * 'exp',++ * 'log'++with other 'Floating' methods transitting via 'Double', also 'log'+precision is limited due to internal use of @log 2 :: Double@.++-}+module Numeric.VariablePrecision.Float+ ( VFloat()+ , recodeFloat+ , module Numeric.VariablePrecision.Precision+ , module TypeLevel.NaturalNumber.ExtraNumbers+ ) where++import Data.Data (Data())+import Data.Typeable (Typeable())++import Data.Bits (bit, shiftL, shiftR)+import Data.Monoid (mappend)+import Data.Ratio ((%), numerator, denominator)++import GHC.Float (showSignedFloat)+import Numeric (readSigned, readFloat)+import Text.FShow.RealFloat (DispFloat(), FShow(fshowsPrec), fshowFloat)++import Debug.Trace (trace) -- FIXME++import Numeric.VariablePrecision.Precision+import TypeLevel.NaturalNumber.ExtraNumbers (N24, n24, N53, n53)++-- | A software implementation of floating point arithmetic, using a strict+-- pair of 'Integer' and 'Int', scaled similarly to 'decodeFloat'.+data VFloat p = F !Integer !Int deriving (Data, Typeable)++-- | Convert between generic 'RealFloat' types+-- more efficiently than 'realToFrac'.+recodeFloat :: (RealFloat a, RealFloat b) => a -> b+recodeFloat = uncurry encodeFloat . decodeFloat++instance NaturalNumber p => DispFloat (VFloat p) where+instance NaturalNumber p => FShow (VFloat p) where+ fshowsPrec p = showSignedFloat fshowFloat p+instance NaturalNumber p => Show (VFloat p) where+ showsPrec = fshowsPrec++instance NaturalNumber p => Read (VFloat p) where+ readsPrec _ = readSigned readFloat -- FIXME ignores precedence++instance HasPrecision VFloat+instance VariablePrecision VFloat where+ adjustPrecision (F 0 _) = F 0 0+ adjustPrecision x@(F m e) = result+ where+ result+ | n > 0 = checkVFloat (F (m `shiftL` n) (e - n))+ | n == 0 = checkVFloat (F m e)+ | n < 0 = checkVFloat (F (m `shiftR` negate n) (e + negate n))+ n = nq - np+ np = precision x+ nq = precision result++instance Eq (VFloat p) where+ F 0 _ == F 0 _ = True+ F a b == F x y = a == x && b == y+ F 0 _ /= F 0 _ = False+ F a b /= F x y = a /= x || b /= y++instance Ord (VFloat p) where+ F 0 _ `compare` F x _ = 0 `compare` x+ F a _ `compare` F 0 _ = a `compare` 0+ F a b `compare` F x y+ | a > 0 && x > 0 = (b `compare` y) `mappend` (a `compare` x)+ | a > 0 && x < 0 = GT+ | a < 0 && x > 0 = LT+ | a < 0 && x < 0 = (y `compare` b) `mappend` (a `compare` x)++instance NaturalNumber p => Num (VFloat p) where+ F 0 _ + xy = xy+ ab + F 0 _ = ab+ F a b + F x y+ | b > y = checkVFloat $ encodeFloat (a + (x `shiftR` (b - y))) b+ | b == y = checkVFloat $ encodeFloat (a + x) b+ | b < y = checkVFloat $ encodeFloat ((a `shiftR` (y - b)) + x) y+ F 0 _ - xy = checkVFloat $ negate xy+ ab - F 0 _ = checkVFloat $ ab+ F a b - F x y+ | b > y = checkVFloat $ encodeFloat (a - (x `shiftR` (b - y))) b+ | b == y = checkVFloat $ encodeFloat (a - x) b+ | b < y = checkVFloat $ encodeFloat ((a `shiftR` (y - b)) - x) y+ ab@(F 0 _) * _ = checkVFloat $ ab+ _ * xy@(F 0 _) = checkVFloat $ xy+ ab@(F a b) * F x y = checkVFloat $ encodeFloat ((a * x) `shiftR` (k - 2)) (b + y + k - 2)+ where k = precision ab+ negate (F a b) = checkVFloat $ F (negate a) b+ abs (F a b) = checkVFloat $ F (abs a) b+ signum (F a _) = fromInteger (signum a)+ fromInteger i = checkVFloat $ encodeFloat i 0++instance NaturalNumber p => Real (VFloat p) where+ toRational (F 0 _) = 0+ toRational (F m e)+ | e > 0 = fromInteger (m `shiftL` e)+ | e == 0 = fromInteger m+ | e < 0 = m % bit (negate e)++instance NaturalNumber p => Fractional (VFloat p) where+ _ / (F 0 _) = error "Numeric.VFloat./0" -- FIMXE+ ab@(F 0 _) / _ = checkVFloat $ ab+ ab@(F a b) / (F x y) = checkVFloat $ encodeFloat ((a `shiftL` (k + 2)) `quot` x) (b - y - k - 2) -- FIXME accuracy+ where k = precision ab+ recip (F 0 _) = error "Numeric.VFloat.recip 0" -- FIXME+ recip xy@(F x y) = checkVFloat $ encodeFloat (bit (2 * k + 2) `quot` x) (negate y - 2 * k - 2) -- FIXME accuracy+ where k = precision xy+ fromRational r = checkVFloat $ fromInteger (numerator r) / fromInteger (denominator r) -- FIXME accuracy++instance NaturalNumber p => RealFrac (VFloat p) where+ properFraction (F 0 _) = (0, checkVFloat $ 0)+ properFraction me@(F m e)+ | e >= 0 = (fromInteger m, checkVFloat $ 0)+ | e < negate (precision me) = (0, checkVFloat $ me)+ | otherwise = (fromInteger n', checkVFloat $ f')+ where+ n = m `shiftR` (negate e)+ d = F (n `shiftL` (negate e)) e+ f = me - d+ (n', f')+ | (m >= 0) == (f >= 0) = (n, f)+ | otherwise = (n + 1, f - 1)++instance NaturalNumber p => RealFloat (VFloat p) where+ floatRadix _ = 2+ floatDigits = precision+ floatRange _ = (negate (bit 20), bit 20) -- FIXME+ -- this floatRange is somewhat arbitrary, but toInteger gives integers+ -- with up to around (precision + maxExponent) bits, the value here+ -- gives rise to potentially more than 300k decimal digits...+ isNaN _ = False+ isInfinite _ = False+ isDenormalized _ = False+ isNegativeZero _ = False+ isIEEE _ = False+ decodeFloat (F 0 _) = (0, 0)+ decodeFloat (F m e) = (m, e)+ encodeFloat 0 _ = F 0 0+ encodeFloat m e = result+ where+ result = checkVFloat $ encodeFloat' (signum m) (abs m) e+ b = precision result+ hi = bit (b + 1)+ lo = bit b+ encodeFloat' !s' !m' !e'+ | m' <= 0 = failed -- FIXME+ | lo <= m' && m' < hi = F (s' * (m' `shiftR` 1)) (e' + 1)+ | m' < lo = encodeFloat' s' (m' `shiftL` 1) (e' - 1)+ | hi <= m' = encodeFloat' s' (m' `shiftR` 1) (e' + 1)+ | otherwise = failed -- FIXME+ where+ failed = error $ "Numeric.VariablePrecision.VFloat.encodeFloat\n"+ ++ show (m, e, b, lo, hi, s', m', e')+ ++ "\nplease report this as a bug."++instance NaturalNumber p => Floating (VFloat p) where -- FIXME++ -- <http://en.wikipedia.org/wiki/AGM_method>+ pi = checkVFloat $ go 1 (sqrt 0.5) 1 2 0+ where+ go a b s k p+ | p == p' = p'+ | otherwise = go a' b' s' k' p'+ where+ a' = (a + b) / 2+ b' = sqrt (a * b)+ c = (a - b) / 2+ s' = s - k' * c * c+ k' = 2 * k+ p' = 4 * a' * a' / s++ -- Newton's method+ sqrt f+ | 0 == f = F 0 0+ | 0 < f = checkVFloat $ go 1+ where+ go !r =+ let r' = (r + f / r) / 2+ in if r == r' then r else go r'++ -- power series+ exp f = checkVFloat $ go 0 1 1 1+ where+ go !e !nf !fn !n =+ let e' = e + fn / nf+ in if e == e' then e else go e' (nf * n) (f * fn) (n + 1)++ -- <http://en.wikipedia.org/wiki/Logarithm#Arithmetic-geometric_mean_approximation>+ log f@(F _ e)+ | f > 0 = checkVFloat $ pi / (2 * agm 1 (encodeFloat 1 (2 - m) / f)) - fromIntegral m * ln2+ where+ p = precision f+ -- f ~= sqrt 2 * 2^(p + e)+ -- f * 2^m > (sqrt 2) ^ p+ -- sqrt 2 * 2 ^ (p + e) * 2 ^ m > sqrt 2 ^ p+ -- 1/2 + p + e + m > p / 2+ -- 1 + p + 2 e + 2 m > 0+ m = negate $ p `div` 2 + e+ agm !a! b =+ let a' = (a + b) / 2+ b' = sqrt (a * b)+ in if a' == b' || (a == a' && b == b') then a' else agm a' b'+ ln2 = viaDouble log 2 -- FIXME++ sin = viaDouble sin -- FIXME+ cos = viaDouble cos -- FIXME+ tan = viaDouble tan -- FIXME+ sinh = viaDouble sinh -- FIXME+ cosh = viaDouble cosh -- FIXME+ tanh = viaDouble tanh -- FIXME+ asin = viaDouble asin -- FIXME+ acos = viaDouble acos -- FIXME+ atan = viaDouble atan -- FIXME+ asinh = viaDouble asinh -- FIXME+ acosh = viaDouble acosh -- FIXME+ atanh = viaDouble atanh -- FIXME++viaDouble :: NaturalNumber p => (Double -> Double) -> (VFloat p -> VFloat p)+viaDouble f = recodeFloat . checkDouble . f . recodeFloat++checkDouble :: Double -> Double+checkDouble f+ | isNaN f = error "Numeric.VariablePrecision.Float: isNaN" -- FIXME+ | isInfinite f = error "Numeric.VariablePrecision.Float: isInfinite" -- FIXME+ | otherwise = f++checkVFloat :: NaturalNumber p => VFloat p -> VFloat p+checkVFloat x@(F _ e)+ | lo <= e && e <= hi = x+ | e < lo = trace ("Numeric.VariablePrecision.Float underflow: " ++ show x) 0 -- FIXME+ | otherwise = error ("Numeric.VariablePrecision.Float overflow: " ++ show x) -- FIXME+ where (lo, hi) = floatRange x
+ Numeric/VariablePrecision/Float/Aliases.hs view
@@ -0,0 +1,93 @@+{-|+Module : Numeric.VariablePrecision.Float.Aliases+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : stable+Portability : portable++Boilerplate definitions generated by:++> flip mapM_ [1..53] $ \p -> let s = show p in+> putStrLn $ "type F" ++ s ++ " = VFloat N" ++ s +++> " ; f" ++ s ++ " :: F" ++ s ++ " ; f" ++ s ++ " = 0"++Along with aliases for 'recodeFloat' with specialized types.++-}+module Numeric.VariablePrecision.Float.Aliases where++import Numeric.VariablePrecision.Float (VFloat, recodeFloat)+import TypeLevel.NaturalNumber+import TypeLevel.NaturalNumber.ExtraNumbers++-- | Convert to a Float from the same precision.+toFloat :: F24 -> Float+toFloat = recodeFloat++-- | Convert from a Float to the same precision.+fromFloat :: Float -> F24+fromFloat = recodeFloat++-- | Convert to a Double from the same precision.+toDouble :: F53 -> Double+toDouble = recodeFloat++-- | Convert from a Double to the same precision.+fromDouble :: Double -> F53+fromDouble = recodeFloat++type F1 = VFloat N1 ; f1 :: F1 ; f1 = 0+type F2 = VFloat N2 ; f2 :: F2 ; f2 = 0+type F3 = VFloat N3 ; f3 :: F3 ; f3 = 0+type F4 = VFloat N4 ; f4 :: F4 ; f4 = 0+type F5 = VFloat N5 ; f5 :: F5 ; f5 = 0+type F6 = VFloat N6 ; f6 :: F6 ; f6 = 0+type F7 = VFloat N7 ; f7 :: F7 ; f7 = 0+type F8 = VFloat N8 ; f8 :: F8 ; f8 = 0+type F9 = VFloat N9 ; f9 :: F9 ; f9 = 0+type F10 = VFloat N10 ; f10 :: F10 ; f10 = 0+type F11 = VFloat N11 ; f11 :: F11 ; f11 = 0+type F12 = VFloat N12 ; f12 :: F12 ; f12 = 0+type F13 = VFloat N13 ; f13 :: F13 ; f13 = 0+type F14 = VFloat N14 ; f14 :: F14 ; f14 = 0+type F15 = VFloat N15 ; f15 :: F15 ; f15 = 0+type F16 = VFloat N16 ; f16 :: F16 ; f16 = 0+type F17 = VFloat N17 ; f17 :: F17 ; f17 = 0+type F18 = VFloat N18 ; f18 :: F18 ; f18 = 0+type F19 = VFloat N19 ; f19 :: F19 ; f19 = 0+type F20 = VFloat N20 ; f20 :: F20 ; f20 = 0+type F21 = VFloat N21 ; f21 :: F21 ; f21 = 0+type F22 = VFloat N22 ; f22 :: F22 ; f22 = 0+type F23 = VFloat N23 ; f23 :: F23 ; f23 = 0+type F24 = VFloat N24 ; f24 :: F24 ; f24 = 0+type F25 = VFloat N25 ; f25 :: F25 ; f25 = 0+type F26 = VFloat N26 ; f26 :: F26 ; f26 = 0+type F27 = VFloat N27 ; f27 :: F27 ; f27 = 0+type F28 = VFloat N28 ; f28 :: F28 ; f28 = 0+type F29 = VFloat N29 ; f29 :: F29 ; f29 = 0+type F30 = VFloat N30 ; f30 :: F30 ; f30 = 0+type F31 = VFloat N31 ; f31 :: F31 ; f31 = 0+type F32 = VFloat N32 ; f32 :: F32 ; f32 = 0+type F33 = VFloat N33 ; f33 :: F33 ; f33 = 0+type F34 = VFloat N34 ; f34 :: F34 ; f34 = 0+type F35 = VFloat N35 ; f35 :: F35 ; f35 = 0+type F36 = VFloat N36 ; f36 :: F36 ; f36 = 0+type F37 = VFloat N37 ; f37 :: F37 ; f37 = 0+type F38 = VFloat N38 ; f38 :: F38 ; f38 = 0+type F39 = VFloat N39 ; f39 :: F39 ; f39 = 0+type F40 = VFloat N40 ; f40 :: F40 ; f40 = 0+type F41 = VFloat N41 ; f41 :: F41 ; f41 = 0+type F42 = VFloat N42 ; f42 :: F42 ; f42 = 0+type F43 = VFloat N43 ; f43 :: F43 ; f43 = 0+type F44 = VFloat N44 ; f44 :: F44 ; f44 = 0+type F45 = VFloat N45 ; f45 :: F45 ; f45 = 0+type F46 = VFloat N46 ; f46 :: F46 ; f46 = 0+type F47 = VFloat N47 ; f47 :: F47 ; f47 = 0+type F48 = VFloat N48 ; f48 :: F48 ; f48 = 0+type F49 = VFloat N49 ; f49 :: F49 ; f49 = 0+type F50 = VFloat N50 ; f50 :: F50 ; f50 = 0+type F51 = VFloat N51 ; f51 :: F51 ; f51 = 0+type F52 = VFloat N52 ; f52 :: F52 ; f52 = 0+type F53 = VFloat N53 ; f53 :: F53 ; f53 = 0
+ Numeric/VariablePrecision/Precision.hs view
@@ -0,0 +1,87 @@+{- |+Module : Numeric.VariablePrecision.Precision+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : provisional+Portability : portable++Classes for types with precision represented by a type-level natural+number, and variable precision types.++Note that performance may be (even) slow(er) with some versions of the+type-level-natural-number package.++-}+module Numeric.VariablePrecision.Precision+ ( HasPrecision(precisionOf)+ , precision+ , atPrecision+ , atPrecisionOf+ , (.@)+ , VariablePrecision(adjustPrecision)+ , withPrecision+ , withPrecisionOf+ , (.@~)+ , module TypeLevel.NaturalNumber+ ) where++import TypeLevel.NaturalNumber++-- | A class for types with precision.+-- Minimal complete definition: (none).+class HasPrecision t where+ -- | Get the precision of a value. 'precisionOf' must not evaluate+ -- its argument, and its result must not be evaluated.+ precisionOf :: NaturalNumber p => t p -> p+ precisionOf _ = error "Numeric.VariablePrecision.Precision.HasPrecision.precisionOf: result evaluated"++-- | Much like 'naturalNumberAsInt' combined with 'precisionOf'.+precision :: (HasPrecision t, NaturalNumber p) => t p -> Int+precision = naturalNumberAsInt . precisionOf++-- | Much like 'const' with a restricted type.+atPrecision :: (HasPrecision t, NaturalNumber p) => t p -> p -> t p+atPrecision = const++-- | Much like 'const' with a restricted type.+atPrecisionOf+ :: (HasPrecision t, HasPrecision s, NaturalNumber p)+ => t p -> s p -> t p+atPrecisionOf = const+infixl 5 `atPrecisionOf` -- precedence between Prelude.< and Prelude.+++-- | An alias for 'atPrecisionOf'.+(.@)+ :: (HasPrecision t, HasPrecision s, NaturalNumber p)+ => t p -> s p -> t p+(.@) = atPrecisionOf+infixl 5 .@ -- precedence between Prelude.< and Prelude.+++-- | A class for types with variable precision.+-- Minimal complete definition: (all).+class HasPrecision t => VariablePrecision t where+ -- | Adjust the precision of a value preserving as much accuracy as+ -- possible.+ adjustPrecision :: (NaturalNumber p, NaturalNumber q) => t p -> t q++-- | Much like 'adjustPrecision' combined with 'atPrecision'.+withPrecision+ :: (VariablePrecision t, NaturalNumber p, NaturalNumber q)+ => t p -> q -> t q+withPrecision x q = adjustPrecision x `atPrecision` q++-- | Much like 'withPrecision' combined with 'precisionOf'.+withPrecisionOf+ :: (VariablePrecision t, HasPrecision s, NaturalNumber p, NaturalNumber q)+ => t p -> s q -> t q+withPrecisionOf x w = x `withPrecision` precisionOf w+infixl 5 `withPrecisionOf` -- precedence between Prelude.< and Prelude.+++-- | An alias for 'withPrecisionOf'.+(.@~)+ :: (VariablePrecision t, HasPrecision s, NaturalNumber p, NaturalNumber q)+ => t p -> s q -> t q+(.@~) = withPrecisionOf+infixl 5 .@~ -- precedence between Prelude.< and Prelude.+
+ Numeric/VariablePrecision/Precision/Reify.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE Rank2Types #-}+{- |+Module : Numeric.VariablePrecision.Precision.Reify+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : provisional+Portability : Rank2Types++Reify from value-level to type-level using Rank2Types.++-}++module Numeric.VariablePrecision.Precision.Reify+ ( reifyPrecision+ , withReifiedPrecision+ , (.@$)+ ) where++import Numeric.VariablePrecision.Precision (NaturalNumber, n0, successorTo, VariablePrecision, withPrecision)++-- | Reify a precision from value-level to type-level.+reifyPrecision :: Int -> (forall p . NaturalNumber p => p -> a) -> a+-- Implemented as described in an email from Gregory Grosswhite+-- <http://markmail.org/message/55iuty6axeljj2do>+reifyPrecision = go n0+ where+ go :: NaturalNumber q => q -> Int -> (forall p . NaturalNumber p => p -> a) -> a+ go n i f+ | i < 0 = error $ "Numeric.VariablePrecision.Precision.Reify.reifyPrecision: negative argument: " ++ show i+ | i == 0 = f n+ | i > 0 = go (successorTo n) (i - 1) f++-- | Much like 'reifyPrecision' combined with 'withPrecision'.+withReifiedPrecision+ :: (VariablePrecision t, NaturalNumber p)+ => t p {-^ original value -}+ -> Int {- ^ new precision -}+ -> (forall q. NaturalNumber q => t q -> a) {-^ operation -}+ -> a+withReifiedPrecision x i f = reifyPrecision i (f . withPrecision x)+infixl 1 `withReifiedPrecision` -- same fixity as Prelude.$++-- | An alias for 'withReifiedPrecision'.+(.@$)+ :: (VariablePrecision t, NaturalNumber p)+ => t p {-^ original value -}+ -> Int {- ^ new precision -}+ -> (forall q. NaturalNumber q => t q -> a) {-^ operation -}+ -> a+(.@$) = withReifiedPrecision+infix 1 .@$ -- same fixity as Prelude.$
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,32 @@+Numeric.VariablePrecision.Precision+ examples of usage in documentation++Numeric.VariablePrecision.Precision.Reify+ examples of usage in documentation++Numeric.VariablePrecision.Float+ improve accuracy of log (bad: log 2 :: Double)+ readsPrec ignores precedence+ proper exception types for+ division by zero+ sqrt negative+ log nonpositive+ floatRange overflow+ reconsider warning on floatRange underflow+ check accuracy of (/), recip+ check accuracy of fromRational+ check accuracy of (+), (-), (*)+ proper (a)(sin|cos|tan)(h) (bad: viaDouble)+ profile and optimise space and time+ consider rounding modes+ consider mixed-precision operations+ consider IEEE inf/nan/-0 semantics++Numeric.VariablePrecision.Complex.Aliases+ if it proves necessary for convenience++Numeric.VariablePrecision.Algorithms+ effective precision of difference++TypeLevel.NaturalNumber.ExtraNumbers+ submit upstream and remove if accepted
+ TypeLevel/NaturalNumber/ExtraNumbers.hs view
@@ -0,0 +1,58 @@+{- |+Module : TypeLevel.NaturalNumber.ExtraNumbers+Copyright : (c) Claude Heiland-Allen 2012+License : BSD3++Maintainer : claudiusmaximus@goto10.org+Stability : stable+Portability : portable++Boilerplate definitions generated by:++> flip mapM_ [16..53] $ \p -> let s = show p in+> putStrLn $ "type N" ++ s ++ " = SuccessorTo N" ++ show (p - 1) +++> " ; n" ++ s ++ " :: N" ++ s ++ " ; n" ++ s ++ " = undefined"++-}+module TypeLevel.NaturalNumber.ExtraNumbers where++import TypeLevel.NaturalNumber (N15, SuccessorTo)++type N16 = SuccessorTo N15 ; n16 :: N16 ; n16 = undefined+type N17 = SuccessorTo N16 ; n17 :: N17 ; n17 = undefined+type N18 = SuccessorTo N17 ; n18 :: N18 ; n18 = undefined+type N19 = SuccessorTo N18 ; n19 :: N19 ; n19 = undefined+type N20 = SuccessorTo N19 ; n20 :: N20 ; n20 = undefined+type N21 = SuccessorTo N20 ; n21 :: N21 ; n21 = undefined+type N22 = SuccessorTo N21 ; n22 :: N22 ; n22 = undefined+type N23 = SuccessorTo N22 ; n23 :: N23 ; n23 = undefined+type N24 = SuccessorTo N23 ; n24 :: N24 ; n24 = undefined+type N25 = SuccessorTo N24 ; n25 :: N25 ; n25 = undefined+type N26 = SuccessorTo N25 ; n26 :: N26 ; n26 = undefined+type N27 = SuccessorTo N26 ; n27 :: N27 ; n27 = undefined+type N28 = SuccessorTo N27 ; n28 :: N28 ; n28 = undefined+type N29 = SuccessorTo N28 ; n29 :: N29 ; n29 = undefined+type N30 = SuccessorTo N29 ; n30 :: N30 ; n30 = undefined+type N31 = SuccessorTo N30 ; n31 :: N31 ; n31 = undefined+type N32 = SuccessorTo N31 ; n32 :: N32 ; n32 = undefined+type N33 = SuccessorTo N32 ; n33 :: N33 ; n33 = undefined+type N34 = SuccessorTo N33 ; n34 :: N34 ; n34 = undefined+type N35 = SuccessorTo N34 ; n35 :: N35 ; n35 = undefined+type N36 = SuccessorTo N35 ; n36 :: N36 ; n36 = undefined+type N37 = SuccessorTo N36 ; n37 :: N37 ; n37 = undefined+type N38 = SuccessorTo N37 ; n38 :: N38 ; n38 = undefined+type N39 = SuccessorTo N38 ; n39 :: N39 ; n39 = undefined+type N40 = SuccessorTo N39 ; n40 :: N40 ; n40 = undefined+type N41 = SuccessorTo N40 ; n41 :: N41 ; n41 = undefined+type N42 = SuccessorTo N41 ; n42 :: N42 ; n42 = undefined+type N43 = SuccessorTo N42 ; n43 :: N43 ; n43 = undefined+type N44 = SuccessorTo N43 ; n44 :: N44 ; n44 = undefined+type N45 = SuccessorTo N44 ; n45 :: N45 ; n45 = undefined+type N46 = SuccessorTo N45 ; n46 :: N46 ; n46 = undefined+type N47 = SuccessorTo N46 ; n47 :: N47 ; n47 = undefined+type N48 = SuccessorTo N47 ; n48 :: N48 ; n48 = undefined+type N49 = SuccessorTo N48 ; n49 :: N49 ; n49 = undefined+type N50 = SuccessorTo N49 ; n50 :: N50 ; n50 = undefined+type N51 = SuccessorTo N50 ; n51 :: N51 ; n51 = undefined+type N52 = SuccessorTo N51 ; n52 :: N52 ; n52 = undefined+type N53 = SuccessorTo N52 ; n53 :: N53 ; n53 = undefined
+ variable-precision.cabal view
@@ -0,0 +1,52 @@+Name: variable-precision+Version: 0.1+Synopsis: variable-precision floating point+Description:+ Software floating point with type-tagged variable mantissa precision,+ implemented using a strict pair of 'Integer' and 'Int' scaled alike+ to 'decodeFloat'.+ .+ Instances of the usual numeric type classes are provided, along with+ additional operators (with carefully chosen fixities) to coerce,+ adjust and reify precisions.+ .+ The intention with this library is to be relatively simple but still+ useful, refer to the documentation for caveats concerning accuracy and+ assorted ill-behaviour.++Homepage: https://gitorious.org/variable-precision+License: BSD3+License-file: LICENSE+Author: Claude Heiland-Allen+Maintainer: claudiusmaximus@goto10.org+Copyright: (c) 2012 Claude Heiland-Allen+Category: Math+Build-type: Simple++Cabal-version: >=1.6++Extra-source-files: TODO++Library+ Exposed-modules:+ Numeric.VariablePrecision.Complex+ Numeric.VariablePrecision.Float+ Numeric.VariablePrecision.Float.Aliases+ Numeric.VariablePrecision.Precision+ Numeric.VariablePrecision.Precision.Reify+ TypeLevel.NaturalNumber.ExtraNumbers+ Build-depends:+ base >= 3 && < 6,+ floatshow >= 0.2 && < 0.3,+ type-level-natural-number >= 1 && < 2+ GHC-Options: -Wall -fno-warn-incomplete-patterns+ GHC-Prof-Options: -prof -auto-all -caf-all++source-repository head+ type: git+ location: git://gitorious.org/variable-precision/variable-precision.git++source-repository this+ type: git+ location: git://gitorious.org/variable-precision/variable-precision.git+ tag: v0.1