From f2ca9f956cbedb251603a835b2f3c6b1dded3d00 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 11 Dec 2016 19:48:56 -0400
Subject: - Updates lux/math tests. - Added lux/math/complex tests.

---
 stdlib/test/test/lux/math.lux         | 144 ++++++++++++++++++++-------
 stdlib/test/test/lux/math/complex.lux | 182 ++++++++++++++++++++++++++++++++++
 stdlib/test/tests.lux                 |  18 ++--
 3 files changed, 301 insertions(+), 43 deletions(-)
 create mode 100644 stdlib/test/test/lux/math/complex.lux

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux
index 8d96fcc41..58f95587d 100644
--- a/stdlib/test/test/lux/math.lux
+++ b/stdlib/test/test/lux/math.lux
@@ -1,45 +1,121 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
 (;module:
   lux
   (lux (codata [io])
        (control monad)
        (data [text "Text/" Monoid<Text>]
              text/format
-             [number]
+             [bool "b/" Eq<Bool>]
+             [number "r/" Number<Real>]
              (struct [list "List/" Fold<List> Functor<List>])
              [product])
        (codata function)
-       math)
+       (math ["R" random])
+       pipe
+       ["&" math])
   lux/test)
 
-(test: "lux/math exports"
-  (test-all (match 1.0 (cos 0.0))
-            (match -1.0 (cos (r./ 2.0 tau)))
-            ## (match 0.0 (cos (r./ 4.0 tau)))
-            ## (match 0.0 (cos (r.* (r./ 4.0 3.0) tau)))
-
-            (match 1.0 (sin (r./ 4.0 tau)))
-            (match -1.0 (sin (r.* (r./ 4.0 3.0) tau)))
-            ## (match 0.0 (sin 0.0))
-            ## (match 0.0 (sin (r./ 2.0 tau)))
-
-            (match 4 (ceil 3.75))
-            (match 3 (floor 3.75))
-            (match 4 (round 3.75))
-            (match 3 (round 3.25))
-
-            (match 3.0 (cbrt 27.0))
-            (match 4.0 (sqrt 16.0))
-
-            (match 90.0 (degrees (r./ 4.0 tau)))
-            (match true (r.= tau (radians (degrees tau))))
-
-            (match 9 (gcd 450 27))
-            (match 40 (lcm 10 8))
-
-            (match 27 (infix 27))
-            (match 9 (infix [27 gcd 450]))
-            (match 9 (infix [(i.* 3 9) gcd 450]))
-            (match true (infix [#and 27 i.< 450 i.< 2000]))
-            (match true (infix [#and 27 i.< 450 i.> 200]))
-            (match true (infix [[27 i.< 450] and [200 i.< 2000]]))
-            ))
+(test: "Trigonometry"
+  [angle (|> R;real (:: @ map (r.* &;tau)))]
+  ($_ seq
+      (assert "Sine and arc-sine are inverse functions."
+              (|> angle &;sin &;asin (r.= angle)))
+      
+      (assert "Cosine and arc-cosine are inverse functions."
+              (|> angle &;cos &;acos (r.= angle)))
+
+      (assert "Tangent and arc-tangent are inverse functions."
+              (|> angle &;tan &;atan (r.= angle)))
+
+      (assert "Can freely go between degrees and radians."
+              (|> angle &;degrees &;radians (r.= angle)))
+      ))
+
+(test: "Roots"
+  [factor (|> R;nat (:: @ map (|>. (n.% +1000)
+                                   (n.max +1)
+                                   nat-to-int
+                                   int-to-real)))
+   base (|> R;real (:: @ map (r.* factor)))]
+  ($_ seq
+      (assert "Square-root is inverse of square."
+              (|> base (&;pow 2.0) &;sqrt (r.= base)))
+      
+      (assert "Cubic-root is inverse of cube."
+              (|> base (&;pow 3.0) &;cbrt (r.= base)))
+      ))
+
+(test: "Rounding"
+  [sample (|> R;real (:: @ map (r.* 1000.0)))]
+  ($_ seq
+      (assert "The ceiling will be an integer value, and will be >= the original."
+              (let [ceil'd (&;ceil sample)]
+                (and (|> ceil'd real-to-int int-to-real (r.= ceil'd))
+                     (r.>= sample ceil'd)
+                     (r.<= 1.0 (r.- sample ceil'd)))))
+
+      (assert "The floor will be an integer value, and will be <= the original."
+              (let [floor'd (&;floor sample)]
+                (and (|> floor'd real-to-int int-to-real (r.= floor'd))
+                     (r.<= sample floor'd)
+                     (r.<= 1.0 (r.- floor'd sample)))))
+
+      (assert "The round will be an integer value, and will be < or > or = the original."
+              (let [round'd (&;round sample)]
+                (and (|> round'd real-to-int int-to-real (r.= round'd))
+                     (r.<= 1.0 (r/abs (r.- sample round'd))))))
+      ))
+
+(test: "Exponentials and logarithms"
+  [sample (|> R;real (:: @ map (r.* 10.0)))]
+  (assert "Logarithm is the inverse of exponential."
+          (|> sample &;exp &;log (r.= sample))))
+
+(test: "Greatest-Common-Divisor and Least-Common-Multiple"
+  [#let [gen-nat (|> R;nat (:: @ map (|>. (n.max +1) (n.% +1000))))]
+   x gen-nat
+   y gen-nat]
+  ($_ (assert "GCD"
+              (let [gcd (&;gcd x y)]
+                (and (n.= +0 (n.% x gcd))
+                     (n.= +0 (n.% y gcd))
+                     (n.<= (n.* x y) gcd))))
+
+      (assert "LCM"
+              (let [lcm (&;lcm x y)]
+                (and (n.= +0 (n.% lcm x))
+                     (n.= +0 (n.% lcm y))
+                     (n.>= +1 lcm))))
+      ))
+
+(test: "Infix syntax"
+  [x R;nat
+   y R;nat
+   z R;nat
+   #let [top (|> x (n.max y) (n.max z))
+         bottom (|> x (n.min y) (n.min z))]]
+  ($_ seq
+      (assert "Constant values don't change."
+              (n.= x (&;infix x)))
+
+      (assert "Can call infix functions."
+              (n.= (&;gcd y x) (&;infix [x &;gcd y])))
+
+      (assert "Can use regular syntax in the middle of infix code."
+              (n.= (&;gcd +450 (n.* +3 +9))
+                   (&;infix [(n.* +3 +9) &;gcd +450])))
+
+      (assert "Can use non-numerical functions/macros as operators."
+              (and (and (n.< y x) (n.< z y))
+                   (&;infix [[x n.< y] and [y n.< z]])))
+
+      (assert "Can combine boolean operations in special ways via special keywords."
+              (and (b/= (and (n.< y x) (n.< z y))
+                        (&;infix [#and x n.< y n.< z]))
+                   (b/= (and (n.< y x) (n.> z y))
+                        (&;infix [#and x n.< y n.> z]))))
+      ))
diff --git a/stdlib/test/test/lux/math/complex.lux b/stdlib/test/test/lux/math/complex.lux
new file mode 100644
index 000000000..a879d2e9d
--- /dev/null
+++ b/stdlib/test/test/lux/math/complex.lux
@@ -0,0 +1,182 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid<Text>]
+             text/format
+             [bool "b/" Eq<Bool>]
+             [number "r/" Number<Real>]
+             (struct [list "List/" Fold<List> Functor<List>])
+             [product])
+       (codata function)
+       (math ["R" random])
+       pipe
+       ["&" math/complex])
+  lux/test)
+
+## Based on org.apache.commons.math4.complex.Complex
+## https://github.com/apache/commons-math/blob/master/src/test/java/org/apache/commons/math4/complex/ComplexTest.java
+
+(def: gen-dim
+  (R;Random Real)
+  (do R;Monad<Random>
+    [factor (|> R;int (:: @ map int-to-real))
+     measure R;real]
+    (wrap (r.* factor measure))))
+
+(def: gen-complex
+  (R;Random &;Complex)
+  (do R;Monad<Random>
+    [real gen-dim
+     imaginary gen-dim]
+    (wrap (&;complex real imaginary))))
+
+(test: "Construction"
+  [real gen-dim
+   imaginary gen-dim]
+  ($_ seq
+      (assert "Can build and tear apart complex numbers"
+              (let [r+i (&;complex real imaginary)]
+                (and (r.= real (get@ #&;real r+i))
+                     (r.= imaginary (get@ #&;imaginary r+i)))))
+
+      (assert "If either the real part or the imaginary part is NaN, the composite is NaN."
+              (and (&;nan? (&;complex number;nan imaginary))
+                   (&;nan? (&;complex real number;nan))))
+      ))
+
+(test: "Absolute value"
+  [real gen-dim
+   imaginary gen-dim]
+  ($_ seq
+      (assert "Absolute value of complex >= absolute value of any of the parts."
+              (let [r+i (&;complex real imaginary)
+                    abs (&;c.abs r+i)]
+                (and (or (r.> real abs)
+                         (and (r.= real abs)
+                              (r.= 0.0 imaginary)))
+                     (or (r.> imaginary abs)
+                         (and (r.= imaginary abs)
+                              (r.= 0.0 real))))))
+
+      (assert "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
+              (and (r.= number;nan (&;c.abs (&;complex number;nan imaginary)))
+                   (r.= number;nan (&;c.abs (&;complex real number;nan)))))
+
+      (assert "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
+              (and (r.= number;+inf (&;c.abs (&;complex number;+inf imaginary)))
+                   (r.= number;+inf (&;c.abs (&;complex real number;+inf)))
+                   (r.= number;-inf (&;c.abs (&;complex number;-inf imaginary)))
+                   (r.= number;-inf (&;c.abs (&;complex real number;-inf)))))
+      ))
+
+(test: "Addidion, substraction, multiplication and division"
+  [x gen-complex
+   y gen-complex
+   factor gen-dim]
+  ($_ seq
+      (assert "Adding 2 complex numbers is the same as adding their parts."
+              (let [z (&;c.+ y x)]
+                (and (&;c.= z
+                            (&;complex (r.+ (get@ #&;real y)
+                                            (get@ #&;real x))
+                                       (r.+ (get@ #&;imaginary y)
+                                            (get@ #&;imaginary x)))))))
+
+      (assert "Subtracting 2 complex numbers is the same as adding their parts."
+              (let [z (&;c.- y x)]
+                (and (&;c.= z
+                            (&;complex (r.- (get@ #&;real y)
+                                            (get@ #&;real x))
+                                       (r.- (get@ #&;imaginary y)
+                                            (get@ #&;imaginary x)))))))
+
+      (assert "Subtraction is the inverse of addition."
+              (and (|> x (&;c.+ y) (&;c.- y) (&;c.= x))
+                   (|> x (&;c.- y) (&;c.+ y) (&;c.= x))))
+
+      (assert "Division is the inverse of multiplication."
+              (|> x (&;c.* y) (&;c./ y) (&;c.= x)))
+
+      (assert "Scalar division is the inverse of scalar multiplication."
+              (|> x (&;c.*' factor) (&;c./' factor) (&;c.= x)))
+      ))
+
+(test: "Conjugate, reciprocal, signum, negation"
+  [x gen-complex]
+  ($_ seq
+      (assert "Conjugate has same real part as original, and opposite of imaginary part."
+              (let [cx (&;conjugate x)]
+                (and (r.= (get@ #&;real x)
+                          (get@ #&;real cx))
+                     (r.= (r/negate (get@ #&;imaginary x))
+                          (get@ #&;imaginary cx)))))
+
+      (assert "The reciprocal functions is its own inverse."
+              (|> x &;reciprocal &;reciprocal (&;c.= x)))
+
+      (assert "x*(x^-1) = 1"
+              (|> x (&;c.* (&;reciprocal x)) (&;c.= &;one)))
+
+      (assert "Absolute value of signum is always 1."
+              (|> x &;c.signum &;c.abs (r.= 1.0)))
+
+      (assert "Negation is its own inverse."
+              (let [there (&;c.negate x)
+                    back-again (&;c.negate there)]
+                (and (not (&;c.= there x))
+                     (&;c.= back-again x))))
+
+      (assert "Negation doesn't change the absolute value."
+              (r.= (&;c.abs x)
+                   (&;c.abs (&;c.negate x))))
+      ))
+
+(test: "Trigonometry"
+  [x gen-complex]
+  ($_ seq
+      (assert "Arc-sine is the inverse of sine."
+              (|> x &;sin &;asin (&;c.= x)))
+
+      (assert "Arc-cosine is the inverse of cosine."
+              (|> x &;cos &;acos (&;c.= x)))
+
+      (assert "Arc-tangent is the inverse of tangent."
+              (|> x &;tan &;atan (&;c.= x))))
+  )
+
+(test: "Power 2 and exponential/logarithm"
+  [x gen-complex]
+  ($_ seq
+      (assert "Square root is inverse of power 2.0"
+              (|> x (&;pow' 2.0) &;sqrt (&;c.= x)))
+
+      (assert "Logarithm is inverse of exponentiation."
+              (and (|> x &;exp &;log (&;c.= x))
+                   (|> x &;log &;exp (&;c.= x))))
+      ))
+
+(test: "Complex roots"
+  [sample gen-complex
+   degree (|> R;nat (:: @ map (|>. (n.max +1) (n.% +5))))
+   #let [(^open "L/") (list;Eq<List> &;Eq<Complex>)]]
+  (assert "Can calculate the N roots for any complex number."
+          (L/= (list;repeat degree sample)
+               (List/map (&;pow' (|> degree nat-to-int int-to-real))
+                         (&;nth-root degree sample)))))
+
+(test: "Codec"
+  [sample gen-complex
+   #let [(^open "c/") &;Codec<Text,Complex>]]
+  (assert "Can encode/decode complex numbers."
+          (|> sample c/encode c/decode
+              (case> (#;Right output)
+                     (&;c.= sample output)
+
+                     _
+                     false))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 7b2e05f01..86de3d341 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -46,28 +46,28 @@
                            [vector]
                            [zipper])
                    (text [format]))
+             ["_;" math]
+             (math ## ["_;" ratio]
+                   ["_;" complex]
+                   ## ["_;" random]
+                   ## ["_;" simple]
+                   )
+             ## ["_;" pipe]
+             ## ["_;" lexer]
+             ## ["_;" regex]
              
              ## (macro [ast]
              ##        [syntax])
              ## [type]
-             ## [math]
-             ## [pipe]
-             ## [lexer]
-             ## [regex]
-             ## (data (format [json]))
              )
         )
   ## (lux (codata [cont])
-  ##      (concurrency [atom])
   ##      [macro]
   ##      (macro [template]
   ##             [poly]
   ##             (poly ["poly_;" eq]
   ##                   ["poly_;" text-encoder]
   ##                   ["poly_;" functor]))
-  ##      (math [ratio]
-  ##            [complex]
-  ##            [random])
   ##      (type [check] [auto])
   ##      (control [effect])
   ##      ["_;" lexer]
-- 
cgit v1.2.3