diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/math.lux | 111 |
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) |