diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/math/logic/continuous.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/test/lux/cli.lux | 112 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/bit.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/test/lux/io.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math.lux | 184 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/infix.lux | 42 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/logic/continuous.lux | 55 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/logic/fuzzy.lux | 267 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/modular.lux | 169 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/random.lux | 49 |
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)) - )))) |