git.iko.soy/rowtype-yoga/purescript-fixed-precision
on main help sign in
Add 'rescale' (#25)
623e513Harry Garrood
src/Data/Fixed.purs+14−1
compare with main
unifiedsplit
@@ -15,6 +15,7 @@ module Data.Fixed
15 , floor
15 , floor
16 , ceil
16 , ceil
17 , round
17 , round
18+ , rescale
18 , approxDiv
19 , approxDiv
19 , kind Precision
20 , kind Precision
20 , One
21 , One
@@ -40,11 +41,12 @@ import Data.Array (replicate)
40import Data.BigInt (BigInt)
41import Data.BigInt (BigInt)
41import Data.BigInt as BigInt
42import Data.BigInt as BigInt
42import Data.Int as Int
43import Data.Int as Int
43−import Data.Maybe (Maybe(..))
44+import Data.Maybe (Maybe(..), fromJust)
44import Data.Monoid as Monoid
45import Data.Monoid as Monoid
45import Data.String.CodeUnits as StringCU
46import Data.String.CodeUnits as StringCU
46import Data.String as String
47import Data.String as String
47import Math as Math
48import Math as Math
49+import Partial.Unsafe (unsafePartial)
48import Prim.TypeError (class Warn, Text)
50import Prim.TypeError (class Warn, Text)
49
51
50-- | A kind for type-level precision information
52-- | A kind for type-level precision information
@@ -294,6 +296,17 @@ round n = Fixed (numerator n + x) where
294 | m * BigInt.fromInt 2 >= d = d - m
296 | m * BigInt.fromInt 2 >= d = d - m
295 | otherwise = -m
297 | otherwise = -m
296
298
299+-- | Change the precision of a fixed-point number. If the new precision is
300+-- | less than the old precision, extra decimal places will be lost.
301+rescale
302+ :: forall precision1 precision2
303+ . KnownPrecision precision1
304+ => KnownPrecision precision2
305+ => Fixed precision1
306+ -> Fixed precision2
307+rescale =
308+ unsafePartial (fromJust <<< fromString <<< toString)
309+
297-- | Division of fixed-precision numbers. This function is deprecated; you
310-- | Division of fixed-precision numbers. This function is deprecated; you
298-- | should use `/` from the `EuclideanRing` instance instead.
311-- | should use `/` from the `EuclideanRing` instance instead.
299approxDiv
312approxDiv
test/Main.purs+51−1
@@ -2,7 +2,7 @@ module Test.Main where
2
2
3import Prelude
3import Prelude
4
4
5−import Data.Fixed (class KnownPrecision, Fixed, PProxy, fromNumber, toNumber, fromString, reifyPrecision, reflectPrecision, toString, P100)
5+import Data.Fixed (class KnownPrecision, Fixed, PProxy, fromNumber, toNumber, fromString, reifyPrecision, reflectPrecision, toString, P100, rescale, fromBigInt, floor)
6import Data.BigInt as BigInt
6import Data.BigInt as BigInt
7import Data.Maybe (Maybe(..), fromJust, isJust)
7import Data.Maybe (Maybe(..), fromJust, isJust)
8import Effect (Effect)
8import Effect (Effect)
@@ -27,6 +27,28 @@ fromNumberWith
27 -> Maybe (Fixed precision)
27 -> Maybe (Fixed precision)
28fromNumberWith _ = fromNumber
28fromNumberWith _ = fromNumber
29
29
30+-- | For type hinting.
31+withPrecisionOf
32+ :: forall precision
33+ . PProxy precision
34+ -> Fixed precision
35+ -> Fixed precision
36+withPrecisionOf _ x = x
37+
38+floorToPrecision
39+ :: forall precision
40+ . KnownPrecision precision
41+ => Int
42+ -> Fixed precision
43+ -> Fixed precision
44+floorToPrecision p =
45+ (_ / scaleFactor)
46+ <<< floor
47+ <<< (_ * scaleFactor)
48+ where
49+ scaleFactor =
50+ fromBigInt (BigInt.pow (BigInt.fromInt 10) (BigInt.fromInt p))
51+
30main :: Effect Unit
52main :: Effect Unit
31main = do
53main = do
32 log "Commutative monoid under addition:"
54 log "Commutative monoid under addition:"
@@ -123,3 +145,31 @@ main = do
123 Nothing ->
145 Nothing ->
124 false
146 false
125 <?> ("failed to roundtrip via Number: " <> show { precision, x })
147 <?> ("failed to roundtrip via Number: " <> show { precision, x })
148+
149+ log ""
150+ log "rescale"
151+ log ""
152+
153+ log "rescaling up then down should be no-op"
154+ quickCheck' 1000 do
155+ let lo = 10
156+ hi <- chooseInt 10 20
157+ unsafePartial fromJust $ join $
158+ reifyPrecision lo \lo_ ->
159+ reifyPrecision hi \hi_ -> do
160+ x <- genFixedP lo_
161+ let y = withPrecisionOf hi_ $ rescale x
162+ let xx = rescale y
163+ pure $ x == xx <?> show { x, xx, y }
164+
165+ log "rescaling down then up should be the same as flooring"
166+ quickCheck' 1000 do
167+ let hi = 20
168+ lo <- chooseInt 10 20
169+ unsafePartial fromJust $ join $
170+ reifyPrecision lo \lo_ ->
171+ reifyPrecision hi \hi_ -> do
172+ x <- genFixedP hi_
173+ let y = withPrecisionOf lo_ $ rescale x
174+ let xx = floorToPrecision lo x
175+ pure $ xx == rescale y <?> show { x, xx, y }