diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/math/complex.lux | 60 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math/complex.lux | 35 |
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. |