diff options
Diffstat (limited to 'stdlib/source/lux/data/number/complex.lux')
-rw-r--r-- | stdlib/source/lux/data/number/complex.lux | 180 |
1 files changed, 90 insertions, 90 deletions
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 7fc8af1dd..15fee133f 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -6,7 +6,7 @@ codec ["M" monad #+ do Monad] ["p" parser]) - (data [number "f/" Number<Frac> Codec<Text,Frac>] + (data [number "frac/" Number<Frac> "f/" Codec<Text,Frac>] [text "text/" Monoid<Text>] text/format ["E" error] @@ -41,9 +41,9 @@ (def: #export (c.= param input) (-> Complex Complex Bool) - (and (f.= (get@ #real param) + (and (f/= (get@ #real param) (get@ #real input)) - (f.= (get@ #imaginary param) + (f/= (get@ #imaginary param) (get@ #imaginary input)))) (do-template [<name> <op>] @@ -54,8 +54,8 @@ #imaginary (<op> (get@ #imaginary param) (get@ #imaginary input))})] - [c.+ f.+] - [c.- f.-] + [c.+ f/+] + [c.- f/-] ) (struct: #export _ (Eq Complex) @@ -63,55 +63,55 @@ (def: #export c.negate (-> Complex Complex) - (|>. (update@ #real f/negate) - (update@ #imaginary f/negate))) + (|>. (update@ #real frac/negate) + (update@ #imaginary frac/negate))) (def: #export c.signum (-> Complex Complex) - (|>. (update@ #real f/signum) - (update@ #imaginary f/signum))) + (|>. (update@ #real frac/signum) + (update@ #imaginary frac/signum))) (def: #export conjugate (-> Complex Complex) - (update@ #imaginary f/negate)) + (update@ #imaginary frac/negate)) (def: #export (c.*' param input) (-> Frac Complex Complex) - {#real (f.* param + {#real (f/* param (get@ #real input)) - #imaginary (f.* param + #imaginary (f/* param (get@ #imaginary input))}) (def: #export (c.* param input) (-> Complex Complex Complex) - {#real (f.- (f.* (get@ #imaginary param) + {#real (f/- (f/* (get@ #imaginary param) (get@ #imaginary input)) - (f.* (get@ #real param) + (f/* (get@ #real param) (get@ #real input))) - #imaginary (f.+ (f.* (get@ #real param) + #imaginary (f/+ (f/* (get@ #real param) (get@ #imaginary input)) - (f.* (get@ #imaginary param) + (f/* (get@ #imaginary param) (get@ #real input)))}) (def: #export (c./ param input) (-> Complex Complex Complex) (let [(^slots [#real #imaginary]) param] - (if (f.< (f/abs imaginary) - (f/abs real)) - (let [quot (f./ imaginary real) - denom (|> real (f.* quot) (f.+ imaginary))] - {#real (|> (get@ #real input) (f.* quot) (f.+ (get@ #imaginary input)) (f./ denom)) - #imaginary (|> (get@ #imaginary input) (f.* quot) (f.- (get@ #real input)) (f./ denom))}) - (let [quot (f./ real imaginary) - denom (|> imaginary (f.* quot) (f.+ real))] - {#real (|> (get@ #imaginary input) (f.* quot) (f.+ (get@ #real input)) (f./ denom)) - #imaginary (|> (get@ #imaginary input) (f.- (f.* quot (get@ #real input))) (f./ denom))})))) + (if (f/< (frac/abs imaginary) + (frac/abs real)) + (let [quot (f// imaginary real) + denom (|> real (f/* quot) (f/+ imaginary))] + {#real (|> (get@ #real input) (f/* quot) (f/+ (get@ #imaginary input)) (f// denom)) + #imaginary (|> (get@ #imaginary input) (f/* quot) (f/- (get@ #real input)) (f// denom))}) + (let [quot (f// real imaginary) + denom (|> imaginary (f/* quot) (f/+ real))] + {#real (|> (get@ #imaginary input) (f/* quot) (f/+ (get@ #real input)) (f// denom)) + #imaginary (|> (get@ #imaginary input) (f/- (f/* quot (get@ #real input))) (f// denom))})))) (def: #export (c./' param subject) (-> Frac Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f./ param real) - #imaginary (f./ param imaginary)})) + {#real (f// param real) + #imaginary (f// param imaginary)})) (def: #export (c.% param input) (-> Complex Complex Complex) @@ -125,68 +125,68 @@ (def: #export (cos subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f.* (math;cosh imaginary) + {#real (f/* (math;cosh imaginary) (math;cos real)) - #imaginary (f.* (math;sinh imaginary) - (f/negate (math;sin real)))})) + #imaginary (f/* (math;sinh imaginary) + (frac/negate (math;sin real)))})) (def: #export (cosh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f.* (math;cos imaginary) + {#real (f/* (math;cos imaginary) (math;cosh real)) - #imaginary (f.* (math;sin imaginary) + #imaginary (f/* (math;sin imaginary) (math;sinh real))})) (def: #export (sin subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f.* (math;cosh imaginary) + {#real (f/* (math;cosh imaginary) (math;sin real)) - #imaginary (f.* (math;sinh imaginary) + #imaginary (f/* (math;sinh imaginary) (math;cos real))})) (def: #export (sinh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f.* (math;cos imaginary) + {#real (f/* (math;cos imaginary) (math;sinh real)) - #imaginary (f.* (math;sin imaginary) + #imaginary (f/* (math;sin imaginary) (math;cosh real))})) (def: #export (tan subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r2 (f.* 2.0 real) - i2 (f.* 2.0 imaginary) - d (f.+ (math;cos r2) (math;cosh i2))] - {#real (f./ d (math;sin r2)) - #imaginary (f./ d (math;sinh i2))})) + r2 (f/* 2.0 real) + i2 (f/* 2.0 imaginary) + d (f/+ (math;cos r2) (math;cosh i2))] + {#real (f// d (math;sin r2)) + #imaginary (f// d (math;sinh i2))})) (def: #export (tanh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r2 (f.* 2.0 real) - i2 (f.* 2.0 imaginary) - d (f.+ (math;cosh r2) (math;cos i2))] - {#real (f./ d (math;sinh r2)) - #imaginary (f./ d (math;sin i2))})) + r2 (f/* 2.0 real) + i2 (f/* 2.0 imaginary) + d (f/+ (math;cosh r2) (math;cos i2))] + {#real (f// d (math;sinh r2)) + #imaginary (f// d (math;sin i2))})) (def: #export (c.abs subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - (complex (if (f.< (f/abs imaginary) - (f/abs real)) - (if (f.= 0.0 imaginary) - (f/abs real) - (let [q (f./ imaginary real)] - (f.* (math;root2 (f.+ 1.0 (f.* q q))) - (f/abs imaginary)))) - (if (f.= 0.0 real) - (f/abs imaginary) - (let [q (f./ real imaginary)] - (f.* (math;root2 (f.+ 1.0 (f.* q q))) - (f/abs real)))) + (complex (if (f/< (frac/abs imaginary) + (frac/abs real)) + (if (f/= 0.0 imaginary) + (frac/abs real) + (let [q (f// imaginary real)] + (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (frac/abs imaginary)))) + (if (f/= 0.0 real) + (frac/abs imaginary) + (let [q (f// real imaginary)] + (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (frac/abs real)))) )))) (struct: #export _ (Number Complex) @@ -197,20 +197,20 @@ (def: % c.%) (def: (negate x) (|> x - (update@ #real f/negate) - (update@ #imaginary f/negate))) + (update@ #real frac/negate) + (update@ #imaginary frac/negate))) (def: abs c.abs) (def: (signum x) (|> x - (update@ #real f/signum) - (update@ #imaginary f/signum)))) + (update@ #real frac/signum) + (update@ #imaginary frac/signum)))) (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r-exp (math;exp real)] - {#real (f.* r-exp (math;cos imaginary)) - #imaginary (f.* r-exp (math;sin imaginary))})) + {#real (f/* r-exp (math;cos imaginary)) + #imaginary (f/* r-exp (math;sin imaginary))})) (def: #export (log subject) (-> Complex Complex) @@ -229,18 +229,18 @@ (def: (copy-sign sign magnitude) (-> Frac Frac Frac) - (f.* (f/signum sign) magnitude)) + (f/* (frac/signum sign) magnitude)) (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c.abs (get@ #real) (f.+ (f/abs real)) (f./ 2.0) math;root2)] - (if (f.>= 0.0 real) + (let [t (|> input c.abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math;root2)] + (if (f/>= 0.0 real) {#real t - #imaginary (f./ (f.* 2.0 t) + #imaginary (f// (f/* 2.0 t) imaginary)} - {#real (f./ (f.* 2.0 t) - (f/abs imaginary)) - #imaginary (f.* t (copy-sign imaginary 1.0))}))) + {#real (f// (f/* 2.0 t) + (frac/abs imaginary)) + #imaginary (f/* t (copy-sign imaginary 1.0))}))) (def: #export (root2-1z input) (-> Complex Complex) @@ -248,18 +248,18 @@ (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) - (if (f.< (f/abs imaginary) - (f/abs real)) - (let [q (f./ imaginary real) - scale (f./ (|> real (f.* q) (f.+ imaginary)) + (if (f/< (frac/abs imaginary) + (frac/abs real)) + (let [q (f// imaginary real) + scale (f// (|> real (f/* q) (f/+ imaginary)) 1.0)] - {#real (f.* q scale) - #imaginary (f/negate scale)}) - (let [q (f./ real imaginary) - scale (f./ (|> imaginary (f.* q) (f.+ real)) + {#real (f/* q scale) + #imaginary (frac/negate scale)}) + (let [q (f// real imaginary) + scale (f// (|> imaginary (f/* q) (f/+ real)) 1.0)] {#real scale - #imaginary (|> scale f/negate (f.* q))}))) + #imaginary (|> scale frac/negate (f/* q))}))) (def: #export (acos input) (-> Complex Complex) @@ -290,20 +290,20 @@ (def: #export (nth-roots nth input) (-> Nat Complex (List Complex)) - (if (n.= +0 nth) + (if (n/= +0 nth) (list) (let [r-nth (|> nth nat-to-int int-to-frac) - nth-root-of-abs (|> input c.abs (get@ #real) (math;pow (f./ r-nth 1.0))) - nth-phi (|> input argument (f./ r-nth)) - slice (|> math;pi (f.* 2.0) (f./ r-nth))] - (|> (list;n.range +0 (n.dec nth)) + nth-root-of-abs (|> input c.abs (get@ #real) (math;pow (f// r-nth 1.0))) + nth-phi (|> input argument (f// r-nth)) + slice (|> math;pi (f/* 2.0) (f// r-nth))] + (|> (list;n/range +0 (n/dec nth)) (L/map (function [nth'] (let [inner (|> nth' nat-to-int int-to-frac - (f.* slice) - (f.+ nth-phi)) - real (f.* nth-root-of-abs + (f/* slice) + (f/+ nth-phi)) + real (f/* nth-root-of-abs (math;cos inner)) - imaginary (f.* nth-root-of-abs + imaginary (f/* nth-root-of-abs (math;sin inner))] {#real real #imaginary imaginary}))))))) |