diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/math.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/math/complex.lux | 176 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math.lux | 144 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math/complex.lux | 182 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 18 |
6 files changed, 408 insertions, 131 deletions
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> "bool"] [ nat nat? nat! Nat #;NatS number;Eq<Nat> "nat"] [ int int? int! Int #;IntS number;Eq<Int> "int"] + [ frac frac? frac! Frac #;FracS number;Eq<Frac> "frac"] [ real real? real! Real #;RealS number;Eq<Real> "real"] [ char char? char! Char #;CharS char;Eq<Char> "char"] [ text text? text! Text #;TextS text;Eq<Text> "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<Syntax>] + (macro ["s" syntax #+ syntax: Syntax "s/" Functor<Syntax>] [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<Syntax> [_ (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<Real> Codec<Text,Real>] + (data [number "r/" Number<Real> Codec<Text,Real>] [text "Text/" Monoid<Text>] 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 [<name> <type> <op>] [(def: #export (<name> 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<Maybe> @@ -284,8 +300,8 @@ (#;Some [r' i']) (do Monad<Error> - [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})) ))) 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] |