{-# LANGUAGE DeriveDataTypeable #-}
--------------------------------------------------------------------------------
-- |
-- Module : Data.RealNumber.Rational
-- Copyright : (C) Frank Staals
-- License : see the LICENSE file
-- Maintainer : Frank Staals
--------------------------------------------------------------------------------
module Data.RealNumber.Rational(RealNumber(..)
-- * Converting to and from RealNumber's
, AsFixed(..), asFixed
, toFixed, fromFixed
, Nat
) where
import Data.Aeson
import Data.Data
import Data.Fixed
import Data.Hashable
import Data.List (dropWhileEnd)
import GHC.Generics (Generic (..))
import GHC.TypeLits
import Test.QuickCheck (Arbitrary (..))
import Control.Monad.Random
import Data.Ratio
import Control.DeepSeq
--------------------------------------------------------------------------------
-- | Real Numbers represented using Rational numbers. The number type
-- itself is exact in the sense that we can represent any rational
-- number.
--
-- The parameter, a natural number, represents the precision (in
-- number of decimals behind the period) with which we display the
-- numbers when printing them (using Show).
--
-- If the number cannot be displayed exactly a '~' is printed after
-- the number.
newtype RealNumber (p :: Nat) = RealNumber Rational
deriving (Eq,Ord,Data,Num,Fractional,Real,RealFrac,Generic,Hashable,ToJSON,FromJSON,NFData)
data NatPrec (p :: Nat) = NatPrec
instance KnownNat p => HasResolution (NatPrec p) where
resolution _ = 10 ^ (natVal (NatPrec @p))
instance KnownNat p => Show (RealNumber p) where
showsPrec d r = showParen (d > app_prec && r < 0) $
case asFixed r of
Exact p -> showString (dropWhileEnd (== '.') . dropWhileEnd (== '0') . show $ p)
Lossy p -> shows p . showChar '~'
where
app_prec = 10
instance KnownNat p => Read (RealNumber p) where
readsPrec i = map wrap . readsPrec @(Fixed (NatPrec p)) i
where
wrap (RealNumber . realToFrac -> x,s') = case s' of
'~':s'' -> (x,s'')
_ -> (x,s')
instance KnownNat p => Arbitrary (RealNumber p) where
arbitrary = fromFixed <$> arbitrary
instance Random (RealNumber p) where
-- Generate a random number between a and b with 'maxBound `div` 2 :: Int' discrete increments.
randomR (a,b) = runRand $ do
v <- getRandom
pure $ (b-a)*abs v + a
-- Generate a random number between -1 and +1 with 'maxBound::Int' discrete increments.
random = runRand $ do
v <- getRandom
let fromInt :: Int -> Integer; fromInt = fromIntegral
pure $ RealNumber $ fromInt v % fromInt maxBound
--------------------------------------------------------------------------------
-- | Fixed-precision representation of a 'RealNumber'. If there's insufficient
-- precision to accurately represent the 'RealNumber' then the 'Lossy' constructor
-- will be used.
data AsFixed p = Exact !(Fixed p) | Lossy !(Fixed p) deriving (Show,Eq)
-- | Cast 'RealNumber' to a fixed-precision number. Data is silently lost if there's
-- insufficient precision.
toFixed :: KnownNat p => RealNumber p -> Fixed (NatPrec p)
toFixed = realToFrac
-- | Cast a fixed-precision number to a 'RealNumber'.
fromFixed :: KnownNat p => Fixed (NatPrec p) -> RealNumber p
fromFixed = realToFrac
-- | Cast 'RealNumber' to a fixed-precision number. Data-loss caused by insufficient
-- precision will be marked by the 'Lossy' constructor.
asFixed :: KnownNat p => RealNumber p -> AsFixed (NatPrec p)
asFixed r = let p = toFixed r in if r == fromFixed p then Exact p else Lossy p