aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/macro/syntax.lux1
-rw-r--r--stdlib/source/lux/math.lux18
-rw-r--r--stdlib/source/lux/math/complex.lux176
-rw-r--r--stdlib/test/test/lux/math.lux144
-rw-r--r--stdlib/test/test/lux/math/complex.lux182
-rw-r--r--stdlib/test/tests.lux18
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]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:10:54 +0000