aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/data')
-rw-r--r--stdlib/source/test/lux/data/bit.lux19
-rw-r--r--stdlib/source/test/lux/data/color.lux4
-rw-r--r--stdlib/source/test/lux/data/error.lux16
-rw-r--r--stdlib/source/test/lux/data/identity.lux14
-rw-r--r--stdlib/source/test/lux/data/lazy.lux17
-rw-r--r--stdlib/source/test/lux/data/maybe.lux17
-rw-r--r--stdlib/source/test/lux/data/name.lux9
-rw-r--r--stdlib/source/test/lux/data/number.lux185
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux373
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux60
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux144
-rw-r--r--stdlib/source/test/lux/data/number/int.lux55
-rw-r--r--stdlib/source/test/lux/data/number/nat.lux55
-rw-r--r--stdlib/source/test/lux/data/number/ratio.lux140
-rw-r--r--stdlib/source/test/lux/data/number/rev.lux55
15 files changed, 581 insertions, 582 deletions
diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux
index 48643c29b..2ae784312 100644
--- a/stdlib/source/test/lux/data/bit.lux
+++ b/stdlib/source/test/lux/data/bit.lux
@@ -6,8 +6,9 @@
[monad (#+ do)]
{[0 #test]
[/
- ["." equivalence]
- ["." codec]]}]
+ ["$." equivalence]
+ ["$." monoid]
+ ["$." codec]]}]
data/text/format
[math
["r" random]]]
@@ -20,6 +21,12 @@
(do r.monad
[value r.bit]
($_ _.and
+ ($equivalence.spec /.equivalence r.bit)
+ ($codec.spec /.equivalence /.codec r.bit)
+ (<| (_.context "Disjunction.")
+ ($monoid.spec /.equivalence /.disjunction r.bit))
+ (<| (_.context "Conjunction.")
+ ($monoid.spec /.equivalence /.conjunction r.bit))
(_.test "A value cannot be true and false at the same time."
(not (and value (not value))))
(_.test "A value must be either true or false at any time."
@@ -27,12 +34,4 @@
(_.test "Can create the complement of a predicate."
(and (not (:: /.equivalence = value ((/.complement function.identity) value)))
(:: /.equivalence = value ((/.complement not) value))))
- (equivalence.test /.equivalence r.bit)
- (codec.test /.codec /.equivalence r.bit)
- (_.test "Or/disjunction monoid."
- (and (not (:: /.or-monoid identity))
- (:: /.or-monoid compose value (not value))))
- (_.test "And/conjunction monoid."
- (and (:: /.and-monoid identity)
- (not (:: /.and-monoid compose value (not value)))))
))))
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index af16ef76e..f5ac95d90 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -5,7 +5,7 @@
[monad (#+ do)]
{[0 #test]
[/
- ["." equivalence]]}]
+ ["$." equivalence]]}]
[data
text/format
[number
@@ -65,7 +65,7 @@
(f/<= +0.75 saturation)))))))
ratio (|> r.frac (r.filter (f/>= +0.5)))]
($_ _.and
- (equivalence.test /.equivalence ..color)
+ ($equivalence.spec /.equivalence ..color)
(_.test "Can convert to/from HSL."
(|> any /.to-hsl /.from-hsl
(distance any)
diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux
index 1dbe1969e..58d37aef7 100644
--- a/stdlib/source/test/lux/data/error.lux
+++ b/stdlib/source/test/lux/data/error.lux
@@ -7,10 +7,10 @@
[monad (#+ do Monad)]
{[0 #test]
[/
- [".T" functor (#+ Injection Comparison)]
- [".T" apply]
- [".T" monad]
- [".T" equivalence]]}]
+ ["$." functor (#+ Injection Comparison)]
+ ["$." apply]
+ ["$." monad]
+ ["$." equivalence]]}]
[data
text/format
[number
@@ -39,10 +39,10 @@
Test
(<| (_.context (%name (name-of /.Error)))
($_ _.and
- (equivalenceT.test (/.equivalence nat.equivalence) (..error r.nat))
- (functorT.laws ..injection ..comparison /.functor)
- (applyT.laws ..injection ..comparison /.apply)
- (monadT.laws ..injection ..comparison /.monad)
+ ($equivalence.spec (/.equivalence nat.equivalence) (..error r.nat))
+ ($functor.spec ..injection ..comparison /.functor)
+ ($apply.spec ..injection ..comparison /.apply)
+ ($monad.spec ..injection ..comparison /.monad)
(do r.monad
[left r.nat
right r.nat
diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux
index aced82f84..ef4450c50 100644
--- a/stdlib/source/test/lux/data/identity.lux
+++ b/stdlib/source/test/lux/data/identity.lux
@@ -6,10 +6,9 @@
[monad (#+ do)]
{[0 #test]
[/
- [".T" functor (#+ Injection Comparison)]
- [".T" apply]
- [".T" monad]
- [".T" equivalence]]}]
+ ["$." functor (#+ Injection Comparison)]
+ ["$." apply]
+ ["$." monad]]}]
[data
["." text ("#@." monoid equivalence)
format]]]
@@ -29,9 +28,10 @@
Test
(<| (_.context (%name (name-of /.Identity)))
($_ _.and
- (functorT.laws ..injection ..comparison /.functor)
- (applyT.laws ..injection ..comparison /.apply)
- (monadT.laws ..injection ..comparison /.monad)
+ ($functor.spec ..injection ..comparison /.functor)
+ ($apply.spec ..injection ..comparison /.apply)
+ ($monad.spec ..injection ..comparison /.monad)
+
(let [(^open "/@.") /.comonad]
(_.test "CoMonad does not affect values."
(and (text@= "yololol" (/@unwrap "yololol"))
diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux
index 957ce0c34..44c0ff2da 100644
--- a/stdlib/source/test/lux/data/lazy.lux
+++ b/stdlib/source/test/lux/data/lazy.lux
@@ -5,10 +5,10 @@
[monad (#+ do)]
{[0 #test]
[/
- [".T" functor (#+ Injection Comparison)]
- [".T" apply]
- [".T" monad]
- [".T" equivalence]]}]
+ ["$." functor (#+ Injection Comparison)]
+ ["$." apply]
+ ["$." monad]
+ ["$." equivalence]]}]
[data
text/format
[number
@@ -40,6 +40,11 @@
#let [lazy (/.freeze (n/* left right))
expected (n/* left right)]]
($_ _.and
+ ($equivalence.spec (/.equivalence nat.equivalence) (..lazy r.nat))
+ ($functor.spec ..injection ..comparison /.functor)
+ ($apply.spec ..injection ..comparison /.apply)
+ ($monad.spec ..injection ..comparison /.monad)
+
(_.test "Freezing does not alter the expected value."
(n/= expected
(/.thaw lazy)))
@@ -48,8 +53,4 @@
(/.thaw lazy)))
(is? (/.thaw lazy)
(/.thaw lazy))))
- (equivalenceT.test (/.equivalence nat.equivalence) (..lazy r.nat))
- (functorT.laws ..injection ..comparison /.functor)
- (applyT.laws ..injection ..comparison /.apply)
- (monadT.laws ..injection ..comparison /.monad)
))))
diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux
index e2c0ce3fa..9b3a77ff9 100644
--- a/stdlib/source/test/lux/data/maybe.lux
+++ b/stdlib/source/test/lux/data/maybe.lux
@@ -6,10 +6,10 @@
[monad (#+ do)]
{[0 #test]
[/
- [".T" functor (#+ Injection Comparison)]
- [".T" apply]
- [".T" monad]
- [".T" equivalence]]}]
+ ["$." functor (#+ Injection Comparison)]
+ ["$." apply]
+ ["$." monad]
+ ["$." equivalence]]}]
[data
["." text
format]
@@ -38,10 +38,11 @@
Test
(<| (_.context (%name (name-of .Maybe)))
($_ _.and
- (equivalenceT.test (/.equivalence nat.equivalence) (..maybe r.nat))
- (functorT.laws ..injection ..comparison /.functor)
- (applyT.laws ..injection ..comparison /.apply)
- (monadT.laws ..injection ..comparison /.monad)
+ ($equivalence.spec (/.equivalence nat.equivalence) (..maybe r.nat))
+ ($functor.spec ..injection ..comparison /.functor)
+ ($apply.spec ..injection ..comparison /.apply)
+ ($monad.spec ..injection ..comparison /.monad)
+
(do r.monad
[left r.nat
right r.nat
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index 6582e68ff..a42684938 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -6,8 +6,8 @@
[monad (#+ do)]
{[0 #test]
[/
- [".T" equivalence]
- [".T" codec]]}]
+ ["$." equivalence]
+ ["$." codec]]}]
[data
["." text ("#@." equivalence)
format]]
@@ -38,8 +38,9 @@
sizeS2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
(^@ name2 [module2 short2]) (..name sizeM2 sizeS2)]
($_ _.and
- (equivalenceT.test /.equivalence (..name sizeM1 sizeS1))
- (codecT.test /.codec /.equivalence (..name sizeM1 sizeS1))
+ ($equivalence.spec /.equivalence (..name sizeM1 sizeS1))
+ ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1))
+
(_.test "Can get the module / short parts of an name."
(and (is? module1 (/.module name1))
(is? short1 (/.short name1))))
diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux
deleted file mode 100644
index 7b57ffc63..000000000
--- a/stdlib/source/test/lux/data/number.lux
+++ /dev/null
@@ -1,185 +0,0 @@
-(.module:
- [lux #*
- [control
- ["M" monad (#+ Monad do)]
- pipe]
- [data
- number
- ["." text ("#;." equivalence)
- format]]
- [math
- ["r" random]]]
- lux/test)
-
-(do-template [category rand-gen <Equivalence> <Order>]
- [(context: (format "[" category "] " "Equivalence & Order")
- (<| (times 100)
- (do @
- [x rand-gen
- y rand-gen]
- (test "" (and (:: <Equivalence> = x x)
- (or (:: <Equivalence> = x y)
- (:: <Order> < y x)
- (:: <Order> > y x)))))))]
-
- ["Nat" r.nat equivalence order]
- ["Int" r.int equivalence order]
- ["Rev" r.rev equivalence order]
- ["Frac" r.frac equivalence order]
- )
-
-(do-template [category rand-gen <Number> <Order>]
- [(context: (format "[" category "] " "Number")
- (<| (times 100)
- (do @
- [x rand-gen
- #let [(^open ".") <Number>
- (^open ".") <Order>]]
- (test "" (and (>= x (abs x))
- ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0
- (or (text;= "Frac" category)
- (not (= x (negate x))))
- (= x (negate (negate x)))
- ## There is loss of precision when multiplying
- (or (text;= "Rev" category)
- (= x (* (signum x)
- (abs x)))))))))]
-
- ["Nat" r.nat number order]
- ["Int" r.int number order]
- ["Rev" r.rev number order]
- ["Frac" r.frac number order]
- )
-
-(do-template [category rand-gen <Enum> <Number> <Order>]
- [(context: (format "[" category "] " "Enum")
- (<| (times 100)
- (do @
- [x rand-gen]
- (test "" (let [(^open ".") <Number>
- (^open ".") <Order>]
- (and (> x
- (:: <Enum> succ x))
- (< x
- (:: <Enum> pred x))
-
- (= x
- (|> x (:: <Enum> pred) (:: <Enum> succ)))
- (= x
- (|> x (:: <Enum> succ) (:: <Enum> pred)))
- ))))))]
-
- ["Nat" r.nat enum number order]
- ["Int" r.int enum number order]
- )
-
-(do-template [category rand-gen <Number> <Order> <Interval> <test>]
- [(context: (format "[" category "] " "Interval")
- (<| (times 100)
- (do @
- [x (|> rand-gen (r.filter <test>))
- #let [(^open ".") <Number>
- (^open ".") <Order>]]
- (test "" (and (<= x (:: <Interval> bottom))
- (>= x (:: <Interval> top)))))))]
-
- ["Nat" r.nat number order interval (function (_ _) #1)]
- ["Int" r.int number order interval (function (_ _) #1)]
- ## Both min and max values will be positive (thus, greater than zero)
- ["Rev" r.rev number order interval (function (_ _) #1)]
- ["Frac" r.frac number order interval (f/> +0.0)]
- )
-
-(do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>]
- [(context: (format "[" category "] " "Monoid")
- (<| (times 100)
- (do @
- [x (|> rand-gen (:: @ map (|>> (:: <Number> abs) <cap>)) (r.filter <test>))
- #let [(^open ".") <Number>
- (^open ".") <Order>
- (^open ".") <Monoid>]]
- (test "Composing with identity doesn't change the value."
- (and (= x (compose identity x))
- (= x (compose x identity))
- (= identity (compose identity identity)))))))]
-
- ["Nat/Add" r.nat number order add@monoid (n/% 1000) (function (_ _) #1)]
- ["Nat/Mul" r.nat number order mul@monoid (n/% 1000) (function (_ _) #1)]
- ["Nat/Min" r.nat number order min@monoid (n/% 1000) (function (_ _) #1)]
- ["Nat/Max" r.nat number order max@monoid (n/% 1000) (function (_ _) #1)]
- ["Int/Add" r.int number order add@monoid (i/% +1000) (function (_ _) #1)]
- ["Int/Mul" r.int number order mul@monoid (i/% +1000) (function (_ _) #1)]
- ["Int/Min" r.int number order min@monoid (i/% +1000) (function (_ _) #1)]
- ["Int/Max" r.int number order max@monoid (i/% +1000) (function (_ _) #1)]
- ["Rev/Add" r.rev number order add@monoid (r/% .125) (function (_ _) #1)]
- ["Rev/Mul" r.rev number order mul@monoid (r/% .125) (function (_ _) #1)]
- ["Rev/Min" r.rev number order min@monoid (r/% .125) (function (_ _) #1)]
- ["Rev/Max" r.rev number order max@monoid (r/% .125) (function (_ _) #1)]
- ["Frac/Add" r.frac number order add@monoid (f/% +1000.0) (f/> +0.0)]
- ["Frac/Mul" r.frac number order mul@monoid (f/% +1000.0) (f/> +0.0)]
- ["Frac/Min" r.frac number order min@monoid (f/% +1000.0) (f/> +0.0)]
- ["Frac/Max" r.frac number order max@monoid (f/% +1000.0) (f/> +0.0)]
- )
-
-(do-template [<category> <rand-gen> <Equivalence> <Codec>]
- [(context: (format "[" <category> "] " "Alternative formats")
- (<| (times 100)
- (do @
- [x <rand-gen>]
- (test "Can encode/decode values."
- (|> x
- (:: <Codec> encode)
- (:: <Codec> decode)
- (case> (#.Right x')
- (:: <Equivalence> = x x')
-
- (#.Left _)
- #0))))))]
-
- ["Nat/Binary" r.nat equivalence binary@codec]
- ["Nat/Octal" r.nat equivalence octal@codec]
- ["Nat/Decimal" r.nat equivalence codec]
- ["Nat/Hex" r.nat equivalence hex@codec]
-
- ["Int/Binary" r.int equivalence binary@codec]
- ["Int/Octal" r.int equivalence octal@codec]
- ["Int/Decimal" r.int equivalence codec]
- ["Int/Hex" r.int equivalence hex@codec]
-
- ["Rev/Binary" r.rev equivalence binary@codec]
- ["Rev/Octal" r.rev equivalence octal@codec]
- ["Rev/Decimal" r.rev equivalence codec]
- ["Rev/Hex" r.rev equivalence hex@codec]
-
- ["Frac/Binary" r.frac equivalence binary@codec]
- ["Frac/Octal" r.frac equivalence octal@codec]
- ["Frac/Decimal" r.frac equivalence codec]
- ["Frac/Hex" r.frac equivalence hex@codec]
- )
-
-(context: "Can convert frac values to/from their bit patterns."
- (<| (times 100)
- (do @
- [raw r.frac
- factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))
- #let [sample (|> factor .int int-to-frac (f/* raw))]]
- (test "Can convert frac values to/from their bit patterns."
- (|> sample frac-to-bits bits-to-frac (f/= sample))))))
-
-(context: "Macros for alternative numeric encodings."
- ($_ seq
- (test "Binary."
- (and (n/= (bin "11001001") (bin "11_00_10_01"))
- (i/= (bin "+11001001") (bin "+11_00_10_01"))
- (r/= (bin ".11001001") (bin ".11_00_10_01"))
- (f/= (bin "+1100.1001") (bin "+11_00.10_01"))))
- (test "Octal."
- (and (n/= (oct "615243") (oct "615_243"))
- (i/= (oct "+615243") (oct "+615_243"))
- (r/= (oct ".615243") (oct ".615_243"))
- (f/= (oct "+6152.43") (oct "+615_2.43"))))
- (test "Hexadecimal."
- (and (n/= (hex "deadBEEF") (hex "dead_BEEF"))
- (i/= (hex "+deadBEEF") (hex "+dead_BEEF"))
- (r/= (hex ".deadBEEF") (hex ".dead_BEEF"))
- (f/= (hex "+deadBE.EF") (hex "+dead_BE.EF"))))))
diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux
index 106edf33d..278e8ec58 100644
--- a/stdlib/source/test/lux/data/number/complex.lux
+++ b/stdlib/source/test/lux/data/number/complex.lux
@@ -1,202 +1,221 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
- pipe]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." codec]]}]
[data
- ["." number
- ["." frac ("#;." number)]
- ["&" complex]]
+ [number
+ ["." frac ("#@." number)]]
[collection
- ["." list ("#;." functor)]]]
+ ["." list ("#@." functor)]]]
["." math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Complex)]})
(def: margin-of-error Frac +1.0e-9)
(def: (within? margin standard value)
- (-> Frac &.Complex &.Complex Bit)
- (let [real-dist (frac;abs (f/- (get@ #&.real standard)
- (get@ #&.real value)))
- imgn-dist (frac;abs (f/- (get@ #&.imaginary standard)
- (get@ #&.imaginary value)))]
+ (-> Frac Complex Complex Bit)
+ (let [real-dist (frac@abs (f/- (get@ #/.real standard)
+ (get@ #/.real value)))
+ imgn-dist (frac@abs (f/- (get@ #/.imaginary standard)
+ (get@ #/.imaginary value)))]
(and (f/< margin real-dist)
(f/< margin imgn-dist))))
-(def: gen-dim
- (r.Random Frac)
+(def: dimension
+ (Random Frac)
(do r.monad
[factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))
measure (|> r.frac (r.filter (f/> +0.0)))]
(wrap (f/* (|> factor .int int-to-frac)
measure))))
-(def: gen-complex
- (r.Random &.Complex)
+(def: #export complex
+ (Random Complex)
(do r.monad
- [real gen-dim
- imaginary gen-dim]
- (wrap (&.complex real imaginary))))
-
-(context: "Construction"
- (<| (times 100)
- (do @
- [real gen-dim
- imaginary gen-dim]
- ($_ seq
- (test "Can build and tear apart complex numbers"
- (let [r+i (&.complex real imaginary)]
- (and (f/= real (get@ #&.real r+i))
- (f/= imaginary (get@ #&.imaginary r+i)))))
-
- (test "If either the real part or the imaginary part is NaN, the composite is NaN."
- (and (&.not-a-number? (&.complex number.not-a-number imaginary))
- (&.not-a-number? (&.complex real number.not-a-number))))
- ))))
-
-(context: "Absolute value"
- (<| (times 100)
- (do @
- [real gen-dim
- imaginary gen-dim]
- ($_ seq
- (test "Absolute value of complex >= absolute value of any of the parts."
- (let [r+i (&.complex real imaginary)
- abs (get@ #&.real (&.abs r+i))]
- (and (f/>= (frac;abs real) abs)
- (f/>= (frac;abs imaginary) abs))))
-
- (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
- (and (number.not-a-number? (get@ #&.real (&.abs (&.complex number.not-a-number imaginary))))
- (number.not-a-number? (get@ #&.real (&.abs (&.complex real number.not-a-number))))))
-
- (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
- (and (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.positive-infinity imaginary))))
- (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.positive-infinity))))
- (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.negative-infinity imaginary))))
- (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.negative-infinity))))))
- ))))
-
-(context: "Addidion, substraction, multiplication and division"
- (<| (times 100)
- (do @
- [x gen-complex
- y gen-complex
- factor gen-dim]
- ($_ seq
- (test "Adding 2 complex numbers is the same as adding their parts."
- (let [z (&.+ y x)]
- (and (&.= z
- (&.complex (f/+ (get@ #&.real y)
- (get@ #&.real x))
- (f/+ (get@ #&.imaginary y)
- (get@ #&.imaginary x)))))))
-
- (test "Subtracting 2 complex numbers is the same as adding their parts."
- (let [z (&.- y x)]
- (and (&.= z
- (&.complex (f/- (get@ #&.real y)
- (get@ #&.real x))
- (f/- (get@ #&.imaginary y)
- (get@ #&.imaginary x)))))))
-
- (test "Subtraction is the inverse of addition."
- (and (|> x (&.+ y) (&.- y) (within? margin-of-error x))
- (|> x (&.- y) (&.+ y) (within? margin-of-error x))))
-
- (test "Division is the inverse of multiplication."
- (|> x (&.* y) (&./ y) (within? margin-of-error x)))
-
- (test "Scalar division is the inverse of scalar multiplication."
- (|> x (&.*' factor) (&./' factor) (within? margin-of-error x)))
-
- (test "If you subtract the remainder, all divisions must be exact."
- (let [rem (&.% y x)
- quotient (|> x (&.- rem) (&./ y))
- floored (|> quotient
- (update@ #&.real math.floor)
- (update@ #&.imaginary math.floor))]
- (within? +0.000000000001
- x
- (|> quotient (&.* y) (&.+ rem)))))
- ))))
-
-(context: "Conjugate, reciprocal, signum, negation"
- (<| (times 100)
- (do @
- [x gen-complex]
- ($_ seq
- (test "Conjugate has same real part as original, and opposite of imaginary part."
- (let [cx (&.conjugate x)]
- (and (f/= (get@ #&.real x)
- (get@ #&.real cx))
- (f/= (frac;negate (get@ #&.imaginary x))
- (get@ #&.imaginary cx)))))
-
- (test "The reciprocal functions is its own inverse."
- (|> x &.reciprocal &.reciprocal (within? margin-of-error x)))
-
- (test "x*(x^-1) = 1"
- (|> x (&.* (&.reciprocal x)) (within? margin-of-error &.one)))
-
- (test "Absolute value of signum is always root2(2), 1 or 0."
- (let [signum-abs (|> x &.signum &.abs (get@ #&.real))]
- (or (f/= +0.0 signum-abs)
- (f/= +1.0 signum-abs)
- (f/= (math.pow +0.5 +2.0) signum-abs))))
-
- (test "Negation is its own inverse."
- (let [there (&.negate x)
- back-again (&.negate there)]
- (and (not (&.= there x))
- (&.= back-again x))))
-
- (test "Negation doesn't change the absolute value."
- (f/= (get@ #&.real (&.abs x))
- (get@ #&.real (&.abs (&.negate x)))))
- ))))
+ [real ..dimension
+ imaginary ..dimension]
+ (wrap (/.complex real imaginary))))
+
+(def: construction
+ Test
+ (do r.monad
+ [real ..dimension
+ imaginary ..dimension]
+ ($_ _.and
+ (_.test "Can build and tear apart complex numbers"
+ (let [r+i (/.complex real imaginary)]
+ (and (f/= real (get@ #/.real r+i))
+ (f/= imaginary (get@ #/.imaginary r+i)))))
+
+ (_.test "If either the real part or the imaginary part is NaN, the composite is NaN."
+ (and (/.not-a-number? (/.complex frac.not-a-number imaginary))
+ (/.not-a-number? (/.complex real frac.not-a-number))))
+ )))
+
+(def: absolute-value
+ Test
+ (do r.monad
+ [real ..dimension
+ imaginary ..dimension]
+ ($_ _.and
+ (_.test "Absolute value of complex >= absolute value of any of the parts."
+ (let [r+i (/.complex real imaginary)
+ abs (get@ #/.real (/.abs r+i))]
+ (and (f/>= (frac@abs real) abs)
+ (f/>= (frac@abs imaginary) abs))))
+
+ (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
+ (and (frac.not-a-number? (get@ #/.real (/.abs (/.complex frac.not-a-number imaginary))))
+ (frac.not-a-number? (get@ #/.real (/.abs (/.complex real frac.not-a-number))))))
+
+ (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
+ (and (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.positive-infinity imaginary))))
+ (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.positive-infinity))))
+ (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.negative-infinity imaginary))))
+ (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.negative-infinity))))))
+ )))
+
+(def: number
+ Test
+ (do r.monad
+ [x ..complex
+ y ..complex
+ factor ..dimension]
+ ($_ _.and
+ (_.test "Adding 2 complex numbers is the same as adding their parts."
+ (let [z (/.+ y x)]
+ (and (/.= z
+ (/.complex (f/+ (get@ #/.real y)
+ (get@ #/.real x))
+ (f/+ (get@ #/.imaginary y)
+ (get@ #/.imaginary x)))))))
+
+ (_.test "Subtracting 2 complex numbers is the same as adding their parts."
+ (let [z (/.- y x)]
+ (and (/.= z
+ (/.complex (f/- (get@ #/.real y)
+ (get@ #/.real x))
+ (f/- (get@ #/.imaginary y)
+ (get@ #/.imaginary x)))))))
+
+ (_.test "Subtraction is the inverse of addition."
+ (and (|> x (/.+ y) (/.- y) (within? margin-of-error x))
+ (|> x (/.- y) (/.+ y) (within? margin-of-error x))))
+
+ (_.test "Division is the inverse of multiplication."
+ (|> x (/.* y) (/./ y) (within? margin-of-error x)))
+
+ (_.test "Scalar division is the inverse of scalar multiplication."
+ (|> x (/.*' factor) (/./' factor) (within? margin-of-error x)))
+
+ (_.test "If you subtract the remainder, all divisions must be exact."
+ (let [rem (/.% y x)
+ quotient (|> x (/.- rem) (/./ y))
+ floored (|> quotient
+ (update@ #/.real math.floor)
+ (update@ #/.imaginary math.floor))]
+ (within? +0.000000000001
+ x
+ (|> quotient (/.* y) (/.+ rem)))))
+ )))
+
+(def: conjugate&reciprocal&signum&negation
+ Test
+ (do r.monad
+ [x ..complex]
+ ($_ _.and
+ (_.test "Conjugate has same real part as original, and opposite of imaginary part."
+ (let [cx (/.conjugate x)]
+ (and (f/= (get@ #/.real x)
+ (get@ #/.real cx))
+ (f/= (frac@negate (get@ #/.imaginary x))
+ (get@ #/.imaginary cx)))))
+
+ (_.test "The reciprocal functions is its own inverse."
+ (|> x /.reciprocal /.reciprocal (within? margin-of-error x)))
+
+ (_.test "x*(x^-1) = 1"
+ (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one)))
+
+ (_.test "Absolute value of signum is always root2(2), 1 or 0."
+ (let [signum-abs (|> x /.signum /.abs (get@ #/.real))]
+ (or (f/= +0.0 signum-abs)
+ (f/= +1.0 signum-abs)
+ (f/= (math.pow +0.5 +2.0) signum-abs))))
+
+ (_.test "Negation is its own inverse."
+ (let [there (/.negate x)
+ back-again (/.negate there)]
+ (and (not (/.= there x))
+ (/.= back-again x))))
+
+ (_.test "Negation doesn't change the absolute value."
+ (f/= (get@ #/.real (/.abs x))
+ (get@ #/.real (/.abs (/.negate x)))))
+ )))
(def: (trigonometric-symmetry forward backward angle)
- (-> (-> &.Complex &.Complex) (-> &.Complex &.Complex) &.Complex Bit)
+ (-> (-> Complex Complex) (-> Complex Complex) Complex Bit)
(let [normal (|> angle forward backward)]
(|> normal forward backward (within? margin-of-error normal))))
-(context: "Trigonometry"
- (<| (seed 17274883666004960943)
- ## (times 100)
- (do @
- [angle (|> gen-complex (:: @ map (|>> (update@ #&.real (f/% +1.0))
- (update@ #&.imaginary (f/% +1.0)))))]
- ($_ seq
- (test "Arc-sine is the inverse of sine."
- (trigonometric-symmetry &.sin &.asin angle))
-
- (test "Arc-cosine is the inverse of cosine."
- (trigonometric-symmetry &.cos &.acos angle))
-
- (test "Arc-tangent is the inverse of tangent."
- (trigonometric-symmetry &.tan &.atan angle))))))
-
-(context: "Power 2 and exponential/logarithm"
- (<| (times 100)
- (do @
- [x gen-complex]
- ($_ seq
- (test "Root 2 is inverse of power 2."
- (|> x (&.pow' +2.0) (&.pow' +0.5) (within? margin-of-error x)))
-
- (test "Logarithm is inverse of exponentiation."
- (|> x &.log &.exp (within? margin-of-error x)))
- ))))
-
-(context: "Complex roots"
- (<| (times 100)
- (do @
- [sample gen-complex
- degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))]
- (test "Can calculate the N roots for any complex number."
- (|> sample
- (&.roots degree)
- (list;map (&.pow' (|> degree .int int-to-frac)))
- (list.every? (within? margin-of-error sample)))))))
+(def: trigonometry
+ Test
+ (<| (_.seed 17274883666004960943)
+ (do r.monad
+ [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f/% +1.0))
+ (update@ #/.imaginary (f/% +1.0)))))]
+ ($_ _.and
+ (_.test "Arc-sine is the inverse of sine."
+ (trigonometric-symmetry /.sin /.asin angle))
+
+ (_.test "Arc-cosine is the inverse of cosine."
+ (trigonometric-symmetry /.cos /.acos angle))
+
+ (_.test "Arc-tangent is the inverse of tangent."
+ (trigonometric-symmetry /.tan /.atan angle))))))
+
+(def: exponentiation&logarithm
+ Test
+ (do r.monad
+ [x ..complex]
+ ($_ _.and
+ (_.test "Root 2 is inverse of power 2."
+ (|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x)))
+
+ (_.test "Logarithm is inverse of exponentiation."
+ (|> x /.log /.exp (within? margin-of-error x)))
+ )))
+
+(def: root
+ Test
+ (do r.monad
+ [sample ..complex
+ degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))]
+ (_.test "Can calculate the N roots for any complex number."
+ (|> sample
+ (/.roots degree)
+ (list@map (/.pow' (|> degree .int int-to-frac)))
+ (list.every? (within? margin-of-error sample))))))
+
+(def: #export test
+ Test
+ ($_ _.and
+ ..construction
+ ..absolute-value
+ ..number
+ ..conjugate&reciprocal&signum&negation
+ ..trigonometry
+ ..exponentiation&logarithm
+ ..root
+ ))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
new file mode 100644
index 000000000..319debddd
--- /dev/null
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -0,0 +1,60 @@
+(.module:
+ [lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ [control
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." enum]
+ ["$." interval]
+ ["$." monoid]
+ ["$." codec]]}]
+ [math
+ ["r" random]]]
+ {1
+ ["." /
+ //]})
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Frac)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence r.frac)
+ ($order.spec /.order r.frac)
+ ($number.spec /.order /.number r.frac)
+ ($enum.spec /.enum r.frac)
+ ($interval.spec /.interval r.frac)
+ (<| (_.context "Addition.")
+ ($monoid.spec /.equivalence /.addition r.frac))
+ (<| (_.context "Multiplication.")
+ ($monoid.spec /.equivalence /.multiplication r.frac))
+ (<| (_.context "Minimum.")
+ ($monoid.spec /.equivalence /.minimum r.frac))
+ (<| (_.context "Maximum.")
+ ($monoid.spec /.equivalence /.multiplication r.frac))
+ ## TODO: Uncomment ASAP
+ ## (<| (_.context "Binary.")
+ ## ($codec.spec /.equivalence /.binary r.frac))
+ ## (<| (_.context "Octal.")
+ ## ($codec.spec /.equivalence /.octal r.frac))
+ ## (<| (_.context "Decimal.")
+ ## ($codec.spec /.equivalence /.decimal r.frac))
+ ## (<| (_.context "Hexadecimal.")
+ ## ($codec.spec /.equivalence /.hex r.frac))
+
+ (_.test "Alternate notations."
+ (and (f/= (bin "+1100.1001")
+ (bin "+11,00.10,01"))
+ (f/= (oct "-6152.43")
+ (oct "-615,2.43"))
+ (f/= (hex "+deadBE.EF")
+ (hex "+dead,BE.EF"))))
+ (do r.monad
+ [sample r.frac]
+ (_.test "Can convert frac values to/from their bit patterns."
+ (|> sample /.frac-to-bits /.bits-to-frac (f/= sample))))
+ )))
diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux
index 62de5e56e..1eb207e19 100644
--- a/stdlib/source/test/lux/data/number/i64.lux
+++ b/stdlib/source/test/lux/data/number/i64.lux
@@ -1,75 +1,83 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- ["M" monad (#+ do Monad)]]
- [data
- [number #*
- ["&" i64]]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." monoid]]}]
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /
+ ["." // #_
+ ["#." nat]]]})
-(context: "Bitwise operations."
- (<| (times 100)
- (do @
- [pattern r.nat
- idx (:: @ map (n/% &.width) r.nat)]
- ($_ seq
- (test "Clearing and settings bits should alter the count."
- (and (n/= (dec (&.count (&.set idx pattern)))
- (&.count (&.clear idx pattern)))
- (|> (&.count pattern)
- (n/- (&.count (&.clear idx pattern)))
- (n/<= 1))
- (|> (&.count (&.set idx pattern))
- (n/- (&.count pattern))
- (n/<= 1))))
- (test "Can query whether a bit is set."
- (and (or (and (&.set? idx pattern)
- (not (&.set? idx (&.clear idx pattern))))
- (and (not (&.set? idx pattern))
- (&.set? idx (&.set idx pattern))))
+(def: #export test
+ Test
+ (do r.monad
+ [pattern r.nat
+ idx (:: @ map (n/% /.width) r.nat)]
+ ($_ _.and
+ ($monoid.spec //nat.equivalence /.disjunction r.nat)
+ ($monoid.spec //nat.equivalence /.conjunction r.nat)
+
+ (_.test "Clearing and settings bits should alter the count."
+ (and (n/= (dec (/.count (/.set idx pattern)))
+ (/.count (/.clear idx pattern)))
+ (|> (/.count pattern)
+ (n/- (/.count (/.clear idx pattern)))
+ (n/<= 1))
+ (|> (/.count (/.set idx pattern))
+ (n/- (/.count pattern))
+ (n/<= 1))))
+ (_.test "Can query whether a bit is set."
+ (and (or (and (/.set? idx pattern)
+ (not (/.set? idx (/.clear idx pattern))))
+ (and (not (/.set? idx pattern))
+ (/.set? idx (/.set idx pattern))))
- (or (and (&.set? idx pattern)
- (not (&.set? idx (&.flip idx pattern))))
- (and (not (&.set? idx pattern))
- (&.set? idx (&.flip idx pattern))))))
- (test "The negation of a bit pattern should have a complementary bit-count."
- (n/= &.width
- (n/+ (&.count pattern)
- (&.count (&.not pattern)))))
- (test "Can do simple binary logic."
- (and (n/= 0
- (&.and pattern
- (&.not pattern)))
- (n/= (&.not 0)
- (&.or pattern
- (&.not pattern)))
- (n/= (&.not 0)
- (&.xor pattern
- (&.not pattern)))
- (n/= 0
- (&.xor pattern
- pattern))))
- (test "rotate-left and rotate-right are inverses of one another."
- (and (|> pattern
- (&.rotate-left idx)
- (&.rotate-right idx)
- (n/= pattern))
- (|> pattern
- (&.rotate-right idx)
- (&.rotate-left idx)
- (n/= pattern))))
- (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged."
- (and (|> pattern
- (&.rotate-left &.width)
- (n/= pattern))
- (|> pattern
- (&.rotate-right &.width)
- (n/= pattern))))
- (test "Shift right respect the sign of ints."
- (let [value (.int pattern)]
- (if (i/< +0 value)
- (i/< +0 (&.arithmetic-right-shift idx value))
- (i/>= +0 (&.arithmetic-right-shift idx value)))))
- ))))
+ (or (and (/.set? idx pattern)
+ (not (/.set? idx (/.flip idx pattern))))
+ (and (not (/.set? idx pattern))
+ (/.set? idx (/.flip idx pattern))))))
+ (_.test "The negation of a bit pattern should have a complementary bit-count."
+ (n/= /.width
+ (n/+ (/.count pattern)
+ (/.count (/.not pattern)))))
+ (_.test "Can do simple binary logic."
+ (and (n/= 0
+ (/.and pattern
+ (/.not pattern)))
+ (n/= (/.not 0)
+ (/.or pattern
+ (/.not pattern)))
+ (n/= (/.not 0)
+ (/.xor pattern
+ (/.not pattern)))
+ (n/= 0
+ (/.xor pattern
+ pattern))))
+ (_.test "rotate-left and rotate-right are inverses of one another."
+ (and (|> pattern
+ (/.rotate-left idx)
+ (/.rotate-right idx)
+ (n/= pattern))
+ (|> pattern
+ (/.rotate-right idx)
+ (/.rotate-left idx)
+ (n/= pattern))))
+ (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged."
+ (and (|> pattern
+ (/.rotate-left /.width)
+ (n/= pattern))
+ (|> pattern
+ (/.rotate-right /.width)
+ (n/= pattern))))
+ (_.test "Shift right respect the sign of ints."
+ (let [value (.int pattern)]
+ (if (i/< +0 value)
+ (i/< +0 (/.arithmetic-right-shift idx value))
+ (i/>= +0 (/.arithmetic-right-shift idx value)))))
+ )))
diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux
new file mode 100644
index 000000000..e83571653
--- /dev/null
+++ b/stdlib/source/test/lux/data/number/int.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ [control
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." enum]
+ ["$." interval]
+ ["$." monoid]
+ ["$." codec]]}]
+ [math
+ ["r" random]]]
+ {1
+ ["." /
+ //]})
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Int)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence r.int)
+ ($order.spec /.order r.int)
+ ($number.spec /.order /.number r.int)
+ ($enum.spec /.enum r.int)
+ ($interval.spec /.interval r.int)
+ (<| (_.context "Addition.")
+ ($monoid.spec /.equivalence /.addition r.int))
+ (<| (_.context "Multiplication.")
+ ($monoid.spec /.equivalence /.multiplication r.int))
+ (<| (_.context "Minimum.")
+ ($monoid.spec /.equivalence /.minimum r.int))
+ (<| (_.context "Maximum.")
+ ($monoid.spec /.equivalence /.multiplication r.int))
+ (<| (_.context "Binary.")
+ ($codec.spec /.equivalence /.binary r.int))
+ (<| (_.context "Octal.")
+ ($codec.spec /.equivalence /.octal r.int))
+ (<| (_.context "Decimal.")
+ ($codec.spec /.equivalence /.decimal r.int))
+ (<| (_.context "Hexadecimal.")
+ ($codec.spec /.equivalence /.hex r.int))
+
+ (_.test "Alternate notations."
+ (and (i/= (bin "+11001001")
+ (bin "+11,00,10,01"))
+ (i/= (oct "-615243")
+ (oct "-615,243"))
+ (i/= (hex "+deadBEEF")
+ (hex "+dead,BEEF"))))
+ )))
diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux
new file mode 100644
index 000000000..e570de094
--- /dev/null
+++ b/stdlib/source/test/lux/data/number/nat.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ [control
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." enum]
+ ["$." interval]
+ ["$." monoid]
+ ["$." codec]]}]
+ [math
+ ["r" random]]]
+ {1
+ ["." /
+ //]})
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Nat)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence r.nat)
+ ($order.spec /.order r.nat)
+ ($number.spec /.order /.number r.nat)
+ ($enum.spec /.enum r.nat)
+ ($interval.spec /.interval r.nat)
+ (<| (_.context "Addition.")
+ ($monoid.spec /.equivalence /.addition r.nat))
+ (<| (_.context "Multiplication.")
+ ($monoid.spec /.equivalence /.multiplication r.nat))
+ (<| (_.context "Minimum.")
+ ($monoid.spec /.equivalence /.minimum r.nat))
+ (<| (_.context "Maximum.")
+ ($monoid.spec /.equivalence /.multiplication r.nat))
+ (<| (_.context "Binary.")
+ ($codec.spec /.equivalence /.binary r.nat))
+ (<| (_.context "Octal.")
+ ($codec.spec /.equivalence /.octal r.nat))
+ (<| (_.context "Decimal.")
+ ($codec.spec /.equivalence /.decimal r.nat))
+ (<| (_.context "Hexadecimal.")
+ ($codec.spec /.equivalence /.hex r.nat))
+
+ (_.test "Alternate notations."
+ (and (n/= (bin "11001001")
+ (bin "11,00,10,01"))
+ (n/= (oct "615243")
+ (oct "615,243"))
+ (n/= (hex "deadBEEF")
+ (hex "dead,BEEF"))))
+ )))
diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux
index a68e5abca..654c489c3 100644
--- a/stdlib/source/test/lux/data/number/ratio.lux
+++ b/stdlib/source/test/lux/data/number/ratio.lux
@@ -1,116 +1,46 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
- pipe]
- [data
- [number
- ["&" ratio ("&;." number)]]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." codec]]}]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Ratio)]})
-(def: gen-part
- (r.Random Nat)
+(def: part
+ (Random Nat)
(|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1)))))
-(def: gen-ratio
- (r.Random &.Ratio)
+(def: #export ratio
+ (Random Ratio)
(do r.monad
- [numerator gen-part
- denominator (|> gen-part
+ [numerator ..part
+ denominator (|> ..part
(r.filter (|>> (n/= 0) not))
(r.filter (|>> (n/= numerator) not)))]
- (wrap (&.ratio numerator denominator))))
+ (wrap (/.ratio numerator denominator))))
-(context: "Normalization"
- (<| (times 100)
- (do @
- [denom1 gen-part
- denom2 gen-part
- sample gen-ratio]
- ($_ seq
- (test "All zeroes are the same."
- (&.= (&.ratio 0 denom1)
- (&.ratio 0 denom2)))
-
- (test "All ratios are built normalized."
- (|> sample
- &.normalize
- ("lux in-module" "lux/data/number/ratio")
- (&.= sample)))
- ))))
-
-(context: "Arithmetic"
- (<| (times 100)
- (do @
- [x gen-ratio
- y gen-ratio
- #let [min (&.min x y)
- max (&.max x y)]]
- ($_ seq
- (test "Addition and subtraction are opposites."
- (and (|> max (&.- min) (&.+ min) (&.= max))
- (|> max (&.+ min) (&.- min) (&.= max))))
-
- (test "Multiplication and division are opposites."
- (and (|> max (&./ min) (&.* min) (&.= max))
- (|> max (&.* min) (&./ min) (&.= max))))
-
- (test "Modulus by a larger ratio doesn't change the value."
- (|> min (&.% max) (&.= min)))
-
- (test "Modulus by a smaller ratio results in a value smaller than the limit."
- (|> max (&.% min) (&.< min)))
-
- (test "Can get the remainder of a division."
- (let [remainder (&.% min max)
- multiple (&.- remainder max)
- factor (&./ min multiple)]
- (and (|> factor (get@ #&.denominator) (n/= 1))
- (|> factor (&.* min) (&.+ remainder) (&.= max)))))
- ))))
-
-(context: "Negation, absolute value and signum"
- (<| (times 100)
- (do @
- [sample gen-ratio]
- ($_ seq
- (test "Negation is it's own inverse."
- (let [there (&;negate sample)
- back-again (&;negate there)]
- (and (not (&.= there sample))
- (&.= back-again sample))))
-
- (test "All ratios are already at their absolute value."
- (|> sample &;abs (&.= sample)))
-
- (test "Signum is the identity."
- (|> sample (&.* (&;signum sample)) (&.= sample)))
- ))))
-
-(context: "Order"
- (<| (times 100)
- (do @
- [x gen-ratio
- y gen-ratio]
- ($_ seq
- (test "Can compare ratios."
- (and (or (&.<= y x)
- (&.> y x))
- (or (&.>= y x)
- (&.< y x))))
- ))))
-
-(context: "Codec"
- (<| (times 100)
- (do @
- [sample gen-ratio
- #let [(^open "&;.") &.codec]]
- (test "Can encode/decode ratios."
- (|> sample &;encode &;decode
- (case> (#.Right output)
- (&.= sample output)
-
- _
- #0))))))
+(def: #export test
+ Test
+ (do r.monad
+ [denom0 ..part
+ denom1 ..part]
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..ratio)
+ ($order.spec /.order ..ratio)
+ ($number.spec /.order /.number ..ratio)
+ ($codec.spec /.equivalence /.codec ..ratio)
+
+ (_.test "All zeroes are the same."
+ (let [(^open "/@.") /.equivalence]
+ (/@= (/.ratio 0 denom0)
+ (/.ratio 0 denom1))))
+ )))
diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux
new file mode 100644
index 000000000..427ce4edf
--- /dev/null
+++ b/stdlib/source/test/lux/data/number/rev.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ [control
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." order]
+ ["$." number]
+ ["$." enum]
+ ["$." interval]
+ ["$." monoid]
+ ["$." codec]]}]
+ [math
+ ["r" random]]]
+ {1
+ ["." /
+ //]})
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Rev)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence r.rev)
+ ($order.spec /.order r.rev)
+ ($number.spec /.order /.number r.rev)
+ ($enum.spec /.enum r.rev)
+ ($interval.spec /.interval r.rev)
+ (<| (_.context "Addition.")
+ ($monoid.spec /.equivalence /.addition r.rev))
+ (<| (_.context "Multiplication.")
+ ($monoid.spec /.equivalence /.multiplication r.rev))
+ (<| (_.context "Minimum.")
+ ($monoid.spec /.equivalence /.minimum r.rev))
+ (<| (_.context "Maximum.")
+ ($monoid.spec /.equivalence /.multiplication r.rev))
+ (<| (_.context "Binary.")
+ ($codec.spec /.equivalence /.binary r.rev))
+ (<| (_.context "Octal.")
+ ($codec.spec /.equivalence /.octal r.rev))
+ (<| (_.context "Decimal.")
+ ($codec.spec /.equivalence /.decimal r.rev))
+ (<| (_.context "Hexadecimal.")
+ ($codec.spec /.equivalence /.hex r.rev))
+
+ (_.test "Alternate notations."
+ (and (r/= (bin ".11001001")
+ (bin ".11,00,10,01"))
+ (r/= (oct ".615243")
+ (oct ".615,243"))
+ (r/= (hex ".deadBEEF")
+ (hex ".dead,BEEF"))))
+ )))