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/source/lux/macro/syntax.lux | 1 + stdlib/source/lux/math.lux | 18 ++-- stdlib/source/lux/math/complex.lux | 176 ++++++++++++++++++++----------------- 3 files changed, 107 insertions(+), 88 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 1d3ef021d..bd8c755d3 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -129,6 +129,7 @@ [ bool bool? bool! Bool #;BoolS bool;Eq "bool"] [ nat nat? nat! Nat #;NatS number;Eq "nat"] [ int int? int! Int #;IntS number;Eq "int"] + [ frac frac? frac! Frac #;FracS number;Eq "frac"] [ real real? real! Real #;RealS number;Eq "real"] [ char char? char! Char #;CharS char;Eq "char"] [ text text? text! Text #;TextS text;Eq "text"] diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 12c32b853..543b2bd0b 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -12,7 +12,7 @@ text/format) host [compiler] - (macro ["s" syntax #+ syntax: Syntax "Syntax/" Functor] + (macro ["s" syntax #+ syntax: Syntax "s/" Functor] [ast]))) ## [Values] @@ -104,13 +104,15 @@ (-> Unit (Syntax Infix)) ($_ s;alt ($_ s;either - (Syntax/map ast;bool s;bool) - (Syntax/map ast;int s;int) - (Syntax/map ast;real s;real) - (Syntax/map ast;char s;char) - (Syntax/map ast;text s;text) - (Syntax/map ast;symbol s;symbol) - (Syntax/map ast;tag s;tag)) + (s/map ast;bool s;bool) + (s/map ast;nat s;nat) + (s/map ast;int s;int) + (s/map ast;frac s;frac) + (s/map ast;real s;real) + (s/map ast;char s;char) + (s/map ast;text s;text) + (s/map ast;symbol s;symbol) + (s/map ast;tag s;tag)) (s;form (s;many s;any)) (s;tuple (s;either (do s;Monad [_ (s;tag! ["" "and"]) diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux index 8e82d957f..6fac976b8 100644 --- a/stdlib/source/lux/math/complex.lux +++ b/stdlib/source/lux/math/complex.lux @@ -11,7 +11,7 @@ number codec monad) - (data [number "r:" Number Codec] + (data [number "r/" Number Codec] [text "Text/" Monoid] error maybe @@ -21,6 +21,7 @@ ["s" syntax #+ syntax: Syntax]))) ## Based on org.apache.commons.math4.complex.Complex +## https://github.com/apache/commons-math/blob/master/src/main/java/org/apache/commons/math4/complex/Complex.java (type: #export Complex {#real Real @@ -37,6 +38,10 @@ (def: #export zero Complex (complex 0.0 0.0)) +(def: #export (nan? complex) + (or (r.= number;nan (get@ #real complex)) + (r.= number;nan (get@ #imaginary complex)))) + (def: #export (c.= param input) (-> Complex Complex Bool) (and (r.= (get@ #real param) @@ -59,19 +64,19 @@ (struct: #export _ (Eq Complex) (def: = c.=)) -(def: #export negate +(def: #export c.negate (-> Complex Complex) - (|>. (update@ #real r:negate) - (update@ #imaginary r:negate))) + (|>. (update@ #real r/negate) + (update@ #imaginary r/negate))) -(def: #export signum +(def: #export c.signum (-> Complex Complex) - (|>. (update@ #real r:signum) - (update@ #imaginary r:signum))) + (|>. (update@ #real r/signum) + (update@ #imaginary r/signum))) (def: #export conjugate (-> Complex Complex) - (update@ #imaginary r:negate)) + (update@ #imaginary r/negate)) (def: #export (c.*' param input) (-> Real Complex Complex) @@ -91,94 +96,105 @@ (r.* (get@ #imaginary param) (get@ #real input)))}) -(def: #export (c./ (^slots [#real #imaginary]) input) +(def: #export (c./ param input) (-> Complex Complex Complex) - (if (r.< (r:abs imaginary) - (r:abs real)) - (let [quot (r./ imaginary real) - denom (|> real (r.* quot) (r.+ imaginary))] - {#real (|> (get@ #real input) (r.* quot) (r.+ (get@ #imaginary input)) (r./ denom)) - #imaginary (|> (get@ #imaginary input) (r.* quot) (r.- (get@ #real input)) (r./ denom))}) - (let [quot (r./ real imaginary) - denom (|> imaginary (r.* quot) (r.+ real))] - {#real (|> (get@ #imaginary input) (r.* quot) (r.+ (get@ #real input)) (r./ denom)) - #imaginary (|> (get@ #imaginary input) (r.- (r.* quot (get@ #real input))) (r./ denom))}))) - -(def: #export (c./' param (^slots [#real #imaginary])) + (let [(^slots [#real #imaginary]) param] + (if (r.< (r/abs imaginary) + (r/abs real)) + (let [quot (r./ imaginary real) + denom (|> real (r.* quot) (r.+ imaginary))] + {#real (|> (get@ #real input) (r.* quot) (r.+ (get@ #imaginary input)) (r./ denom)) + #imaginary (|> (get@ #imaginary input) (r.* quot) (r.- (get@ #real input)) (r./ denom))}) + (let [quot (r./ real imaginary) + denom (|> imaginary (r.* quot) (r.+ real))] + {#real (|> (get@ #imaginary input) (r.* quot) (r.+ (get@ #real input)) (r./ denom)) + #imaginary (|> (get@ #imaginary input) (r.- (r.* quot (get@ #real input))) (r./ denom))})))) + +(def: #export (c./' param subject) (-> Real Complex Complex) - {#real (r./ param real) - #imaginary (r./ param imaginary)}) + (let [(^slots [#real #imaginary]) subject] + {#real (r./ param real) + #imaginary (r./ param imaginary)})) -(def: #export (cos (^slots [#real #imaginary])) +(def: #export (cos subject) (-> Complex Complex) - {#real (r.* (math;cosh imaginary) - (math;cos real)) - #imaginary (r.* (math;sinh imaginary) - (r:negate (math;sin real)))}) + (let [(^slots [#real #imaginary]) subject] + {#real (r.* (math;cosh imaginary) + (math;cos real)) + #imaginary (r.* (math;sinh imaginary) + (r/negate (math;sin real)))})) -(def: #export (cosh (^slots [#real #imaginary])) +(def: #export (cosh subject) (-> Complex Complex) - {#real (r.* (math;cos imaginary) - (math;cosh real)) - #imaginary (r.* (math;sin imaginary) - (math;sinh real))}) + (let [(^slots [#real #imaginary]) subject] + {#real (r.* (math;cos imaginary) + (math;cosh real)) + #imaginary (r.* (math;sin imaginary) + (math;sinh real))})) -(def: #export (sin (^slots [#real #imaginary])) +(def: #export (sin subject) (-> Complex Complex) - {#real (r.* (math;cosh imaginary) - (math;sin real)) - #imaginary (r.* (math;sinh imaginary) - (math;cos real))}) + (let [(^slots [#real #imaginary]) subject] + {#real (r.* (math;cosh imaginary) + (math;sin real)) + #imaginary (r.* (math;sinh imaginary) + (math;cos real))})) -(def: #export (sinh (^slots [#real #imaginary])) +(def: #export (sinh subject) (-> Complex Complex) - {#real (r.* (math;cos imaginary) - (math;sinh real)) - #imaginary (r.* (math;sin imaginary) - (math;cosh real))}) + (let [(^slots [#real #imaginary]) subject] + {#real (r.* (math;cos imaginary) + (math;sinh real)) + #imaginary (r.* (math;sin imaginary) + (math;cosh real))})) -(def: #export (tan (^slots [#real #imaginary])) +(def: #export (tan subject) (-> Complex Complex) - (let [r2 (r.* 2.0 real) + (let [(^slots [#real #imaginary]) subject + r2 (r.* 2.0 real) i2 (r.* 2.0 imaginary) d (r.+ (math;cos r2) (math;cosh i2))] {#real (r./ d (math;sin r2)) #imaginary (r./ d (math;sinh i2))})) -(def: #export (tanh (^slots [#real #imaginary])) +(def: #export (tanh subject) (-> Complex Complex) - (let [r2 (r.* 2.0 real) + (let [(^slots [#real #imaginary]) subject + r2 (r.* 2.0 real) i2 (r.* 2.0 imaginary) d (r.+ (math;cosh r2) (math;cos i2))] {#real (r./ d (math;sinh r2)) #imaginary (r./ d (math;sin i2))})) -(def: #export (abs (^slots [#real #imaginary])) +(def: #export (c.abs subject) (-> Complex Real) - (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)))) - )) - -(def: #export (exp (^slots [#real #imaginary])) + (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)))) + ))) + +(def: #export (exp subject) (-> Complex Complex) - (let [r-exp (math;exp real)] + (let [(^slots [#real #imaginary]) subject + r-exp (math;exp real)] {#real (r.* r-exp (math;cos imaginary)) #imaginary (r.* r-exp (math;sin imaginary))})) -(def: #export (log (^@ input (^slots [#real #imaginary]))) +(def: #export (log subject) (-> Complex Complex) - {#real (math;log (abs input)) - #imaginary (math;atan2 real imaginary)}) + (let [(^slots [#real #imaginary]) subject] + {#real (math;log (c.abs subject)) + #imaginary (math;atan2 real imaginary)})) (do-template [ ] [(def: #export ( param input) @@ -191,17 +207,17 @@ (def: (copy-sign sign magnitude) (-> Real Real Real) - (r.* (r:signum sign) magnitude)) + (r.* (r/signum sign) magnitude)) (def: #export (sqrt (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input abs (r.+ (r:abs real)) (r./ 2.0) math;sqrt)] + (let [t (|> input c.abs (r.+ (r/abs real)) (r./ 2.0) math;sqrt)] (if (r.>= 0.0 real) {#real t #imaginary (r./ (r.* 2.0 t) imaginary)} {#real (r./ (r.* 2.0 t) - (r:abs imaginary)) + (r/abs imaginary)) #imaginary (r.* t (copy-sign imaginary 1.0))}))) (def: #export (sqrt-1z input) @@ -210,25 +226,25 @@ (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) - (if (r.< (r:abs imaginary) - (r:abs real)) + (if (r.< (r/abs imaginary) + (r/abs real)) (let [q (r./ imaginary real) scale (r./ (|> real (r.* q) (r.+ imaginary)) 1.0)] {#real (r.* q scale) - #imaginary (r:negate scale)}) + #imaginary (r/negate scale)}) (let [q (r./ real imaginary) scale (r./ (|> imaginary (r.* q) (r.+ real)) 1.0)] {#real scale - #imaginary (|> scale r:negate (r.* q))}))) + #imaginary (|> scale r/negate (r.* q))}))) (def: #export (acos input) (-> Complex Complex) (|> input (c.+ (|> input sqrt-1z (c.* i))) log - (c.* (negate i)))) + (c.* (c.negate i)))) (def: #export (asin input) (-> Complex Complex) @@ -236,7 +252,7 @@ sqrt-1z (c.+ (c.* i input)) log - (c.* (negate i)))) + (c.* (c.negate i)))) (def: #export (atan input) (-> Complex Complex) @@ -256,7 +272,7 @@ (list) (let [r-nth (|> nth nat-to-int int-to-real) nth-root-of-abs (math;pow (r./ r-nth 1.0) - (abs input)) + (c.abs input)) nth-phi (|> input argument (r./ r-nth)) slice (|> math;pi (r.* 2.0) (r./ r-nth))] (|> (list;n.range +0 (n.dec nth)) @@ -273,7 +289,7 @@ (struct: #export _ (Codec Text Complex) (def: (encode (^slots [#real #imaginary])) - ($_ Text/append "(" (r:encode real) ", " (r:encode imaginary) ")")) + ($_ Text/append "(" (r/encode real) ", " (r/encode imaginary) ")")) (def: (decode input) (case (do Monad @@ -284,8 +300,8 @@ (#;Some [r' i']) (do Monad - [r (r:decode (text;trim r')) - i (r:decode (text;trim i'))] + [r (r/decode (text;trim r')) + i (r/decode (text;trim i'))] (wrap {#real r #imaginary i})) ))) -- cgit v1.2.3