Safe Haskell | None |
---|---|
Language | Haskell2010 |
Discretized floating point numbers, where the scaling factor is kept as two phantom types denoting the rational number used for scaling.
Synopsis
- data RatioTy a
- class RatioTyConstant a where
- ratioTyConstant :: Proxy a -> Ratio Integer
- newtype Discretized (b :: k) = Discretized {}
- discretizeRatio :: forall a u l. (Real a, KnownNat u, KnownNat l) => a -> Discretized ((u :: Nat) :% (l :: Nat))
Documentation
Some discretizations are of the type ln 2 / 2
(PAM
matrices in Blast
for example). Using this type, we can annotate as follows: Discretized
(RTyLn 2 :% RTyId 2)
.
One may use Unknown
if the scale is not known. For example, the blast
matrices use different scales internally and one needs to read the header to
get the scale.
Instances
class RatioTyConstant a where Source #
Instances
KnownNat k => RatioTyConstant (RTyExp k :: RatioTy Nat) Source # | |
Defined in Numeric.Discretized | |
KnownNat k => RatioTyConstant (RTyId k :: RatioTy Nat) Source # | |
Defined in Numeric.Discretized | |
KnownNat k => RatioTyConstant (RTyLn k :: RatioTy Nat) Source # | |
Defined in Numeric.Discretized | |
(RatioTyConstant a, RatioTyConstant b) => RatioTyConstant (RTyTimes a b :: RatioTy k) Source # | |
Defined in Numeric.Discretized | |
(RatioTyConstant a, RatioTyConstant b) => RatioTyConstant (RTyPlus a b :: RatioTy k) Source # | |
Defined in Numeric.Discretized |
newtype Discretized (b :: k) Source #
A discretized value takes a floating point number n
and produces a
discretized value. The actual discretization formula is given on the type
level, freeing us from having to carry around some scaling function.
Typically, one might use types likes 100
, (100 :% 1)
, or (RTyLn 2 :%
RTyId 2)
.
The main use of a Discretized
value is to enable calculations with Int
while somewhat pretending to use floating point values.
Be careful with certain operations like (*)
as they will easily cause the
numbers to arbitrarily wrong. (+)
and (-)
are fine, however.
NOTE Export and import of data is in the form of floating points, which can lead to additional loss of precision if one is careless!
TODO fast Show
methods required!
TODO blaze stuff?
TODO We might want to discretize LogDomain
style values. This requires
some thought on in which direction to wrap. Maybe, we want to log-domain
Discretized values, which probably just works.
Instances
discretizeRatio :: forall a u l. (Real a, KnownNat u, KnownNat l) => a -> Discretized ((u :: Nat) :% (l :: Nat)) Source #
Discretizes any Real a
into the Discretized
value. This conversion
is lossy and uses a type-level rational of u :% l
!