aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/math.lux111
1 files changed, 97 insertions, 14 deletions
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 4d65c75b8..64ee13480 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -2,8 +2,9 @@
lux
(lux (control monad
["p" parser "p/" Functor<Parser>])
- (data (coll [list "L/" Fold<List>])
- [product])
+ (data [product]
+ [number]
+ (coll [list "L/" Fold<List>]))
[macro]
(macro ["s" syntax #+ syntax: Syntax]
[code])))
@@ -33,26 +34,49 @@
[asin "lux math asin"]
[atan "lux math atan"]
- [cosh "lux math cosh"]
- [sinh "lux math sinh"]
- [tanh "lux math tanh"]
-
[exp "lux math exp"]
[log "lux math log"]
[ceil "lux math ceil"]
[floor "lux math floor"]
- [round "lux math round"]
)
-(do-template [<name> <method>]
- [(def: #export (<name> param subject)
- (-> Frac Frac Frac)
- (<method> subject param))]
+(def: #export (round input)
+ (-> Frac Frac)
+ (let [floored (floor input)
+ diff (f/- floored input)]
+ (cond (f/> 0.5 diff)
+ (f/+ 1.0 floored)
+
+ (f/< -0.5 diff)
+ (f/+ -1.0 floored)
+
+ ## else
+ floored)))
- [atan2 "lux math atan2"]
- [pow "lux math pow"]
- )
+(def: #export (pow param subject)
+ (-> Frac Frac Frac)
+ ("lux math pow" subject param))
+
+(def: #export (atan2 param subject)
+ (-> Frac Frac Frac)
+ (cond (f/> 0.0 param)
+ (atan (f// param subject))
+
+ (f/< 0.0 param)
+ (if (f/>= 0.0 subject)
+ (|> subject (f// param) atan (f/+ pi))
+ (|> subject (f// param) atan (f/- pi)))
+
+ ## (f/= 0.0 param)
+ (cond (f/> 0.0 subject)
+ (|> pi (f// 2.0))
+
+ (f/< 0.0 subject)
+ (|> pi (f// -2.0))
+
+ ## (f/= 0.0 subject)
+ number.not-a-number)))
(def: #export (log' base input)
(-> Frac Frac Frac)
@@ -95,6 +119,65 @@
[Int i/mod i/gcd i/lcm 0 i/* i// i/-]
)
+## Hyperbolic functions
+## https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions
+(do-template [<name> <comp> <inverse>]
+ [(def: #export (<name> x)
+ (-> Frac Frac)
+ (|> (exp x) (<comp> (exp (f/* -1.0 x))) (f// 2.0)))
+
+ (def: #export (<inverse> x)
+ (-> Frac Frac)
+ (|> 2.0 (f// (|> (exp x) (<comp> (exp (f/* -1.0 x)))))))]
+
+ [sinh f/- csch]
+ [cosh f/+ sech]
+ )
+
+(do-template [<name> <top> <bottom>]
+ [(def: #export (<name> x)
+ (-> Frac Frac)
+ (let [e+ (exp x)
+ e- (exp (f/* -1.0 x))
+ sinh' (|> e+ (f/- e-))
+ cosh' (|> e+ (f/+ e-))]
+ (|> <top> (f// <bottom>))))]
+
+ [tanh sinh' cosh']
+ [coth cosh' sinh']
+ )
+
+## https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms
+(do-template [<name> <comp>]
+ [(def: #export (<name> x)
+ (-> Frac Frac)
+ (|> x (pow 2.0) (<comp> 1.0) (pow 0.5) (f/+ x) log))]
+
+ [asinh f/+]
+ [acosh f/-]
+ )
+
+(do-template [<name> <base> <diff>]
+ [(def: #export (<name> x)
+ (-> Frac Frac)
+ (let [x+ (|> <base> (f/+ <diff>))
+ x- (|> <base> (f/- <diff>))]
+ (|> x+ (f// x-) log (f// 2.0))))]
+
+ [atanh 1.0 x]
+ [acoth x 1.0]
+ )
+
+(do-template [<name> <op>]
+ [(def: #export (<name> x)
+ (-> Frac Frac)
+ (let [x^2 (|> x (pow 2.0))]
+ (|> 1.0 (<op> x^2) (pow 0.5) (f/+ 1.0) (f// x) log)))]
+
+ [asech f/-]
+ [acsch f/+]
+ )
+
## [Syntax]
(type: #rec Infix
(#Const Code)