- Added Number implementation for Complex.

2 files changed, 66 insertions, 29 deletions

diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux
index 69e9f71f9..252e31d51 100644
--- a/stdlib/source/lux/math/complex.lux
+++ b/stdlib/source/lux/math/complex.lux
@@ -116,6 +116,15 @@
     {#real (r./ param real)
      #imaginary (r./ param imaginary)}))
 
+(def: #export (c.% param input)
+  (-> Complex Complex Complex)
+  (let [scaled (c./ param input)
+        quotient (|> scaled
+                     (update@ #real math;floor)
+                     (update@ #imaginary math;floor))]
+    (c.- (c.* quotient param)
+         input)))
+
 (def: #export (cos subject)
   (-> Complex Complex)
   (let [(^slots [#real #imaginary]) subject]
@@ -167,21 +176,37 @@
      #imaginary (r./ d (math;sin i2))}))
 
 (def: #export (c.abs subject)
-  (-> Complex Real)
+  (-> Complex Complex)
   (let [(^slots [#real #imaginary]) subject]
-    (if (r.< (r/abs imaginary)
-             (r/abs real))
-      (if (r.= 0.0 imaginary)
-        (r/abs real)
-        (let [q (r./ imaginary real)]
-          (r.* (math;sqrt (r.+ 1.0 (r.* q q)))
-               (r/abs imaginary))))
-      (if (r.= 0.0 real)
-        (r/abs imaginary)
-        (let [q (r./ real imaginary)]
-          (r.* (math;sqrt (r.+ 1.0 (r.* q q)))
-               (r/abs real))))
-      )))
+    (complex (if (r.< (r/abs imaginary)
+                      (r/abs real))
+               (if (r.= 0.0 imaginary)
+                 (r/abs real)
+                 (let [q (r./ imaginary real)]
+                   (r.* (math;sqrt (r.+ 1.0 (r.* q q)))
+                        (r/abs imaginary))))
+               (if (r.= 0.0 real)
+                 (r/abs imaginary)
+                 (let [q (r./ real imaginary)]
+                   (r.* (math;sqrt (r.+ 1.0 (r.* q q)))
+                        (r/abs real))))
+               ))))
+
+(struct: #export _ (Number Complex)
+  (def: + c.+)
+  (def: - c.-)
+  (def: * c.*)
+  (def: / c./)
+  (def: % c.%)
+  (def: (negate x)
+    (|> x
+        (update@ #real r/negate)
+        (update@ #imaginary r/negate)))
+  (def: abs c.abs)
+  (def: (signum x)
+    (|> x
+        (update@ #real r/signum)
+        (update@ #imaginary r/signum))))
 
 (def: #export (exp subject)
   (-> Complex Complex)
@@ -193,7 +218,7 @@
 (def: #export (log subject)
   (-> Complex Complex)
   (let [(^slots [#real #imaginary]) subject]
-    {#real (math;log (c.abs subject))
+    {#real (|> subject c.abs (get@ #real) math;log)
      #imaginary (math;atan2 real imaginary)}))
 
 (do-template [<name> <type> <op>]
@@ -211,7 +236,7 @@
 
 (def: #export (sqrt (^@ input (^slots [#real #imaginary])))
   (-> Complex Complex)
-  (let [t (|> input c.abs (r.+ (r/abs real)) (r./ 2.0) math;sqrt)]
+  (let [t (|> input c.abs (get@ #real) (r.+ (r/abs real)) (r./ 2.0) math;sqrt)]
     (if (r.>= 0.0 real)
       {#real t
        #imaginary (r./ (r.* 2.0 t)
@@ -271,8 +296,7 @@
   (if (n.= +0 nth)
     (list)
     (let [r-nth (|> nth nat-to-int int-to-real)
-          nth-root-of-abs (math;pow (r./ r-nth 1.0)
-                                    (c.abs input))
+          nth-root-of-abs (|> input c.abs (get@ #real) (math;pow (r./ r-nth 1.0)))
           nth-phi (|> input argument (r./ r-nth))
           slice (|> math;pi (r.* 2.0) (r./ r-nth))]
       (|> (list;n.range +0 (n.dec nth))
diff --git a/stdlib/test/test/lux/math/complex.lux b/stdlib/test/test/lux/math/complex.lux
index 487e7ba59..0cb5be426 100644
--- a/stdlib/test/test/lux/math/complex.lux
+++ b/stdlib/test/test/lux/math/complex.lux
@@ -64,25 +64,27 @@
   ($_ seq
       (assert "Absolute value of complex >= absolute value of any of the parts."
               (let [r+i (&;complex real imaginary)
-                    abs (&;c.abs r+i)]
+                    abs (get@ #&;real (&;c.abs r+i))]
                 (and (r.>= (r/abs real) abs)
                      (r.>= (r/abs imaginary) abs))))
 
       (assert "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
-              (and (number;nan? (&;c.abs (&;complex number;nan imaginary)))
-                   (number;nan? (&;c.abs (&;complex real number;nan)))))
+              (and (number;nan? (get@ #&;real (&;c.abs (&;complex number;nan imaginary))))
+                   (number;nan? (get@ #&;real (&;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)))))
+              (and (r.= number;+inf (get@ #&;real (&;c.abs (&;complex number;+inf imaginary))))
+                   (r.= number;+inf (get@ #&;real (&;c.abs (&;complex real number;+inf))))
+                   (r.= number;+inf (get@ #&;real (&;c.abs (&;complex number;-inf imaginary))))
+                   (r.= number;+inf (get@ #&;real (&;c.abs (&;complex real number;-inf))))))
       ))
 
 (test: "Addidion, substraction, multiplication and division"
   [x gen-complex
    y gen-complex
-   factor gen-dim]
+   factor gen-dim
+   #let [rem (&;c.% (&;complex 3.0 5.0)
+                    (&;complex 6.0 4.0))]]
   ($_ seq
       (assert "Adding 2 complex numbers is the same as adding their parts."
               (let [z (&;c.+ y x)]
@@ -109,6 +111,17 @@
 
       (assert "Scalar division is the inverse of scalar multiplication."
               (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x)))
+
+      (assert "If you subtract the remainder, all divisions must be exact."
+              (let [rem (&;c.% y x)
+                    quotient (|> x (&;c.- rem) (&;c./ y))
+                    floored (|> quotient
+                                (update@ #&;real math;floor)
+                                (update@ #&;imaginary math;floor))
+                    (^open "&/") &;Codec<Text,Complex>]
+                (within? 0.000000000001
+                         x
+                         (|> quotient (&;c.* y) (&;c.+ rem)))))
       ))
 
 (test: "Conjugate, reciprocal, signum, negation"
@@ -128,7 +141,7 @@
               (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one)))
 
       (assert "Absolute value of signum is always sqrt(2), 1 or 0."
-              (let [signum-abs (|> x &;c.signum &;c.abs)]
+              (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))]
                 (or (r.= 0.0 signum-abs)
                     (r.= 1.0 signum-abs)
                     (r.= (math;sqrt 2.0) signum-abs))))
@@ -140,8 +153,8 @@
                      (&;c.= back-again x))))
 
       (assert "Negation doesn't change the absolute value."
-              (r.= (&;c.abs x)
-                   (&;c.abs (&;c.negate x))))
+              (r.= (get@ #&;real (&;c.abs x))
+                   (get@ #&;real (&;c.abs (&;c.negate x)))))
       ))
 
 ## ## Don't know how to test complex trigonometry properly.