variable-precision 0.2 → 0.2.1

raw patch · 4 files changed

+146/−3 lines, 4 files

Files

• CHANGES +1/−0
• Numeric/VariablePrecision.hs +2/−0
• Numeric/VariablePrecision/Fixed.hs +139/−0
• variable-precision.cabal +4/−3

@@ -1,3 +1,4 @@+v0.2.1	fixed point v0.2	generic IEEE-ish v0.1.1	fixed for ghc-7.0.4 v0.1	initial release

@@ -12,6 +12,7 @@ -} module Numeric.VariablePrecision   ( module Numeric.VariablePrecision.Float+  , module Numeric.VariablePrecision.Fixed   , module Numeric.VariablePrecision.Complex   , module Numeric.VariablePrecision.Precision   , module Numeric.VariablePrecision.Precision.Reify@@ -20,6 +21,7 @@   ) where  import Numeric.VariablePrecision.Float+import Numeric.VariablePrecision.Fixed import Numeric.VariablePrecision.Complex import Numeric.VariablePrecision.Precision import Numeric.VariablePrecision.Precision.Reify

@@ -0,0 +1,139 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, Rank2Types, MonoLocalBinds #-}+{- |+Module      :  Numeric.VariablePrecision.Fixed+Copyright   :  (c) Claude Heiland-Allen 2012+License     :  BSD3++Maintainer  :  claudiusmaximus@goto10.org+Stability   :  unstable+Portability :  BangPatterns, DeriveDataTypeable, Rank2Types, MonoLocalBinds++Variable precision software fixed point based on @Integer@.++Accuracy has not been extensively verified.++Example:++> reifyPrecision 1000 $ \prec ->+>    show $ auto (355 :: VFixed N15) / 113 `atPrecision` prec++-}+module Numeric.VariablePrecision.Fixed+  ( VFixed()+  , DFixed(..)+  , toDFixed+  , fromDFixed+  , withDFixed+  ) where++import Data.Data (Data())+import Data.Typeable (Typeable())++import Data.Bits (bit, shiftL, shiftR)+import Data.Ratio ((%), numerator, denominator)++import Numeric (readSigned, readFloat)+import Text.FShow.Raw (BinDecode(..), binDecFormat, FormatStyle(Generic))++import Numeric.VariablePrecision.Precision+import Numeric.VariablePrecision.Precision.Reify+++-- | A software implementation of fixed point arithmetic, using an+--   'Integer' adjusted to @p@ bits after the binary point.+newtype VFixed p = F Integer+  deriving (Data, Typeable)+++instance HasPrecision VFixed where+  -- default implementation+++instance VariablePrecision VFixed where+  adjustPrecision = self+    where+      self (F x)+        | s > 0 = F (x `shiftL` s)+        | s < 0 = F (x `shiftR` negate s)+        | otherwise = F x+      s = naturalNumberAsInt (undefined `asPrecOut` self) - naturalNumberAsInt (undefined `asPrecIn` self)+      asPrecIn :: p -> (t p -> t q) -> p+      asPrecIn _ _ = undefined+      asPrecOut :: q -> (t p -> t q) -> q+      asPrecOut _ _ = undefined+++instance NaturalNumber p => BinDecode (VFixed p) where+  decode l@(F x) = (x, negate . fromIntegral . precision $ l)+  showDigits l = 2 + floor ((1 + fromIntegral (precision l)) * logBase 10 2 :: Double)+++instance NaturalNumber p => Show (VFixed p) where++  show = binDecFormat (Generic (Just (-5, 5))) Nothing+++instance NaturalNumber p => Read (VFixed p) where++  readsPrec _ = readSigned readFloat -- FIXME ignores precedence?+++instance NaturalNumber p => Eq (VFixed p) where F x == F y = x == y+++instance NaturalNumber p => Ord (VFixed p) where F x `compare` F y = x `compare` y+++instance NaturalNumber p => Num (VFixed p) where+  F x + F y = F $  x + y+  F x - F y = F $  x - y+  l@(F x) * F y = F $ (x * y) `shiftR` fromIntegral (precision l)+  negate (F x) = F (negate x)+  abs (F x) = F (abs x)+  signum (F x) = F (signum x)+  fromInteger x = let r = F (x `shiftL` fromIntegral (precision r)) in r+++instance NaturalNumber p => Fractional (VFixed p) where+  l@(F x) / F y = F ((x `shiftL` fromIntegral (precision l)) `quot` y)+  fromRational x =+    let r = F ((numerator x `shiftL` fromIntegral (precision r)) `quot` denominator x) in r+++instance NaturalNumber p => Real (VFixed p) where+  toRational l@(F x) = x % (bit . fromIntegral . precision) l+++instance NaturalNumber p => RealFrac (VFixed p) where+  properFraction f@(F x) = w (fromIntegral n, g)+    where+      w (a, b)+        | a < 0 && b /= 0 = (a + 1, b - 1)+        | otherwise = (a, b)+      n = x `shiftR` p+      p = fromIntegral (precision f)+      g = F (x - (n `shiftL` p))+++-- | A concrete format suitable for storage or wire transmission.+data DFixed = DFixed{ dxPrecision :: !Word, dxMantissa :: !Integer }+  deriving (Eq, Ord, Read, Show, Data, Typeable)+++-- | Freeze a 'VFixed'.+toDFixed :: NaturalNumber p => VFixed p -> DFixed+toDFixed f@(F m) = DFixed (precision f) m+++-- | Thaw a 'DFixed'.  Results in 'Nothing' on precision mismatch.+fromDFixed :: NaturalNumber p => DFixed -> Maybe (VFixed p)+fromDFixed d@(DFixed _ m)+  | dxPrecision d == precision result = Just result+  | otherwise = Nothing+  where+    result = F m  --  -XMonoLocalBinds+++-- | Thaw a 'DFixed' to its natural precision.+withDFixed :: DFixed -> (forall p . NaturalNumber p => VFixed p -> r) -> r+withDFixed (DFixed p m) f = reifyPrecision p $ \prec -> f (F m `atPrecision` prec)

@@ -1,10 +1,10 @@ Name:                variable-precision-Version:             0.2+Version:             0.2.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'.+  to 'decodeFloat'.  Version 0.2.1 added a fixed point number type.   .   Instances of the usual numeric type classes are provided, along with   additional operators (with carefully chosen fixities) to coerce,@@ -43,6 +43,7 @@   Exposed-modules:     Numeric.VariablePrecision     Numeric.VariablePrecision.Algorithms+    Numeric.VariablePrecision.Fixed     Numeric.VariablePrecision.Float     Numeric.VariablePrecision.Complex     Numeric.VariablePrecision.Precision@@ -70,4 +71,4 @@ source-repository this   type:     git   location: git://gitorious.org/variable-precision/variable-precision.git-  tag:      v0.2+  tag:      v0.2.1