git.iko.soy/rowtype-yoga/purescript-fixed-precision
on main help sign in
rowtype-yoga/purescript-fixed-precision/test/Main.purs
179 lines 5.7 kB history raw
1module Test.Main where
3import Prelude
5import Data.Fixed (class KnownPrecision, Fixed, PProxy, fromNumber, toNumber, fromString, reifyPrecision, reflectPrecision, toString, P100, rescale, fromBigInt, floor, ceil, numerator)
6import Data.BigInt as BigInt
7import Data.Maybe (Maybe(..), fromJust, isJust)
8import Effect (Effect)
9import Effect.Console (log)
10import Data.Number as Math
11import Partial.Unsafe (unsafePartial)
12import Test.QuickCheck (arbitrary, quickCheck', (<?>), (===))
13import Test.QuickCheck.Gen (Gen, chooseInt, uniform, suchThat)
15-- Just here to package up the safe use of `unsafePartial`.
16trying :: forall a b. Gen a -> (a -> Maybe b) -> Gen b
17trying gen f = map (unsafePartial fromJust) (map f gen `suchThat` isJust)
19genFixedP :: forall p. KnownPrecision p => PProxy p -> Gen (Fixed p)
20genFixedP _ = map (fromNumber <<< stretch) uniform `trying` identity
21 where
22 -- maps [0,1] to [-10,10]
23 stretch = (_ * 20.0) >>> (_ - 10.0)
25fromNumberWith
26 :: forall precision
27 . KnownPrecision precision
28 => PProxy precision
29 -> Number
30 -> Maybe (Fixed precision)
31fromNumberWith _ = fromNumber
33-- | For type hinting.
34withPrecisionOf
35 :: forall precision
36 . PProxy precision
37 -> Fixed precision
38 -> Fixed precision
39withPrecisionOf _ x = x
41truncateToPrecision
42 :: forall precision
43 . KnownPrecision precision
44 => Int
45 -> Fixed precision
46 -> Fixed precision
47truncateToPrecision p =
48 (_ / scaleFactor)
49 <<< (\x -> if x > zero then floor x else ceil x)
50 <<< (_ * scaleFactor)
51 where
52 scaleFactor =
53 fromBigInt (BigInt.pow (BigInt.fromInt 10) (BigInt.fromInt p))
55main :: Effect Unit
56main = do
57 log "Commutative monoid under addition:"
58 log ""
60 log "Associativity: (a + b) + c = a + (b + c)"
61 quickCheck' 1000 do
62 precision <- chooseInt 0 10
63 unsafePartial fromJust $ reifyPrecision precision \p -> do
64 a <- genFixedP p
65 b <- genFixedP p
66 c <- genFixedP p
67 pure $ (a + b) + c == a + (b + c) <?> show { precision, a, b, c }
69 log "Identity: zero + a = a + zero = a"
71 quickCheck' 1000 do
72 precision <- chooseInt 0 10
73 unsafePartial fromJust $ reifyPrecision precision \p -> do
74 a <- genFixedP p
75 pure $ zero + a == a <?> show { precision, a }
76 quickCheck' 1000 do
77 precision <- chooseInt 0 10
78 unsafePartial fromJust $ reifyPrecision precision \p -> do
79 a <- genFixedP p
80 pure $ a + zero == a <?> show { precision, a }
82 log "Commutative: a + b = b + a"
83 quickCheck' 1000 do
84 precision <- chooseInt 0 10
85 unsafePartial fromJust $ reifyPrecision precision \p -> do
86 a <- genFixedP p
87 b <- genFixedP p
88 pure $ a + b == b + a <?> show { precision, a, b }
90 log "Multiplicative unit: one * a = a * one = a"
92 quickCheck' 1000 do
93 precision <- chooseInt 0 10
94 unsafePartial fromJust $ reifyPrecision precision \p -> do
95 a <- genFixedP p
96 pure $ one * a == a <?> show { precision, a }
97 quickCheck' 1000 do
98 precision <- chooseInt 0 10
99 unsafePartial fromJust $ reifyPrecision precision \p -> do
100 a <- genFixedP p
101 pure $ a * one == a <?> show { precision, a }
103 log "Multiplicative zero: zero * a = a * zero = zero"
104 quickCheck' 1000 do
105 precision <- chooseInt 0 10
106 unsafePartial fromJust $ reifyPrecision precision \p -> do
107 a <- genFixedP p
108 pure $ zero * a == zero <?> show { precision, a }
109 quickCheck' 1000 do
110 precision <- chooseInt 0 10
111 unsafePartial fromJust $ reifyPrecision precision \p -> do
112 a <- genFixedP p
113 pure $ a * zero == zero <?> show { precision, a }
115 log ""
116 log "Parsing/printing"
117 log ""
119 log "An empty string parses Nothing"
120 quickCheck' 1
121 let x = fromString "" :: Maybe (Fixed P100)
122 in x === Nothing
124 log "Roundtrip: fromString <<< toString == Just"
125 quickCheck' 1000 do
126 precision <- chooseInt 0 100
127 unsafePartial fromJust $ reifyPrecision precision \p -> do
128 a <- genFixedP p
129 let b = fromString (toString a)
130 pure $ b == Just a <?> show { precision, a, b, numeratorA: numerator a, numeratorB: map numerator b }
132 log ""
133 log "Conversions to/from Number"
134 log ""
136 log "Roundtrip inaccuracy should be bounded by precision"
137 quickCheck' 1000 \x -> do
138 -- This is limited by the precision of Number
139 precision <- chooseInt 0 10
140 pure $ unsafePartial fromJust $ reifyPrecision precision \p -> do
141 -- Note: we use 0.5 here because these numbers should differ by no more
142 -- than half of the distance between two consecutive representable values
143 -- of the type `Fixed precision`.
144 let epsilon = 0.5 / BigInt.toNumber (reflectPrecision p)
145 case toNumber <$> fromNumberWith p x of
146 Just x' ->
147 (Math.abs (x' - x) <= epsilon)
148 <?> show { precision, epsilon, x, x' }
149 Nothing ->
150 false
151 <?> ("failed to roundtrip via Number: " <> show { precision, x })
153 log ""
154 log "rescale"
155 log ""
157 log "rescaling up then down should be no-op"
158 quickCheck' 1000 do
159 let lo = 10
160 hi <- chooseInt 10 20
161 unsafePartial fromJust $ join $
162 reifyPrecision lo \lo_ ->
163 reifyPrecision hi \hi_ -> do
164 x <- genFixedP lo_
165 let y = withPrecisionOf hi_ $ rescale x
166 let xx = rescale y
167 pure $ x == xx <?> show { x, xx, y }
169 log "rescaling down then up should be the same as truncating"
170 quickCheck' 1000 do
171 let hi = 20
172 lo <- chooseInt 10 20
173 unsafePartial fromJust $ join $
174 reifyPrecision lo \lo_ ->
175 reifyPrecision hi \hi_ -> do
176 x <- genFixedP hi_
177 let y = withPrecisionOf lo_ $ rescale x
178 let xx = truncateToPrecision lo x
179 pure $ xx == rescale y <?> show { x, xx, y }