Generalized/type-agnostic arithmetic.

5 files changed, 282 insertions, 173 deletions

diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index 8df8e5813..a8b175c3a 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -11,15 +11,13 @@
    [data
     [collection
      ["[0]" list]]]
-   [macro
-    ["[0]" template]]
-   ["[0]" math
+   [math
     ["[0]" random {"+" Random}]
     [number
      ["n" nat]
-     ["[0]" int]
      ["f" frac]
-     ["r" rev]]]]]
+     ["r" rev]
+     ["[0]" int]]]]]
  [\\library
   ["[0]" /]])
 
@@ -34,11 +32,11 @@
 
 (def: square
   (-> Frac Frac)
-  (math.pow +2.0))
+  (f.pow +2.0))
 
 (def: square_root
   (-> Frac Frac)
-  (math.pow +0.5))
+  (f.pow +0.5))
 
 (def: (distance/1 from to)
   (-> Frac Frac Frac)
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index aeadbf093..6b5c9749e 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -4,6 +4,8 @@
    ["_" test {"+" Test}]
    [abstract
     [monad {"+" do}]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]]
    [macro
     ["[0]" template]]
    [math
@@ -11,7 +13,10 @@
     [number
      ["n" nat]
      ["i" int]
-     ["f" frac]]]]]
+     ["r" rev]
+     ["f" frac]
+     ["[0]" ratio {"+" Ratio}]
+     ["[0]" complex {"+" Complex}]]]]]
  [\\library
   ["[0]" /]]
  ["[0]" / "_"
@@ -23,152 +28,117 @@
    ["[1]/[0]" continuous]
    ["[1]/[0]" fuzzy]]])
 
-(def: margin_of_error
-  +0.0000001)
+(def: ratio/0
+  Ratio
+  [ratio.#numerator 0 ratio.#denominator 1])
 
-(def: (trigonometric_symmetry forward backward angle)
-  (-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
-  (let [normal (|> angle forward backward)]
-    (|> normal forward backward (f.approximately? ..margin_of_error normal))))
+(def: complex/0
+  Complex
+  [complex.#real +0.0 complex.#imaginary +0.0])
 
 (def: .public test
   Test
   (<| (_.covering /._)
-      ($_ _.and
-          (do [! random.monad]
-            [.let [~= (f.approximately? ..margin_of_error)]
-             angle (|> random.safe_frac (# ! each (f.* /.tau)))]
-            ($_ _.and
-                (_.cover [/.sin /.asin]
-                         (trigonometric_symmetry /.sin /.asin angle))
-                (_.cover [/.cos /.acos]
-                         (trigonometric_symmetry /.cos /.acos angle))
-                (_.cover [/.tan /.atan]
-                         (trigonometric_symmetry /.tan /.atan angle))
-                (_.cover [/.tau]
-                         (and (and (~= +0.0 (/.sin /.tau))
-                                   (~= +1.0 (/.cos /.tau)))
-                              (and (~= +0.0 (/.sin (f./ +2.0 /.tau)))
-                                   (~= -1.0 (/.cos (f./ +2.0 /.tau))))
-                              (and (~= +1.0 (/.sin (f./ +4.0 /.tau)))
-                                   (~= +0.0 (/.cos (f./ +4.0 /.tau))))
-                              (and (~= -1.0 (/.sin (f.* +3.0 (f./ +4.0 /.tau))))
-                                   (~= +0.0 (/.cos (f.* +3.0 (f./ +4.0 /.tau)))))
-                              (let [x2+y2 (f.+ (/.pow +2.0 (/.sin angle))
-                                               (/.pow +2.0 (/.cos angle)))]
-                                (~= +1.0 x2+y2))))
-                (_.cover [/.pi]
-                         (~= (f./ +2.0 /.tau) /.pi))
-                ))
-          (do [! random.monad]
-            [sample (|> random.safe_frac (# ! each (f.* +1000.0)))]
-            ($_ _.and
-                (_.cover [/.ceil]
-                         (let [ceil'd (/.ceil sample)]
-                           (and (|> ceil'd f.int i.frac (f.= ceil'd))
-                                (f.>= sample ceil'd)
-                                (f.<= +1.0 (f.- sample ceil'd)))))
-                (_.cover [/.floor]
-                         (let [floor'd (/.floor sample)]
-                           (and (|> floor'd f.int i.frac (f.= floor'd))
-                                (f.<= sample floor'd)
-                                (f.<= +1.0 (f.- floor'd sample)))))
-                (_.cover [/.round]
-                         (let [round'd (/.round sample)]
-                           (and (|> round'd f.int i.frac (f.= round'd))
-                                (f.<= +1.0 (f.abs (f.- sample round'd))))))
-                (_.cover [/.root/2]
-                         (let [sample (f.abs sample)]
-                           (|> sample
-                               /.root/2
-                               (/.pow +2.0)
-                               (f.approximately? ..margin_of_error sample))))
-                (_.cover [/.root/3]
-                         (|> sample
-                             /.root/3
-                             (/.pow +3.0)
-                             (f.approximately? ..margin_of_error sample)))
-                ))
-          (do [! random.monad]
-            [.let [~= (f.approximately? ..margin_of_error)]
-             sample (# ! each (f.* +10.0) random.safe_frac)
-             power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)]
-            ($_ _.and
-                (_.cover [/.exp /.log]
-                         (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample)))
-                (_.cover [/.e]
-                         (~= +1.0 (/.log /.e)))
-                (_.cover [/.pow /.log_by]
-                         (let [sample (f.abs sample)]
-                           (|> sample
-                               (/.pow power)
-                               (/.log_by sample)
-                               (~= power))))
-                ))
-          (do [! random.monad]
-            [.let [~= (f.approximately? ..margin_of_error)]
-             angle (# ! each (f.* /.tau) random.safe_frac)
-             sample (# ! each f.abs random.safe_frac)
-             big (# ! each (f.* +1,000,000,000.00) random.safe_frac)]
-            (template.let [(odd! <function>)
-                           [(_.cover [<function>]
-                                     (~= (f.opposite (<function> angle))
-                                         (<function> (f.opposite angle))))]
+      (do random.monad
+        [parameterN (random.only (|>> (n.= 0) not) random.nat)
+         subjectN random.nat
 
-                           (even! <function>)
-                           [(_.cover [<function>]
-                                     (~= (<function> angle)
-                                         (<function> (f.opposite angle))))]
+         parameterI (random.only (|>> (i.= +0) not) random.int)
+         subjectI random.int
 
-                           (inverse! <left> <right> <input>)
-                           [(_.cover [<left> <right>]
-                                     (~= (<right> <input>)
-                                         (<left> (f./ <input> +1.0))))]]
-              ($_ _.and
-                  (odd! /.sinh)
-                  (even! /.cosh)
-                  (odd! /.tanh)
-                  (odd! /.coth)
-                  (even! /.sech)
-                  (odd! /.csch)
+         parameterR (random.only (|>> (r.= .0) not) random.rev)
+         subjectR random.rev
 
-                  (inverse! /.acosh /.asech sample)
-                  (inverse! /.asinh /.acsch sample)
-                  (inverse! /.atanh /.acoth big)
-                  )))
-          (do [! random.monad]
-            [x (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac)
-             y (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac)]
-            (_.cover [/.hypotenuse]
-                     (let [h (/.hypotenuse x y)]
-                       (and (f.>= x h)
-                            (f.>= y h)))))
-          (do [! random.monad]
-            [.let [~= (f.approximately? ..margin_of_error)
-                   tau/4 (f./ +4.0 /.tau)]
-             x (# ! each (f.* tau/4) random.safe_frac)
-             y (# ! each (f.* tau/4) random.safe_frac)]
-            (_.cover [/.atan/2]
-                     (let [expected (/.atan/2 x y)
-                           actual (if (f.> +0.0 x)
-                                    (/.atan (f./ x y))
-                                    (if (f.< +0.0 y)
-                                      (f.- /.pi (/.atan (f./ x y)))
-                                      (f.+ /.pi (/.atan (f./ x y)))))]
-                       (and (~= expected actual)
-                            (~= tau/4 (/.atan/2 +0.0 (f.abs y)))
-                            (~= (f.opposite tau/4) (/.atan/2 +0.0 (f.opposite (f.abs y))))
-                            (f.not_a_number? (/.atan/2 +0.0 +0.0))))))
-          (do [! random.monad]
-            [of (# ! each (|>> (n.% 10) ++) random.nat)]
-            (_.cover [/.factorial]
-                     (and (n.= 1 (/.factorial 0))
-                          (|> (/.factorial of) (n.% of) (n.= 0)))))
+         parameterF (random.only (|>> (f.= +0.0) not) random.safe_frac)
+         subjectF random.safe_frac
 
-          /infix.test
-          /modulus.test
-          /modular.test
-          /number.test
-          /logic/continuous.test
-          /logic/fuzzy.test
-          )))
+         parameter/ (random.only (|>> (ratio.= ratio/0) not) random.ratio)
+         subject/ random.ratio
+
+         parameterC (random.only (|>> (complex.= complex/0) not) random.complex)
+         subjectC random.complex])
+      (`` ($_ _.and
+              (~~ (template [</> <scenarios>']
+                    [(_.cover [</>]
+                              (with_expansions [<scenarios> (template.spliced <scenarios>')]
+                                (`` (and (~~ (template [<=> <//> <parameter> <subject>]
+                                               [(<=> (<//> <parameter> <subject>)
+                                                     (</> <parameter> <subject>))]
+                                               
+                                               <scenarios>))))))]
+
+                    [/.+ [[n.= n.+ parameterN subjectN]
+                          [i.= i.+ parameterI subjectI]
+                          [r.= r.+ parameterR subjectR]
+                          [f.= f.+ parameterF subjectF]
+                          [ratio.= ratio.+ parameter/ subject/]
+                          [complex.= complex.+ parameterC subjectC]]]
+                    [/.- [[n.= n.- parameterN subjectN]
+                          [i.= i.- parameterI subjectI]
+                          [r.= r.- parameterR subjectR]
+                          [f.= f.- parameterF subjectF]
+                          [ratio.= ratio.- parameter/ subject/]
+                          [complex.= complex.- parameterC subjectC]]]
+                    [/.* [[n.= n.* parameterN subjectN]
+                          [i.= i.* parameterI subjectI]
+                          [r.= r.* parameterR subjectR]
+                          [f.= f.* parameterF subjectF]
+                          [ratio.= ratio.* parameter/ subject/]
+                          [complex.= complex.* parameterC subjectC]]]
+                    [/./ [[n.= n./ parameterN subjectN]
+                          [i.= i./ parameterI subjectI]
+                          [r.= r./ parameterR subjectR]
+                          [f.= f./ parameterF subjectF]
+                          [ratio.= ratio./ parameter/ subject/]
+                          [complex.= complex./ parameterC subjectC]]]
+                    [/.% [[n.= n.% parameterN subjectN]
+                          [i.= i.% parameterI subjectI]
+                          [r.= r.% parameterR subjectR]
+                          [f.= f.% parameterF subjectF]
+                          [ratio.= ratio.% parameter/ subject/]
+                          [complex.= complex.% parameterC subjectC]]]
+                    ))
+              (~~ (template [</> <scenarios>']
+                    [(_.cover [</>]
+                              (with_expansions [<scenarios> (template.spliced <scenarios>')]
+                                (`` (and (~~ (template [<//> <parameter> <subject>]
+                                               [(bit#= (<//> <parameter> <subject>)
+                                                       (</> <parameter> <subject>))]
+                                               
+                                               <scenarios>))))))]
+
+                    [/.= [[n.= parameterN subjectN]
+                          [i.= parameterI subjectI]
+                          [r.= parameterR subjectR]
+                          [f.= parameterF subjectF]
+                          [ratio.= parameter/ subject/]
+                          [complex.= parameterC subjectC]]]
+                    [/.< [[n.< parameterN subjectN]
+                          [i.< parameterI subjectI]
+                          [r.< parameterR subjectR]
+                          [f.< parameterF subjectF]
+                          [ratio.< parameter/ subject/]]]
+                    [/.<= [[n.<= parameterN subjectN]
+                           [i.<= parameterI subjectI]
+                           [r.<= parameterR subjectR]
+                           [f.<= parameterF subjectF]
+                           [ratio.<= parameter/ subject/]]]
+                    [/.> [[n.> parameterN subjectN]
+                          [i.> parameterI subjectI]
+                          [r.> parameterR subjectR]
+                          [f.> parameterF subjectF]
+                          [ratio.> parameter/ subject/]]]
+                    [/.>= [[n.>= parameterN subjectN]
+                           [i.>= parameterI subjectI]
+                           [r.>= parameterR subjectR]
+                           [f.>= parameterF subjectF]
+                           [ratio.>= parameter/ subject/]]]
+                    ))
+
+              /infix.test
+              /modulus.test
+              /modular.test
+              /number.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
index f52e6dd5f..709a24b0b 100644
--- a/stdlib/source/test/lux/math/infix.lux
+++ b/stdlib/source/test/lux/math/infix.lux
@@ -1,19 +1,18 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    [abstract
-     [monad {"+" do}]]
-    [data
-     ["[0]" bit ("[1]#[0]" equivalence)]]
-    [math
-     ["[0]" random]
-     [number
-      ["n" nat]
-      ["f" frac]]]]]
-  [\\library
-   ["[0]" /
-    ["[0]" //]]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random]
+    [number
+     ["n" nat]
+     ["f" frac]]]]]
+ [\\library
+  ["[0]" /]])
 
 (def: .public test
   Test
@@ -30,8 +29,8 @@
                             (/.infix subject))
 
                        unary_functions!
-                       (f.= (//.sin angle)
-                            (/.infix [//.sin angle]))
+                       (f.= (f.sin angle)
+                            (/.infix [f.sin angle]))
 
                        binary_functions!
                        (n.= (n.gcd parameter subject)
diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux
index 53b8982a2..bfee3adcc 100644
--- a/stdlib/source/test/lux/math/number/complex.lux
+++ b/stdlib/source/test/lux/math/number/complex.lux
@@ -1,18 +1,15 @@
 (.using
  [library
   [lux "*"
-   ["%" data/text/format {"+" format}]
    ["_" test {"+" Test}]
    [abstract
     [monad {"+" do}]
     [\\specification
-     ["$[0]" equivalence]
-     ["$[0]" order]
-     ["$[0]" codec]]]
+     ["$[0]" equivalence]]]
    [data
     [collection
      ["[0]" list ("[1]#[0]" functor)]]]
-   ["[0]" math
+   [math
     ["[0]" random {"+" Random}]]]]
  [\\library
   ["[0]" /
@@ -161,8 +158,8 @@
                  (let [rem (/.% y x)
                        quotient (|> x (/.- rem) (/./ y))
                        floored (|> quotient
-                                   (revised /.#real math.floor)
-                                   (revised /.#imaginary math.floor))]
+                                   (revised /.#real f.floor)
+                                   (revised /.#imaginary f.floor))]
                    (/.approximately? +0.000000000001
                                      x
                                      (|> quotient (/.* y) (/.+ rem)))))
@@ -192,7 +189,7 @@
                  (let [signum_abs (|> x /.signum /.abs)]
                    (or (f.= +0.0 signum_abs)
                        (f.= +1.0 signum_abs)
-                       (f.= (math.pow +0.5 +2.0) signum_abs))))
+                       (f.= (f.pow +0.5 +2.0) signum_abs))))
         (_.cover [/.opposite]
                  (let [own_inverse!
                        (let [there (/.opposite x)
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index f78b23afd..77453c6f2 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -14,6 +14,8 @@
      ["$[0]" codec]]]
    [data
     ["[0]" bit ("[1]#[0]" equivalence)]]
+   [macro
+    ["[0]" template]]
    [math
     ["[0]" random {"+" Random}]]]]
  [\\library
@@ -126,6 +128,148 @@
        @.jvm (as_is <jvm>)
        (as_is)))
 
+(def: margin_of_error
+  +0.0000001)
+
+(def: (trigonometric_symmetry forward backward angle)
+  (-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
+  (let [normal (|> angle forward backward)]
+    (|> normal forward backward (/.approximately? ..margin_of_error normal))))
+
+(def: test|math
+  Test
+  ($_ _.and
+      (do [! random.monad]
+        [.let [~= (/.approximately? ..margin_of_error)]
+         angle (|> random.safe_frac (# ! each (/.* /.tau)))]
+        ($_ _.and
+            (_.cover [/.sin /.asin]
+                     (trigonometric_symmetry /.sin /.asin angle))
+            (_.cover [/.cos /.acos]
+                     (trigonometric_symmetry /.cos /.acos angle))
+            (_.cover [/.tan /.atan]
+                     (trigonometric_symmetry /.tan /.atan angle))
+            (_.cover [/.tau]
+                     (and (and (~= +0.0 (/.sin /.tau))
+                               (~= +1.0 (/.cos /.tau)))
+                          (and (~= +0.0 (/.sin (/./ +2.0 /.tau)))
+                               (~= -1.0 (/.cos (/./ +2.0 /.tau))))
+                          (and (~= +1.0 (/.sin (/./ +4.0 /.tau)))
+                               (~= +0.0 (/.cos (/./ +4.0 /.tau))))
+                          (and (~= -1.0 (/.sin (/.* +3.0 (/./ +4.0 /.tau))))
+                               (~= +0.0 (/.cos (/.* +3.0 (/./ +4.0 /.tau)))))
+                          (let [x2+y2 (/.+ (/.pow +2.0 (/.sin angle))
+                                           (/.pow +2.0 (/.cos angle)))]
+                            (~= +1.0 x2+y2))))
+            (_.cover [/.pi]
+                     (~= (/./ +2.0 /.tau) /.pi))
+            ))
+      (do [! random.monad]
+        [sample (|> random.safe_frac (# ! each (/.* +1000.0)))]
+        ($_ _.and
+            (_.cover [/.ceil]
+                     (let [ceil'd (/.ceil sample)]
+                       (and (|> ceil'd /.int i.frac (/.= ceil'd))
+                            (/.>= sample ceil'd)
+                            (/.<= +1.0 (/.- sample ceil'd)))))
+            (_.cover [/.floor]
+                     (let [floor'd (/.floor sample)]
+                       (and (|> floor'd /.int i.frac (/.= floor'd))
+                            (/.<= sample floor'd)
+                            (/.<= +1.0 (/.- floor'd sample)))))
+            (_.cover [/.round]
+                     (let [round'd (/.round sample)]
+                       (and (|> round'd /.int i.frac (/.= round'd))
+                            (/.<= +1.0 (/.abs (/.- sample round'd))))))
+            (_.cover [/.root/2]
+                     (let [sample (/.abs sample)]
+                       (|> sample
+                           /.root/2
+                           (/.pow +2.0)
+                           (/.approximately? ..margin_of_error sample))))
+            (_.cover [/.root/3]
+                     (|> sample
+                         /.root/3
+                         (/.pow +3.0)
+                         (/.approximately? ..margin_of_error sample)))
+            ))
+      (do [! random.monad]
+        [.let [~= (/.approximately? ..margin_of_error)]
+         sample (# ! each (/.* +10.0) random.safe_frac)
+         power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)]
+        ($_ _.and
+            (_.cover [/.exp /.log]
+                     (|> sample /.exp /.log (/.approximately? +0.000000000000001 sample)))
+            (_.cover [/.e]
+                     (~= +1.0 (/.log /.e)))
+            (_.cover [/.pow /.log_by]
+                     (let [sample (/.abs sample)]
+                       (|> sample
+                           (/.pow power)
+                           (/.log_by sample)
+                           (~= power))))
+            ))
+      (do [! random.monad]
+        [.let [~= (/.approximately? ..margin_of_error)]
+         angle (# ! each (/.* /.tau) random.safe_frac)
+         sample (# ! each /.abs random.safe_frac)
+         big (# ! each (/.* +1,000,000,000.00) random.safe_frac)]
+        (template.let [(odd! <function>)
+                       [(_.cover [<function>]
+                                 (~= (/.opposite (<function> angle))
+                                     (<function> (/.opposite angle))))]
+
+                       (even! <function>)
+                       [(_.cover [<function>]
+                                 (~= (<function> angle)
+                                     (<function> (/.opposite angle))))]
+
+                       (inverse! <left> <right> <input>)
+                       [(_.cover [<left> <right>]
+                                 (~= (<right> <input>)
+                                     (<left> (/./ <input> +1.0))))]]
+          ($_ _.and
+              (odd! /.sinh)
+              (even! /.cosh)
+              (odd! /.tanh)
+              (odd! /.coth)
+              (even! /.sech)
+              (odd! /.csch)
+
+              (inverse! /.acosh /.asech sample)
+              (inverse! /.asinh /.acsch sample)
+              (inverse! /.atanh /.acoth big)
+              )))
+      (do [! random.monad]
+        [x (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac)
+         y (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac)]
+        (_.cover [/.hypotenuse]
+                 (let [h (/.hypotenuse x y)]
+                   (and (/.>= x h)
+                        (/.>= y h)))))
+      (do [! random.monad]
+        [.let [~= (/.approximately? ..margin_of_error)
+               tau/4 (/./ +4.0 /.tau)]
+         x (# ! each (/.* tau/4) random.safe_frac)
+         y (# ! each (/.* tau/4) random.safe_frac)]
+        (_.cover [/.atan/2]
+                 (let [expected (/.atan/2 x y)
+                       actual (if (/.> +0.0 x)
+                                (/.atan (/./ x y))
+                                (if (/.< +0.0 y)
+                                  (/.- /.pi (/.atan (/./ x y)))
+                                  (/.+ /.pi (/.atan (/./ x y)))))]
+                   (and (~= expected actual)
+                        (~= tau/4 (/.atan/2 +0.0 (/.abs y)))
+                        (~= (/.opposite tau/4) (/.atan/2 +0.0 (/.opposite (/.abs y))))
+                        (/.not_a_number? (/.atan/2 +0.0 +0.0))))))
+      (do [! random.monad]
+        [of (# ! each (|>> (n.% 10) ++) random.nat)]
+        (_.cover [/.factorial]
+                 (and (n.= 1 (/.factorial 0))
+                      (|> (/.factorial of) (n.% of) (n.= 0)))))
+      ))
+
 (def: .public test
   Test
   (<| (_.covering /._)
@@ -242,4 +386,5 @@
           ..predicate
           ..conversion
           ..signature
+          ..test|math
           )))