aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/math/logic/continuous.lux6
-rw-r--r--stdlib/source/test/lux.lux17
-rw-r--r--stdlib/source/test/lux/cli.lux112
-rw-r--r--stdlib/source/test/lux/data/bit.lux7
-rw-r--r--stdlib/source/test/lux/io.lux33
-rw-r--r--stdlib/source/test/lux/math.lux184
-rw-r--r--stdlib/source/test/lux/math/infix.lux42
-rw-r--r--stdlib/source/test/lux/math/logic/continuous.lux55
-rw-r--r--stdlib/source/test/lux/math/logic/fuzzy.lux267
-rw-r--r--stdlib/source/test/lux/math/modular.lux169
-rw-r--r--stdlib/source/test/lux/math/random.lux49
11 files changed, 445 insertions, 496 deletions
diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux
index 33b93f9ae..453761aea 100644
--- a/stdlib/source/lux/math/logic/continuous.lux
+++ b/stdlib/source/lux/math/logic/continuous.lux
@@ -2,10 +2,10 @@
[lux (#- false true or and not)
[data
[number
- ["." rev ("#;." interval)]]]])
+ ["." rev ("#@." interval)]]]])
-(def: #export true Rev rev;top)
-(def: #export false Rev rev;bottom)
+(def: #export true Rev rev@top)
+(def: #export false Rev rev@bottom)
(do-template [<name> <chooser>]
[(def: #export <name>
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 781f3edde..196213c54 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -31,6 +31,8 @@
[data
[text
[format (#+)]]]
+ ## [math
+ ## [random (#+)]]
## TODO: Test these modules
[data
[format
@@ -114,18 +116,13 @@
["#." control]
["#." data]
["#." time]
+ ["#." math]
["#." host
["#/." jvm]]]
## [control
## [concurrency
## ## [semaphore (#+)]
## ]]
- ## [math (#+)
- ## [random (#+)]
- ## [modular (#+)]
- ## [logic
- ## [continuous (#+)]
- ## [fuzzy (#+)]]]
## [macro
## [code (#+)]
## [syntax (#+)]
@@ -373,16 +370,16 @@
..template)
(<| (_.context "Cross-platform support.")
..cross-platform-support)
- (<| (_.context "/cli Command-Line Interface.")
- /cli.test)
- (<| (_.context "/io I/O (input/output)")
- /io.test)
+ /cli.test
+ /io.test
(<| (_.context "/control")
/control.test)
(<| (_.context "/data")
/data.test)
(<| (_.context "/time")
/time.test)
+ (<| (_.context "/math")
+ /math.test)
(<| (_.context "/host Host-platform interoperation")
($_ _.and
/host.test
diff --git a/stdlib/source/test/lux/cli.lux b/stdlib/source/test/lux/cli.lux
index c59c47faf..361b447ee 100644
--- a/stdlib/source/test/lux/cli.lux
+++ b/stdlib/source/test/lux/cli.lux
@@ -1,5 +1,8 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ ["r" math/random]
[control
["M" monad (#+ Monad do)]
pipe
@@ -8,68 +11,65 @@
["." error]
[number
["." nat ("#;." decimal)]]
- ["." text ("#;." equivalence)
- format]
+ ["." text ("#;." equivalence)]
[collection
- ["." list]]]
- [math
- ["r" random]]
- ["_" test (#+ Test)]]
+ ["." list]]]]
{1
["." /]})
(def: #export test
Test
- (do r.monad
- [num-args (|> r.nat (:: @ map (n/% 10)))
- #let [gen-arg (:: @ map nat;encode r.nat)]
- yes gen-arg
- #let [gen-ignore (r.filter (|>> (text;= yes) not)
- (r.unicode 5))]
- no gen-ignore
- pre-ignore (r.list 5 gen-ignore)
- post-ignore (r.list 5 gen-ignore)]
- ($_ _.and
- (_.test "Can read any argument."
- (|> (/.run (list yes) /.any)
- (case> (#error.Failure _)
- #0
-
- (#error.Success arg)
- (text;= arg yes))))
- (_.test "Can test tokens."
- (and (|> (/.run (list yes) (/.this yes))
- (case> (#error.Failure _)
- #0
+ (<| (_.context (%name (name-of /.CLI)))
+ (do r.monad
+ [num-args (|> r.nat (:: @ map (n/% 10)))
+ #let [gen-arg (:: @ map nat;encode r.nat)]
+ yes gen-arg
+ #let [gen-ignore (r.filter (|>> (text;= yes) not)
+ (r.unicode 5))]
+ no gen-ignore
+ pre-ignore (r.list 5 gen-ignore)
+ post-ignore (r.list 5 gen-ignore)]
+ ($_ _.and
+ (_.test "Can read any argument."
+ (|> (/.run (list yes) /.any)
+ (case> (#error.Failure _)
+ #0
+
+ (#error.Success arg)
+ (text;= arg yes))))
+ (_.test "Can test tokens."
+ (and (|> (/.run (list yes) (/.this yes))
+ (case> (#error.Failure _)
+ #0
- (#error.Success _)
- #1))
- (|> (/.run (list no) (/.this yes))
- (case> (#error.Failure _)
- #1
+ (#error.Success _)
+ #1))
+ (|> (/.run (list no) (/.this yes))
+ (case> (#error.Failure _)
+ #1
- (#error.Success _)
- #0))))
- (_.test "Can use custom token parsers."
- (|> (/.run (list yes) (/.parse nat;decode))
- (case> (#error.Failure _)
- #0
-
- (#error.Success parsed)
- (text;= (nat;encode parsed)
- yes))))
- (_.test "Can query if there are any more inputs."
- (and (|> (/.run (list) /.end)
- (case> (#error.Success []) #1 _ #0))
- (|> (/.run (list yes) (p.not /.end))
- (case> (#error.Success []) #0 _ #1))))
- (_.test "Can parse CLI input anywhere."
- (|> (/.run (list.concat (list pre-ignore (list yes) post-ignore))
- (|> (/.somewhere (/.this yes))
- (p.before (p.some /.any))))
- (case> (#error.Failure _)
- #0
+ (#error.Success _)
+ #0))))
+ (_.test "Can use custom token parsers."
+ (|> (/.run (list yes) (/.parse nat;decode))
+ (case> (#error.Failure _)
+ #0
+
+ (#error.Success parsed)
+ (text;= (nat;encode parsed)
+ yes))))
+ (_.test "Can query if there are any more inputs."
+ (and (|> (/.run (list) /.end)
+ (case> (#error.Success []) #1 _ #0))
+ (|> (/.run (list yes) (p.not /.end))
+ (case> (#error.Success []) #0 _ #1))))
+ (_.test "Can parse CLI input anywhere."
+ (|> (/.run (list.concat (list pre-ignore (list yes) post-ignore))
+ (|> (/.somewhere (/.this yes))
+ (p.before (p.some /.any))))
+ (case> (#error.Failure _)
+ #0
- (#error.Success _)
- #1)))
- )))
+ (#error.Success _)
+ #1)))
+ ))))
diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux
index 2ae784312..f6ad5e727 100644
--- a/stdlib/source/test/lux/data/bit.lux
+++ b/stdlib/source/test/lux/data/bit.lux
@@ -1,6 +1,8 @@
(.module:
[lux #*
+ data/text/format
["_" test (#+ Test)]
+ ["r" math/random]
["." function]
[control
[monad (#+ do)]
@@ -8,10 +10,7 @@
[/
["$." equivalence]
["$." monoid]
- ["$." codec]]}]
- data/text/format
- [math
- ["r" random]]]
+ ["$." codec]]}]]
{1
["." /]})
diff --git a/stdlib/source/test/lux/io.lux b/stdlib/source/test/lux/io.lux
index 5dd4bfe8d..504c9bb9c 100644
--- a/stdlib/source/test/lux/io.lux
+++ b/stdlib/source/test/lux/io.lux
@@ -1,5 +1,8 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ ["r" math/random]
[control
[monad (#+ do)]
{[0 #test]
@@ -7,10 +10,7 @@
["$." functor (#+ Injection Comparison)]
["$." apply]
["$." monad]]}]
- ["." function]
- [math
- ["r" random]]
- ["_" test (#+ Test)]]
+ ["." function]]
{1
["." / (#+ IO)]})
@@ -25,16 +25,17 @@
(def: #export test
Test
- (do r.monad
- [sample r.nat
- exit-code r.int]
- ($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (<| (_.context (%name (name-of /.IO)))
+ (do r.monad
+ [sample r.nat
+ exit-code r.int]
+ ($_ _.and
+ ($functor.spec ..injection ..comparison /.functor)
+ ($apply.spec ..injection ..comparison /.apply)
+ ($monad.spec ..injection ..comparison /.monad)
- (_.test "Can execute computations designated as I/O computations."
- (n/= sample (/.run (/.io sample))))
- (_.test "I/O operations won't execute unless they are explicitly run."
- (exec (/.exit exit-code)
- true)))))
+ (_.test "Can execute computations designated as I/O computations."
+ (n/= sample (/.run (/.io sample))))
+ (_.test "I/O operations won't execute unless they are explicitly run."
+ (exec (/.exit exit-code)
+ true))))))
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index 8b95691f6..79143b815 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -1,20 +1,27 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ ["r" math/random]
[control
[monad (#+ Monad do)]]
[data
- ["." bit ("#;." equivalence)]
+ ["." bit ("#@." equivalence)]
[number
- ["." frac ("#;." number)]]]
- ["&" math
- infix
- ["r" random]]]
- lux/test)
+ ["." frac ("#@." number)]]]]
+ {1
+ ["." /]}
+ ["." / #_
+ ["#." infix]
+ ["#." modular]
+ ["#." logic #_
+ ["#/." continuous]
+ ["#/." fuzzy]]])
(def: (within? margin-of-error standard value)
(-> Frac Frac Frac Bit)
(f/< margin-of-error
- (frac;abs (f/- standard value))))
+ (frac@abs (f/- standard value))))
(def: margin Frac +0.0000001)
@@ -23,104 +30,65 @@
(let [normal (|> angle forward backward)]
(|> normal forward backward (within? margin normal))))
-(context: "Trigonometry"
- (<| (times 100)
- (do @
- [angle (|> r.frac (:: @ map (f/* &.tau)))]
- ($_ seq
- (test "Sine and arc-sine are inverse functions."
- (trigonometric-symmetry &.sin &.asin angle))
-
- (test "Cosine and arc-cosine are inverse functions."
- (trigonometric-symmetry &.cos &.acos angle))
-
- (test "Tangent and arc-tangent are inverse functions."
- (trigonometric-symmetry &.tan &.atan angle))
- ))))
-
-(context: "Rounding"
- (<| (times 100)
- (do @
- [sample (|> r.frac (:: @ map (f/* +1000.0)))]
- ($_ seq
- (test "The ceiling will be an integer value, and will be >= the original."
- (let [ceil'd (&.ceil sample)]
- (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd))
- (f/>= sample ceil'd)
- (f/<= +1.0 (f/- sample ceil'd)))))
-
- (test "The floor will be an integer value, and will be <= the original."
- (let [floor'd (&.floor sample)]
- (and (|> floor'd frac-to-int int-to-frac (f/= floor'd))
- (f/<= sample floor'd)
- (f/<= +1.0 (f/- floor'd sample)))))
-
- (test "The round will be an integer value, and will be < or > or = the original."
- (let [round'd (&.round sample)]
- (and (|> round'd frac-to-int int-to-frac (f/= round'd))
- (f/<= +1.0 (frac;abs (f/- sample round'd))))))
- ))))
-
-(context: "Exponentials and logarithms"
- (<| (times 100)
- (do @
- [sample (|> r.frac (:: @ map (f/* +10.0)))]
- (test "Logarithm is the inverse of exponential."
- (|> sample &.exp &.log (within? +1.0e-15 sample))))))
-
-(context: "Greatest-Common-Divisor and Least-Common-Multiple"
- (<| (times 100)
- (do @
- [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))]
- x gen-nat
- y gen-nat]
- ($_ seq
- (test "GCD"
- (let [gcd (&.n/gcd x y)]
- (and (n/= 0 (n/% gcd x))
- (n/= 0 (n/% gcd y))
- (n/>= 1 gcd))))
-
- (test "LCM"
- (let [lcm (&.n/lcm x y)]
- (and (n/= 0 (n/% x lcm))
- (n/= 0 (n/% y lcm))
- (n/<= (n/* x y) lcm))))
- ))))
-
-(context: "Infix syntax"
- (<| (times 100)
- (do @
- [x r.nat
- y r.nat
- z r.nat
- theta r.frac
- #let [top (|> x (n/max y) (n/max z))
- bottom (|> x (n/min y) (n/min z))]]
- ($_ seq
- (test "Constant values don't change."
- (n/= x
- (infix x)))
-
- (test "Can call binary functions."
- (n/= (&.n/gcd y x)
- (infix [x &.n/gcd y])))
-
- (test "Can call unary functions."
- (f/= (&.sin theta)
- (infix [&.sin theta])))
-
- (test "Can use regular syntax in the middle of infix code."
- (n/= (&.n/gcd 450 (n/* 3 9))
- (infix [(n/* 3 9) &.n/gcd 450])))
-
- (test "Can use non-numerical functions/macros as operators."
- (bit;= (and (n/< y x) (n/< z y))
- (infix [[x n/< y] and [y n/< z]])))
-
- (test "Can combine bit operations in special ways via special keywords."
- (and (bit;= (and (n/< y x) (n/< z y))
- (infix [#and x n/< y n/< z]))
- (bit;= (and (n/< y x) (n/> z y))
- (infix [#and x n/< y n/> z]))))
- ))))
+(def: #export test
+ Test
+ ($_ _.and
+ (<| (_.context "Trigonometry")
+ (do r.monad
+ [angle (|> r.frac (:: @ map (f/* /.tau)))]
+ ($_ _.and
+ (_.test "Sine and arc-sine are inverse functions."
+ (trigonometric-symmetry /.sin /.asin angle))
+ (_.test "Cosine and arc-cosine are inverse functions."
+ (trigonometric-symmetry /.cos /.acos angle))
+ (_.test "Tangent and arc-tangent are inverse functions."
+ (trigonometric-symmetry /.tan /.atan angle))
+ )))
+ (<| (_.context "Rounding")
+ (do r.monad
+ [sample (|> r.frac (:: @ map (f/* +1000.0)))]
+ ($_ _.and
+ (_.test "The ceiling will be an integer value, and will be >= the original."
+ (let [ceil'd (/.ceil sample)]
+ (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd))
+ (f/>= sample ceil'd)
+ (f/<= +1.0 (f/- sample ceil'd)))))
+ (_.test "The floor will be an integer value, and will be <= the original."
+ (let [floor'd (/.floor sample)]
+ (and (|> floor'd frac-to-int int-to-frac (f/= floor'd))
+ (f/<= sample floor'd)
+ (f/<= +1.0 (f/- floor'd sample)))))
+ (_.test "The round will be an integer value, and will be < or > or = the original."
+ (let [round'd (/.round sample)]
+ (and (|> round'd frac-to-int int-to-frac (f/= round'd))
+ (f/<= +1.0 (frac@abs (f/- sample round'd))))))
+ )))
+ (<| (_.context "Exponentials and logarithms")
+ (do r.monad
+ [sample (|> r.frac (:: @ map (f/* +10.0)))]
+ (_.test "Logarithm is the inverse of exponential."
+ (|> sample /.exp /.log (within? +1.0e-15 sample)))))
+ (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple")
+ (do r.monad
+ [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))]
+ x gen-nat
+ y gen-nat]
+ ($_ _.and
+ (_.test "GCD"
+ (let [gcd (/.n/gcd x y)]
+ (and (n/= 0 (n/% gcd x))
+ (n/= 0 (n/% gcd y))
+ (n/>= 1 gcd))))
+
+ (_.test "LCM"
+ (let [lcm (/.n/lcm x y)]
+ (and (n/= 0 (n/% x lcm))
+ (n/= 0 (n/% y lcm))
+ (n/<= (n/* x y) lcm))))
+ )))
+
+ /infix.test
+ /modular.test
+ /logic/continuous.test
+ /logic/fuzzy.test
+ ))
diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux
new file mode 100644
index 000000000..59a44022a
--- /dev/null
+++ b/stdlib/source/test/lux/math/infix.lux
@@ -0,0 +1,42 @@
+(.module:
+ [lux #*
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random]
+ ["_" test (#+ Test)]
+ [data
+ ["." bit ("#@." equivalence)]]]
+ {1
+ ["." /
+ ["." //]]})
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.infix)))
+ (do r.monad
+ [subject r.nat
+ parameter r.nat
+ extra r.nat
+ angle r.frac]
+ ($_ _.and
+ (_.test "Constant values don't change."
+ (n/= subject
+ (/.infix subject)))
+ (_.test "Can call binary functions."
+ (n/= (//.n/gcd parameter subject)
+ (/.infix [subject //.n/gcd parameter])))
+ (_.test "Can call unary functions."
+ (f/= (//.sin angle)
+ (/.infix [//.sin angle])))
+ (_.test "Can use regular syntax in the middle of infix code."
+ (n/= (//.n/gcd extra (n/* parameter subject))
+ (/.infix [(n/* parameter subject) //.n/gcd extra])))
+ (_.test "Can use non-numerical functions/macros as operators."
+ (bit@= (and (n/< parameter subject) (n/< extra parameter))
+ (/.infix [[subject n/< parameter] and [parameter n/< extra]])))
+ (_.test "Can combine bit operations in special ways via special keywords."
+ (and (bit@= (and (n/< parameter subject) (n/< extra parameter))
+ (/.infix [#and subject n/< parameter n/< extra]))
+ (bit@= (and (n/< parameter subject) (n/> extra parameter))
+ (/.infix [#and subject n/< parameter n/> extra]))))
+ ))))
diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux
index b9db253f6..214a3c041 100644
--- a/stdlib/source/test/lux/math/logic/continuous.lux
+++ b/stdlib/source/test/lux/math/logic/continuous.lux
@@ -1,35 +1,32 @@
(.module:
[lux #*
- [control
- [monad (#+ do)]]
- [math
- ["r" random]
- [logic
- ["&" continuous]]]]
- lux/test)
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random]
+ ["_" test (#+ Test)]]
+ {1
+ ["." /]})
-(context: "Operations"
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
[left r.rev
right r.rev]
- ($_ seq
- (test "AND is the minimum."
- (let [result (&.and left right)]
- (and (r/<= left result)
- (r/<= right result))))
-
- (test "OR is the maximum."
- (let [result (&.or left right)]
- (and (r/>= left result)
- (r/>= right result))))
-
- (test "Double negation results in the original value."
- (r/= left (&.not (&.not left))))
-
- (test "Every value is equivalent to itself."
- (and (r/>= left
- (&.= left left))
- (r/>= right
- (&.= right right))))
+ ($_ _.and
+ (_.test "AND is the minimum."
+ (let [result (/.and left right)]
+ (and (r/<= left result)
+ (r/<= right result))))
+ (_.test "OR is the maximum."
+ (let [result (/.or left right)]
+ (and (r/>= left result)
+ (r/>= right result))))
+ (_.test "Double negation results in the original value."
+ (r/= left (/.not (/.not left))))
+ (_.test "Every value is equivalent to itself."
+ (and (r/>= left
+ (/.= left left))
+ (r/>= right
+ (/.= right right))))
))))
diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux
index aaacd32ef..c74540bd9 100644
--- a/stdlib/source/test/lux/math/logic/fuzzy.lux
+++ b/stdlib/source/test/lux/math/logic/fuzzy.lux
@@ -1,26 +1,27 @@
(.module:
[lux #*
- [control
- [monad (#+ do Monad)]]
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[data
- ["." bit ("#;." equivalence)]
- ["." number]
- [text
- format]
+ ["." bit ("#@." equivalence)]
+ [number
+ ["." nat]
+ ["." rev]]
[collection
["." list]
- ["." set]]]
- [math
- ["r" random]
- [logic
- ["&" fuzzy]
- ["_" continuous]]]]
- lux/test)
-
-(do-template [<desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>]
- [(context: (format "[" <desc> "] " "Triangles")
- (<| (times 100)
- (do @
+ ["." set]]]]
+ {1
+ ["." / (#+ Fuzzy)
+ [//
+ ["//" continuous]]]})
+
+(do-template [<name> <desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>]
+ [(def: <name>
+ Test
+ (<| (_.context (%name (name-of <triangle>)))
+ (do r.monad
[values (r.set <hash> 3 <gen>)
#let [[x y z] (case (set.to-list values)
(^ (list x y z))
@@ -36,32 +37,30 @@
_
(undefined))
triangle (<triangle> x y z)]]
- ($_ seq
- (test "The middle value will always have maximum membership."
- (r/= _.true (&.membership middle triangle)))
-
- (test "Boundary values will always have 0 membership."
- (and (r/= _.false (&.membership bottom triangle))
- (r/= _.false (&.membership top triangle))))
-
- (test "Values within range, will have membership > 0."
- (bit;= (r/> _.false (&.membership sample triangle))
- (and (<gt> bottom sample)
- (<lt> top sample))))
-
- (test "Values outside of range, will have membership = 0."
- (bit;= (r/= _.false (&.membership sample triangle))
- (or (<lte> bottom sample)
- (<gte> top sample))))
+ ($_ _.and
+ (_.test "The middle value will always have maximum membership."
+ (r/= //.true (/.membership middle triangle)))
+ (_.test "Boundary values will always have 0 membership."
+ (and (r/= //.false (/.membership bottom triangle))
+ (r/= //.false (/.membership top triangle))))
+ (_.test "Values within range, will have membership > 0."
+ (bit@= (r/> //.false (/.membership sample triangle))
+ (and (<gt> bottom sample)
+ (<lt> top sample))))
+ (_.test "Values outside of range, will have membership = 0."
+ (bit@= (r/= //.false (/.membership sample triangle))
+ (or (<lte> bottom sample)
+ (<gte> top sample))))
))))]
- ["Rev" number.hash r.rev &.triangle r/< r/<= r/> r/>=]
+ [rev-triangles "Rev" rev.hash r.rev /.triangle r/< r/<= r/> r/>=]
)
-(do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
- [(context: (format "[" <desc> "] " "Trapezoids")
- (<| (times 100)
- (do @
+(do-template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
+ [(def: <name>
+ Test
+ (<| (_.context (%name (name-of <trapezoid>)))
+ (do r.monad
[values (r.set <hash> 4 <gen>)
#let [[w x y z] (case (set.to-list values)
(^ (list w x y z))
@@ -77,107 +76,113 @@
_
(undefined))
trapezoid (<trapezoid> w x y z)]]
- ($_ seq
- (test "The middle values will always have maximum membership."
- (and (r/= _.true (&.membership middle-bottom trapezoid))
- (r/= _.true (&.membership middle-top trapezoid))))
-
- (test "Boundary values will always have 0 membership."
- (and (r/= _.false (&.membership bottom trapezoid))
- (r/= _.false (&.membership top trapezoid))))
-
- (test "Values within inner range will have membership = 1"
- (bit;= (r/= _.true (&.membership sample trapezoid))
- (and (<gte> middle-bottom sample)
- (<lte> middle-top sample))))
-
- (test "Values within range, will have membership > 0."
- (bit;= (r/> _.false (&.membership sample trapezoid))
- (and (<gt> bottom sample)
- (<lt> top sample))))
-
- (test "Values outside of range, will have membership = 0."
- (bit;= (r/= _.false (&.membership sample trapezoid))
- (or (<lte> bottom sample)
- (<gte> top sample))))
+ ($_ _.and
+ (_.test "The middle values will always have maximum membership."
+ (and (r/= //.true (/.membership middle-bottom trapezoid))
+ (r/= //.true (/.membership middle-top trapezoid))))
+ (_.test "Boundary values will always have 0 membership."
+ (and (r/= //.false (/.membership bottom trapezoid))
+ (r/= //.false (/.membership top trapezoid))))
+ (_.test "Values within inner range will have membership = 1"
+ (bit@= (r/= //.true (/.membership sample trapezoid))
+ (and (<gte> middle-bottom sample)
+ (<lte> middle-top sample))))
+ (_.test "Values within range, will have membership > 0."
+ (bit@= (r/> //.false (/.membership sample trapezoid))
+ (and (<gt> bottom sample)
+ (<lt> top sample))))
+ (_.test "Values outside of range, will have membership = 0."
+ (bit@= (r/= //.false (/.membership sample trapezoid))
+ (or (<lte> bottom sample)
+ (<gte> top sample))))
))))]
- ["Rev" number.hash r.rev &.trapezoid r/< r/<= r/> r/>=]
+ [rev-trapezoids "Rev" rev.hash r.rev /.trapezoid r/< r/<= r/> r/>=]
)
-(def: gen-triangle
- (r.Random (&.Fuzzy Rev))
+(def: #export triangle
+ (Random (Fuzzy Rev))
(do r.monad
[x r.rev
y r.rev
z r.rev]
- (wrap (&.triangle x y z))))
-
-(context: "Combinators"
- (<| (times 100)
- (do @
- [left gen-triangle
- right gen-triangle
+ (wrap (/.triangle x y z))))
+
+(def: combinators
+ Test
+ (<| (_.context "Combinators")
+ (do r.monad
+ [left ..triangle
+ right ..triangle
sample r.rev]
- ($_ seq
- (test "Union membership as as high as membership in any of its members."
- (let [combined (&.union left right)
- combined-membership (&.membership sample combined)]
- (and (r/>= (&.membership sample left)
- combined-membership)
- (r/>= (&.membership sample right)
- combined-membership))))
-
- (test "Intersection membership as as low as membership in any of its members."
- (let [combined (&.intersection left right)
- combined-membership (&.membership sample combined)]
- (and (r/<= (&.membership sample left)
- combined-membership)
- (r/<= (&.membership sample right)
- combined-membership))))
-
- (test "Complement membership is the opposite of normal membership."
- (r/= (&.membership sample left)
- (_.not (&.membership sample (&.complement left)))))
-
- (test "Membership in the difference will never be higher than in the set being subtracted."
- (bit;= (r/> (&.membership sample right)
- (&.membership sample left))
- (r/< (&.membership sample left)
- (&.membership sample (&.difference left right)))))
+ ($_ _.and
+ (_.test "Union membership as as high as membership in any of its members."
+ (let [combined (/.union left right)
+ combined-membership (/.membership sample combined)]
+ (and (r/>= (/.membership sample left)
+ combined-membership)
+ (r/>= (/.membership sample right)
+ combined-membership))))
+ (_.test "Intersection membership as as low as membership in any of its members."
+ (let [combined (/.intersection left right)
+ combined-membership (/.membership sample combined)]
+ (and (r/<= (/.membership sample left)
+ combined-membership)
+ (r/<= (/.membership sample right)
+ combined-membership))))
+ (_.test "Complement membership is the opposite of normal membership."
+ (r/= (/.membership sample left)
+ (//.not (/.membership sample (/.complement left)))))
+ (_.test "Membership in the difference will never be higher than in the set being subtracted."
+ (bit@= (r/> (/.membership sample right)
+ (/.membership sample left))
+ (r/< (/.membership sample left)
+ (/.membership sample (/.difference left right)))))
))))
-(context: "From predicates and sets"
- (<| (times 100)
- (do @
- [#let [set-10 (set.from-list number.hash (list.n/range 0 10))]
- sample (|> r.nat (:: @ map (n/% 20)))]
- ($_ seq
- (test (format "Values that satisfy a predicate have membership = 1."
- "Values that don't have membership = 0.")
- (bit;= (r/= _.true (&.membership sample (&.from-predicate n/even?)))
- (n/even? sample)))
-
- (test (format "Values that belong to a set have membership = 1."
- "Values that don't have membership = 0.")
- (bit;= (r/= _.true (&.membership sample (&.from-set set-10)))
- (set.member? set-10 sample)))
+(def: predicates-and-sets
+ Test
+ (do r.monad
+ [#let [set-10 (set.from-list nat.hash (list.n/range 0 10))]
+ sample (|> r.nat (:: @ map (n/% 20)))]
+ ($_ _.and
+ (<| (_.context (%name (name-of /.from-predicate)))
+ (_.test (format "Values that satisfy a predicate have membership = 1."
+ "Values that don't have membership = 0.")
+ (bit@= (r/= //.true (/.membership sample (/.from-predicate n/even?)))
+ (n/even? sample))))
+ (<| (_.context (%name (name-of /.from-set)))
+ (_.test (format "Values that belong to a set have membership = 1."
+ "Values that don't have membership = 0.")
+ (bit@= (r/= //.true (/.membership sample (/.from-set set-10)))
+ (set.member? set-10 sample))))
+ )))
+
+(def: thresholds
+ Test
+ (do r.monad
+ [fuzzy ..triangle
+ sample r.rev
+ threshold r.rev
+ #let [vip-fuzzy (/.cut threshold fuzzy)
+ member? (/.to-predicate threshold fuzzy)]]
+ (<| (_.context (%name (name-of /.cut)))
+ ($_ _.and
+ (_.test "Can increase the threshold of membership of a fuzzy set."
+ (bit@= (r/> //.false (/.membership sample vip-fuzzy))
+ (r/> threshold (/.membership sample fuzzy))))
+ (_.test "Can turn fuzzy sets into predicates through a threshold."
+ (bit@= (member? sample)
+ (r/> threshold (/.membership sample fuzzy))))
))))
-(context: "Thresholds"
- (<| (times 100)
- (do @
- [fuzzy gen-triangle
- sample r.rev
- threshold r.rev
- #let [vip-fuzzy (&.cut threshold fuzzy)
- member? (&.to-predicate threshold fuzzy)]]
- ($_ seq
- (test "Can increase the threshold of membership of a fuzzy set."
- (bit;= (r/> _.false (&.membership sample vip-fuzzy))
- (r/> threshold (&.membership sample fuzzy))))
-
- (test "Can turn fuzzy sets into predicates through a threshold."
- (bit;= (member? sample)
- (r/> threshold (&.membership sample fuzzy))))
- ))))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ..rev-triangles
+ ..rev-trapezoids
+ ..combinators
+ ..predicates-and-sets
+ ..thresholds
+ )))
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux
index 4f9449d2a..242b08503 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/modular.lux
@@ -1,18 +1,16 @@
(.module:
[lux #*
- [control
- [monad (#+ do)]]
+ data/text/format
+ ["_" test (#+ Test)]
+ ["r" math/random]
+ [control/monad (#+ do)]
[data
["." product]
- ["." bit ("#;." equivalence)]
- ["." error]
- [text
- format]]
- [math
- ["r" random]
- ["/" modular]]
- ["." type ("#;." equivalence)]]
- lux/test)
+ ["." bit ("#@." equivalence)]
+ ["." error]]
+ ["." type ("#@." equivalence)]]
+ {1
+ ["." /]})
(def: %3 (/.modulus +3))
(`` (type: Mod3 (~~ (:of %3))))
@@ -43,7 +41,7 @@
(-> Int Int Bit)
(-> (/.Mod m) (/.Mod m) Bit)))
(function (_ param subject)
- (bit;= (m/? param subject)
+ (bit@= (m/? param subject)
(i/? (value param)
(value subject)))))
@@ -59,9 +57,10 @@
(/.mod modulus)
(/.m/= (m/! param subject)))))
-(context: "Modular arithmetic."
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Mod)))
+ (do r.monad
[_normalM modulusR
_alternativeM (|> modulusR (r.filter (|>> (i/= _normalM) not)))
#let [normalM (|> _normalM /.from-int error.assume)
@@ -69,82 +68,72 @@
[_param param] (modR normalM)
[_subject subject] (modR normalM)
#let [copyM (|> normalM /.to-int /.from-int error.assume)]]
- ($_ seq
- (test "Every modulus has a unique type, even if the numeric value is the same as another."
- (and (type;= (:of normalM)
- (:of normalM))
- (not (type;= (:of normalM)
- (:of alternativeM)))
- (not (type;= (:of normalM)
- (:of copyM)))))
-
- (test "Can extract the original integer from the modulus."
- (i/= _normalM
- (/.to-int normalM)))
-
- (test "Can compare mod'ed values."
- (and (/.m/= subject subject)
- ((comparison /.m/= i/=) param subject)
- ((comparison /.m/< i/<) param subject)
- ((comparison /.m/<= i/<=) param subject)
- ((comparison /.m/> i/>) param subject)
- ((comparison /.m/>= i/>=) param subject)))
-
- (test "Mod'ed values are ordered."
- (and (bit;= (/.m/< param subject)
- (not (/.m/>= param subject)))
- (bit;= (/.m/> param subject)
- (not (/.m/<= param subject)))
- (bit;= (/.m/= param subject)
- (not (or (/.m/< param subject)
- (/.m/> param subject))))))
-
- (test "Can do arithmetic."
- (and ((arithmetic normalM /.m/+ i/+) param subject)
- ((arithmetic normalM /.m/- i/-) param subject)
- ((arithmetic normalM /.m/* i/*) param subject)))
-
- (test "Can sometimes find multiplicative inverse."
- (case (/.inverse subject)
- (#.Some subject^-1)
- (|> subject
- (/.m/* subject^-1)
- (/.m/= (/.mod normalM +1)))
-
- #.None
- #1))
-
- (test "Can encode/decode to text."
- (let [(^open "mod/.") (/.codec normalM)]
- (case (|> subject mod/encode mod/decode)
- (#error.Success output)
- (/.m/= subject output)
+ ($_ _.and
+ (_.test "Every modulus has a unique type, even if the numeric value is the same as another."
+ (and (type@= (:of normalM)
+ (:of normalM))
+ (not (type@= (:of normalM)
+ (:of alternativeM)))
+ (not (type@= (:of normalM)
+ (:of copyM)))))
+ (_.test "Can extract the original integer from the modulus."
+ (i/= _normalM
+ (/.to-int normalM)))
+ (_.test "Can compare mod'ed values."
+ (and (/.m/= subject subject)
+ ((comparison /.m/= i/=) param subject)
+ ((comparison /.m/< i/<) param subject)
+ ((comparison /.m/<= i/<=) param subject)
+ ((comparison /.m/> i/>) param subject)
+ ((comparison /.m/>= i/>=) param subject)))
+ (_.test "Mod'ed values are ordered."
+ (and (bit@= (/.m/< param subject)
+ (not (/.m/>= param subject)))
+ (bit@= (/.m/> param subject)
+ (not (/.m/<= param subject)))
+ (bit@= (/.m/= param subject)
+ (not (or (/.m/< param subject)
+ (/.m/> param subject))))))
+ (_.test "Can do arithmetic."
+ (and ((arithmetic normalM /.m/+ i/+) param subject)
+ ((arithmetic normalM /.m/- i/-) param subject)
+ ((arithmetic normalM /.m/* i/*) param subject)))
+ (_.test "Can sometimes find multiplicative inverse."
+ (case (/.inverse subject)
+ (#.Some subject^-1)
+ (|> subject
+ (/.m/* subject^-1)
+ (/.m/= (/.mod normalM +1)))
+
+ #.None
+ #1))
+ (_.test "Can encode/decode to text."
+ (let [(^open "mod/.") (/.codec normalM)]
+ (case (|> subject mod/encode mod/decode)
+ (#error.Success output)
+ (/.m/= subject output)
+
+ (#error.Failure error)
+ #0)))
+ (_.test "Can equalize 2 moduli if they are equal."
+ (case (/.equalize (/.mod normalM _subject)
+ (/.mod copyM _param))
+ (#error.Success paramC)
+ (/.m/= param paramC)
(#error.Failure error)
- #0)))
-
- (test "Can equalize 2 moduli if they are equal."
- (case (/.equalize (/.mod normalM _subject)
- (/.mod copyM _param))
- (#error.Success paramC)
- (/.m/= param paramC)
-
- (#error.Failure error)
- #0))
+ #0))
+ (_.test "Cannot equalize 2 moduli if they are the different."
+ (case (/.equalize (/.mod normalM _subject)
+ (/.mod alternativeM _param))
+ (#error.Success paramA)
+ #0
- (test "Cannot equalize 2 moduli if they are the different."
- (case (/.equalize (/.mod normalM _subject)
- (/.mod alternativeM _param))
- (#error.Success paramA)
- #0
-
- (#error.Failure error)
- #1))
-
- (test "All numbers are congruent to themselves."
- (/.congruent? normalM _subject _subject))
-
- (test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus."
- (bit;= (/.congruent? normalM _param _subject)
- (/.m/= param subject)))
+ (#error.Failure error)
+ #1))
+ (_.test "All numbers are congruent to themselves."
+ (/.congruent? normalM _subject _subject))
+ (_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus."
+ (bit@= (/.congruent? normalM _param _subject)
+ (/.m/= param subject)))
))))
diff --git a/stdlib/source/test/lux/math/random.lux b/stdlib/source/test/lux/math/random.lux
deleted file mode 100644
index acc161cc4..000000000
--- a/stdlib/source/test/lux/math/random.lux
+++ /dev/null
@@ -1,49 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do Monad)]]
- [data
- ["." number]
- [collection
- ["." list]
- ["." row]
- ["." array]
- ["." queue]
- ["." stack]
- ["." set]
- ["dict" dictionary]]]
- [math
- ["r" random]]]
- lux/test)
-
-(context: "Random."
- (<| (times 100)
- (do @
- [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
- _list (r.list size r.nat)
- _row (r.row size r.nat)
- _array (r.array size r.nat)
- _queue (r.queue size r.nat)
- _stack (r.stack size r.nat)
- _set (r.set number.hash size r.nat)
- _dict (r.dictionary number.hash size r.nat r.nat)
- top r.nat
- filtered (|> r.nat (r.filter (n/<= top)))]
- ($_ seq
- (test "Can produce lists."
- (n/= size (list.size _list)))
- (test "Can produce rows."
- (n/= size (row.size _row)))
- (test "Can produce arrays."
- (n/= size (array.size _array)))
- (test "Can produce queues."
- (n/= size (queue.size _queue)))
- (test "Can produce stacks."
- (n/= size (stack.size _stack)))
- (test "Can produce sets."
- (n/= size (set.size _set)))
- (test "Can produce dicts."
- (n/= size (dict.size _dict)))
- (test "Can filter values."
- (n/<= top filtered))
- ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 12:28:32 +0000