Ported tests for math-related modules.

1 files changed, 136 insertions, 131 deletions

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
+          )))