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
newtype VFixed p = F Integer
deriving (Data, Typeable)
instance HasPrecision VFixed where
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
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))
data DFixed = DFixed{ dxPrecision :: !Word, dxMantissa :: !Integer }
deriving (Eq, Ord, Read, Show, Data, Typeable)
toDFixed :: NaturalNumber p => VFixed p -> DFixed
toDFixed f@(F m) = DFixed (precision f) m
fromDFixed :: NaturalNumber p => DFixed -> Maybe (VFixed p)
fromDFixed d@(DFixed _ m)
| dxPrecision d == precision result = Just result
| otherwise = Nothing
where
result = F m
withDFixed :: DFixed -> (forall p . NaturalNumber p => VFixed p -> r) -> r
withDFixed (DFixed p m) f = reifyPrecision p $ \prec -> f (F m `atPrecision` prec)