aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-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
3 files changed, 107 insertions, 88 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}))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 06:30:13 +0000