From d710d9f4fc098e7c243c8a5f23cd42683f13e07f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 Mar 2022 04:22:45 -0400 Subject: Generalized/type-agnostic arithmetic. --- stdlib/source/library/lux/data/color.lux | 41 +- stdlib/source/library/lux/extension.lux | 4 +- stdlib/source/library/lux/math.lux | 636 ++++++++-------------- stdlib/source/library/lux/math/number/complex.lux | 111 ++-- stdlib/source/library/lux/math/number/frac.lux | 442 ++++++++++++++- stdlib/source/library/lux/math/number/int.lux | 31 +- stdlib/source/library/lux/math/number/nat.lux | 10 +- stdlib/source/library/lux/math/number/rev.lux | 10 +- stdlib/source/library/lux/static.lux | 13 +- 9 files changed, 759 insertions(+), 539 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index e327ff261..093a2b6ba 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -1,25 +1,22 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}] - ["[0]" hash {"+" Hash}]] - [control - [parser - ["<[0]>" code]]] - [data - [collection - ["[0]" list ("[1]#[0]" functor)]]] - ["[0]" math - [number - ["n" nat] - ["f" frac] - ["[0]" int] - ["[0]" rev ("[1]#[0]" interval)] - ["[0]" i64]]] - [type - abstract]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}] + ["[0]" hash {"+" Hash}]] + [data + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + [number + ["n" nat] + ["f" frac] + ["[0]" int] + ["[0]" rev ("[1]#[0]" interval)] + ["[0]" i64]]] + [type + abstract]]]) (def: rgb_limit 256) (def: top (-- rgb_limit)) @@ -244,7 +241,7 @@ (def: .public (of_hsb [hue saturation brightness]) (-> HSB Color) (let [hue (|> hue (f.* +6.0)) - i (math.floor hue) + i (f.floor hue) f (|> hue (f.- i)) p (|> +1.0 (f.- saturation) (f.* brightness)) q (|> +1.0 (f.- (f.* f saturation)) (f.* brightness)) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index cabab0a8f..2e2c74f23 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -13,8 +13,8 @@ [collection ["[0]" list ("[1]#[0]" functor)]]] [macro {"+" with_symbols} - ["[0]" code] - [syntax {"+" syntax:}]] + [syntax {"+" syntax:}] + ["[0]" code]] [tool [compiler ["[0]" phase]]]]]) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index f9df0dd73..7395cb180 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -1,414 +1,228 @@ (.using [library [lux "*" - ["@" target] - [math - [number - ["n" nat] - ["i" int]]]]]) - -(template [ ] - [(def: .public - )] - - [e +2.7182818284590452354] - ... ["π is wrong!" by Bob Palais](https://www.math.utah.edu/~palais/pi.html) - [pi +3.14159265358979323846] - ... [The Tau Manifesto](https://tauday.com/tau-manifesto) - [tau +6.28318530717958647692] - ) - -(for @.old - (as_is (template [ ] - [(def: .public ( it) - (-> Frac Frac) - ( it))] - - [cos "jvm invokestatic:java.lang.Math:cos:double"] - [sin "jvm invokestatic:java.lang.Math:sin:double"] - [tan "jvm invokestatic:java.lang.Math:tan:double"] - - [acos "jvm invokestatic:java.lang.Math:acos:double"] - [asin "jvm invokestatic:java.lang.Math:asin:double"] - [atan "jvm invokestatic:java.lang.Math:atan:double"] - - [exp "jvm invokestatic:java.lang.Math:exp:double"] - [log "jvm invokestatic:java.lang.Math:log:double"] - - [ceil "jvm invokestatic:java.lang.Math:ceil:double"] - [floor "jvm invokestatic:java.lang.Math:floor:double"] - - [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] - [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] - ) - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) - - @.jvm - (as_is (template: (!double value) - [(|> value - (:as (Primitive "java.lang.Double")) - "jvm object cast")]) - - (template: (!frac value) - [(|> value - "jvm object cast" - (: (Primitive "java.lang.Double")) - (:as Frac))]) - - (template [ ] - [(def: .public - (-> Frac Frac) - (|>> !double - ["D"] - ("jvm member invoke static" [] "java.lang.Math" []) - !frac))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - [root/3 "cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] - ["D" (!double subject)] ["D" (!double param)]) - !frac))) - - @.js - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("js apply" ("js constant" )) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [ceil "Math.ceil"] - [floor "Math.floor"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) - - @.python - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("python object do" ("python import" "math")) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.lua - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("lua apply" ("lua constant" )) - (:as Frac)))] - - [cos "math.cos"] - [sin "math.sin"] - [tan "math.tan"] - - [acos "math.acos"] - [asin "math.asin"] - [atan "math.atan"] - - [exp "math.exp"] - [log "math.log"] - - [ceil "math.ceil"] - [floor "math.floor"] - - [root/2 "math.sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("lua power" param subject)) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.ruby - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("ruby apply" ("ruby constant" )) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (template [ ] - [(def: .public ( it) - (-> Frac Frac) - (|> ("ruby object do" it []) - (:as Int) - ("lux i64 f64")))] - - [ceil "ceil"] - [floor "floor"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("ruby object do" "**" subject [param])))) - - @.php - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> ("php apply" ("php constant" )) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("php apply" ("php constant" "pow") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - - @.scheme - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> ("scheme apply" ("scheme constant" )) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceiling"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - ) - -(def: .public (round it) - (-> Frac Frac) - (let [floored (floor it) - diff ("lux f64 -" floored it)] - (cond ("lux f64 <" diff +0.5) - ("lux f64 +" +1.0 floored) - - ("lux f64 <" -0.5 diff) - ("lux f64 +" -1.0 floored) - - ... else - floored))) - -(def: .public (atan/2 x y) - (-> Frac Frac Frac) - (cond ("lux f64 <" x +0.0) - (..atan ("lux f64 /" x y)) - - ("lux f64 <" +0.0 x) - (if (or ("lux f64 <" y +0.0) - ("lux f64 =" +0.0 y)) - (|> y ("lux f64 /" x) atan ("lux f64 +" pi)) - (|> y ("lux f64 /" x) atan ("lux f64 -" pi))) - - ... ("lux f64 =" +0.0 x) - (cond ("lux f64 <" y +0.0) - (|> pi ("lux f64 /" +2.0)) - - ("lux f64 <" +0.0 y) - (|> pi ("lux f64 /" -2.0)) - - ... ("lux f64 =" +0.0 y) - ("lux f64 /" +0.0 +0.0)))) - -(def: .public (log_by base it) - (-> Frac Frac Frac) - ("lux f64 /" - (..log base) - (..log it))) - -(def: .public (factorial it) - (-> Nat Nat) - (loop [acc 1 - it it] - (if (n.> 1 it) - (again (n.* it acc) (-- it)) - acc))) - -(def: .public (hypotenuse catA catB) - (-> Frac Frac Frac) - (..pow +0.5 ("lux f64 +" - (..pow +2.0 catA) - (..pow +2.0 catB)))) - -... Hyperbolic functions -... https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions -(template [ ] - [(def: .public ( it) - (-> Frac Frac) - (|> (..exp it) ( (..exp ("lux f64 *" -1.0 it))) ("lux f64 /" +2.0))) - - (def: .public ( it) - (-> Frac Frac) - (|> +2.0 ("lux f64 /" (|> (..exp it) ( (..exp ("lux f64 *" -1.0 it)))))))] - - [sinh "lux f64 -" csch] - [cosh "lux f64 +" sech] - ) - -(template [ ] - [(def: .public ( it) - (-> Frac Frac) - (let [e+ (exp it) - e- (exp ("lux f64 *" -1.0 it)) - sinh' (|> e+ ("lux f64 -" e-)) - cosh' (|> e+ ("lux f64 +" e-))] - (|> ("lux f64 /" ))))] - - [tanh sinh' cosh'] - [coth cosh' sinh'] - ) - -... https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms -(template [ ] - [(def: .public ( it) - (-> Frac Frac) - (|> it (pow +2.0) ( +1.0) (pow +0.5) ("lux f64 +" it) log))] - - [asinh "lux f64 +"] - [acosh "lux f64 -"] - ) - -(template [ ] - [(def: .public ( it) - (-> Frac Frac) - (let [it+ (|> ("lux f64 +" )) - it- (|> ("lux f64 -" ))] - (|> it+ ("lux f64 /" it-) log ("lux f64 /" +2.0))))] - - [atanh +1.0 it] - [acoth it +1.0] - ) - -(template [ ] - [(def: .public ( it) - (-> Frac Frac) - (let [it^2 (|> it (pow +2.0))] - (|> +1.0 ( it^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" it) log)))] - - [asech "lux f64 -"] - [acsch "lux f64 +"] - ) + [extension {"+" analysis:}] + ["[0]" static] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code]]] + [data + [text + ["%" format]] + [collection + ["[0]" list ("[1]#[0]" mix)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" template]] + [tool + [compiler + ["[0]" phase ("[1]#[0]" monad)] + [language + [lux + ["[0]" analysis {"+" Analysis Operation Phase} + ["[0]" type]]]] + [meta + [archive {"+" Archive}]]]] + [type + ["[0]" check]]]] + [/ + ["[0]" random] + [number + ["[0]" nat] + ["[0]" int] + ["[0]" rev] + ["[0]" frac] + ["[0]" ratio {"+" Ratio}] + ["[0]" complex {"+" Complex}]]]) + +(exception: (no_arithmetic_for [type Type]) + (exception.report + "Type" (%.type type))) + +(def: (composite phase archive <+> last prevs) + (-> Phase Archive Code Analysis (List Analysis) (Operation Analysis)) + (case <+> + [_ {.#Text $}] + (phase#in (list#mix (function (_ left right) + {analysis.#Extension $ (list left right)}) + last + prevs)) + + _ + (do phase.monad + [[_ $] (type.inferring + (phase archive <+>))] + (in (list#mix (function (_ left right) + (analysis.reified [$ (list left right)])) + last + prevs))))) + +(with_expansions [<@> (static.text (let [[@ _] (symbol .._)] @)) + [ratio.#numerator 0 ratio.#denominator 1] + [ratio.#numerator 1 ratio.#denominator 1] + [complex.#real +0.0 complex.#imaginary +0.0] + [complex.#real +1.0 complex.#imaginary +0.0]] + (as_is (template [ '] + [(with_expansions [ (static.seed) + (template.text [<@> " " ]) + (template.spliced ')] + (as_is (analysis: ( self phase archive [operands (<>.some .any)]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [operands (monad.each ! (|>> (phase archive) (type.expecting :it:)) + operands) + _ (type.inference :it:) + :it: (type.check (check.identity (list) $it))] + (case (list.reversed operands) + (pattern (list single)) + (in single) + + (pattern (list)) + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [ <0> <+>] + [(check.subsumes? :it:) + <0>] + + )) + + ... else + (phase.except ..no_arithmetic_for [:it:]))) + + (pattern (list& last prevs)) + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [ <0> <+>] + [(check.subsumes? :it:) + (..composite phase archive (` <+>) last prevs)] + + )) + + ... else + (phase.except ..no_arithmetic_for [:it:]))))))) + (syntax: .public ( [operands (<>.some .any)]) + (in (list (` ( (~+ operands))))))))] + + [+ [[.Nat (in (analysis.nat 0)) "lux i64 +"] + [.Int (in (analysis.int +0)) "lux i64 +"] + [.Rev (in (analysis.rev .0)) "lux i64 +"] + [.Frac (in (analysis.frac +0.0)) "lux f64 +"] + [Ratio (type.expecting Ratio (phase archive (` ))) ratio.+] + [Complex (type.expecting Complex (phase archive (` ))) complex.+]]] + [- [[.Nat (in (analysis.nat 0)) "lux i64 -"] + [.Int (in (analysis.int -0)) "lux i64 -"] + [.Rev (in (analysis.rev .0)) "lux i64 -"] + [.Frac (in (analysis.frac -0.0)) "lux f64 -"] + [Ratio (type.expecting Ratio (phase archive (` ))) ratio.-] + [Complex (type.expecting Complex (phase archive (` ))) complex.-]]] + [* [[.Nat (in (analysis.nat 1)) nat.*] + [.Int (in (analysis.int +1)) "lux i64 *"] + [.Rev (in (analysis.rev rev./1)) rev.*] + [.Frac (in (analysis.frac +1.0)) "lux f64 *"] + [Ratio (type.expecting Ratio (phase archive (` ))) ratio.*] + [Complex (type.expecting Complex (phase archive (` ))) complex.*]]] + [/ [[.Nat (in (analysis.nat 1)) nat./] + [.Int (in (analysis.int +1)) "lux i64 /"] + [.Rev (in (analysis.rev rev./1)) rev./] + [.Frac (in (analysis.frac +1.0)) "lux f64 /"] + [Ratio (type.expecting Ratio (phase archive (` ))) ratio./] + [Complex (type.expecting Complex (phase archive (` ))) complex./]]] + ) + (template [ '] + [(with_expansions [ (static.seed) + (template.text [<@> " " ]) + (template.spliced ')] + (as_is (analysis: ( self phase archive [left .any + right .any]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [left (type.expecting :it: (phase archive left)) + right (type.expecting :it: (phase archive right)) + _ (type.inference .Bit) + :it: (type.check (check.identity (list) $it))] + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [ <+>] + [(check.subsumes? :it:) + (..composite phase archive (` <+>) right (list left))] + + )) + + ... else + (phase.except ..no_arithmetic_for [:it:])))))) + (syntax: .public ( [left .any + right .any]) + (in (list (` ( (~ left) (~ right))))))))] + + [= [[.Nat "lux i64 ="] + [.Int "lux i64 ="] + [.Rev "lux i64 ="] + [.Frac "lux f64 ="] + [Ratio ratio.=] + [Complex complex.=]]] + [< [[.Nat nat.<] + [.Int "lux i64 <"] + [.Rev rev.<] + [.Frac "lux f64 <"] + [Ratio ratio.<]]] + [> [[.Nat nat.>] + [.Int int.>] + [.Rev rev.>] + [.Frac frac.>] + [Ratio ratio.>]]] + [<= [[.Nat nat.<=] + [.Int int.<=] + [.Rev rev.<=] + [.Frac frac.<=] + [Ratio ratio.<=]]] + [>= [[.Nat nat.>=] + [.Int int.>=] + [.Rev rev.>=] + [.Frac frac.>=] + [Ratio ratio.>=]]] + ) + (template [ '] + [(with_expansions [ (static.seed) + (template.text [<@> " " ]) + (template.spliced ')] + (as_is (analysis: ( self phase archive [left .any + right .any]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [left (type.expecting :it: (phase archive left)) + right (type.expecting :it: (phase archive right)) + _ (type.inference :it:) + :it: (type.check (check.identity (list) $it))] + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [ <+>] + [(check.subsumes? :it:) + (..composite phase archive (` <+>) right (list left))] + + )) + + ... else + (phase.except ..no_arithmetic_for [:it:])))))) + (syntax: .public ( [left .any + right .any]) + (in (list (` ( (~ left) (~ right))))))))] + + [% [[.Nat nat.%] + [.Int "lux i64 %"] + [.Rev rev.%] + [.Frac "lux f64 %"] + [Ratio ratio.%] + [Complex complex.%]]] + ) + )) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 52947b51b..470a9bfbf 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -1,24 +1,19 @@ (.using [library [lux "*" - ["[0]" math] [abstract - [equivalence {"+" Equivalence}] - [codec {"+" Codec}] - ["M" monad {"+" Monad do}]] + [equivalence {"+" Equivalence}]] [control ["[0]" maybe] ["<>" parser - ["<[0]>" code {"+" Parser}]]] + ["<[0]>" code]]] [data [collection ["[0]" list ("[1]#[0]" functor)]]] [macro - [syntax {"+" syntax:}] - ["[0]" code]] + [syntax {"+" syntax:}]] [math [number - ["n" nat] ["f" frac] ["[0]" int]]]]]) @@ -133,60 +128,60 @@ (-> Complex Complex Complex) (let [scaled (/ param input) quotient (|> scaled - (revised #real math.floor) - (revised #imaginary math.floor))] + (revised #real f.floor) + (revised #imaginary f.floor))] (- (* quotient param) input))) (def: .public (cos subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cosh #imaginary) - (math.cos #real)) - ..#imaginary (f.opposite (f.* (math.sinh #imaginary) - (math.sin #real)))])) + [..#real (f.* (f.cosh #imaginary) + (f.cos #real)) + ..#imaginary (f.opposite (f.* (f.sinh #imaginary) + (f.sin #real)))])) (def: .public (cosh subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cos #imaginary) - (math.cosh #real)) - ..#imaginary (f.* (math.sin #imaginary) - (math.sinh #real))])) + [..#real (f.* (f.cos #imaginary) + (f.cosh #real)) + ..#imaginary (f.* (f.sin #imaginary) + (f.sinh #real))])) (def: .public (sin subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cosh #imaginary) - (math.sin #real)) - ..#imaginary (f.* (math.sinh #imaginary) - (math.cos #real))])) + [..#real (f.* (f.cosh #imaginary) + (f.sin #real)) + ..#imaginary (f.* (f.sinh #imaginary) + (f.cos #real))])) (def: .public (sinh subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cos #imaginary) - (math.sinh #real)) - ..#imaginary (f.* (math.sin #imaginary) - (math.cosh #real))])) + [..#real (f.* (f.cos #imaginary) + (f.sinh #real)) + ..#imaginary (f.* (f.sin #imaginary) + (f.cosh #real))])) (def: .public (tan subject) (-> Complex Complex) (let [(open "[0]") 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))])) + d (f.+ (f.cos r2) (f.cosh i2))] + [..#real (f./ d (f.sin r2)) + ..#imaginary (f./ d (f.sinh i2))])) (def: .public (tanh subject) (-> Complex Complex) (let [(open "[0]") 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))])) + d (f.+ (f.cosh r2) (f.cos i2))] + [..#real (f./ d (f.sinh r2)) + ..#imaginary (f./ d (f.sin i2))])) (def: .public (abs subject) (-> Complex Frac) @@ -196,26 +191,26 @@ (if (f.= +0.0 #imaginary) (f.abs #real) (let [q (f./ #imaginary #real)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.* (f.pow +0.5 (f.+ +1.0 (f.* q q))) (f.abs #imaginary)))) (if (f.= +0.0 #real) (f.abs #imaginary) (let [q (f./ #real #imaginary)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.* (f.pow +0.5 (f.+ +1.0 (f.* q q))) (f.abs #real))))))) (def: .public (exp subject) (-> Complex Complex) (let [(open "[0]") subject - r_exp (math.exp #real)] - [..#real (f.* r_exp (math.cos #imaginary)) - ..#imaginary (f.* r_exp (math.sin #imaginary))])) + r_exp (f.exp #real)] + [..#real (f.* r_exp (f.cos #imaginary)) + ..#imaginary (f.* r_exp (f.sin #imaginary))])) (def: .public (log subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (|> subject ..abs math.log) - ..#imaginary (math.atan/2 #real #imaginary)])) + [..#real (|> subject ..abs f.log) + ..#imaginary (f.atan/2 #real #imaginary)])) (template [ ] [(def: .public ( param input) @@ -233,7 +228,7 @@ (def: .public (root/2 input) (-> Complex Complex) (let [(open "[0]") input - t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (math.pow +0.5))] + t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (f.pow +0.5))] (if (f.< +0.0 #real) [..#real (f./ (f.* +2.0 t) (f.abs #imaginary)) @@ -286,27 +281,27 @@ (def: .public (argument (open "[0]")) (-> Complex Frac) - (math.atan/2 #real #imaginary)) + (f.atan/2 #real #imaginary)) (def: .public (roots nth input) (-> Nat Complex (List Complex)) - (if (n.= 0 nth) - (list) - (let [r_nth (|> nth .int int.frac) - nth_root_of_abs (|> input ..abs (math.pow (f./ r_nth +1.0))) - nth_phi (|> input ..argument (f./ r_nth)) - slice (|> math.pi (f.* +2.0) (f./ r_nth))] - (|> (list.indices nth) - (list#each (function (_ nth') - (let [inner (|> nth' .int int.frac - (f.* slice) - (f.+ nth_phi)) - real (f.* nth_root_of_abs - (math.cos inner)) - imaginary (f.* nth_root_of_abs - (math.sin inner))] - [..#real real - ..#imaginary imaginary]))))))) + (case nth + 0 (list) + _ (let [r_nth (|> nth .int int.frac) + nth_root_of_abs (|> input ..abs (f.pow (f./ r_nth +1.0))) + nth_phi (|> input ..argument (f./ r_nth)) + slice (|> f.pi (f.* +2.0) (f./ r_nth))] + (|> (list.indices nth) + (list#each (function (_ nth') + (let [inner (|> nth' .int int.frac + (f.* slice) + (f.+ nth_phi)) + real (f.* nth_root_of_abs + (f.cos inner)) + imaginary (f.* nth_root_of_abs + (f.sin inner))] + [..#real real + ..#imaginary imaginary]))))))) (def: .public (approximately? margin_of_error standard value) (-> Frac Complex Complex Bit) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index d3cd5f138..511b0fef9 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -21,16 +21,422 @@ ["[1][0]" i64] ["[1][0]" nat] ["[1][0]" int] - ["[1][0]" rev] - ["/[1]" //]]) + ["[1][0]" rev]]) -(def: .public (= reference sample) - (-> Frac Frac Bit) - ("lux f64 =" reference sample)) +(template [ ] + [(def: .public + )] -(def: .public (< reference sample) - (-> Frac Frac Bit) - ("lux f64 <" reference sample)) + [e +2.7182818284590452354] + ... ["π is wrong!" by Bob Palais](https://www.math.utah.edu/~palais/pi.html) + [pi +3.14159265358979323846] + ... [The Tau Manifesto](https://tauday.com/tau-manifesto) + [tau +6.28318530717958647692] + ) + +(for @.old + (as_is (template [ ] + [(def: .public ( it) + (-> Frac Frac) + ( it))] + + [cos "jvm invokestatic:java.lang.Math:cos:double"] + [sin "jvm invokestatic:java.lang.Math:sin:double"] + [tan "jvm invokestatic:java.lang.Math:tan:double"] + + [acos "jvm invokestatic:java.lang.Math:acos:double"] + [asin "jvm invokestatic:java.lang.Math:asin:double"] + [atan "jvm invokestatic:java.lang.Math:atan:double"] + + [exp "jvm invokestatic:java.lang.Math:exp:double"] + [log "jvm invokestatic:java.lang.Math:log:double"] + + [ceil "jvm invokestatic:java.lang.Math:ceil:double"] + [floor "jvm invokestatic:java.lang.Math:floor:double"] + + [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] + [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] + ) + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) + + @.jvm + (as_is (template: (!double value) + [(|> value + (:as (Primitive "java.lang.Double")) + "jvm object cast")]) + + (template: (!frac value) + [(|> value + "jvm object cast" + (: (Primitive "java.lang.Double")) + (:as Frac))]) + + (template [ ] + [(def: .public + (-> Frac Frac) + (|>> !double + ["D"] + ("jvm member invoke static" [] "java.lang.Math" []) + !frac))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + [root/3 "cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] + ["D" (!double subject)] ["D" (!double param)]) + !frac))) + + @.js + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("js apply" ("js constant" )) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [ceil "Math.ceil"] + [floor "Math.floor"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) + + @.python + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("python object do" ("python import" "math")) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.lua + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("lua apply" ("lua constant" )) + (:as Frac)))] + + [cos "math.cos"] + [sin "math.sin"] + [tan "math.tan"] + + [acos "math.acos"] + [asin "math.asin"] + [atan "math.atan"] + + [exp "math.exp"] + [log "math.log"] + + [ceil "math.ceil"] + [floor "math.floor"] + + [root/2 "math.sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("lua power" param subject)) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.ruby + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("ruby apply" ("ruby constant" )) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (template [ ] + [(def: .public ( it) + (-> Frac Frac) + (|> ("ruby object do" it []) + (:as Int) + ("lux i64 f64")))] + + [ceil "ceil"] + [floor "floor"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("ruby object do" "**" subject [param])))) + + @.php + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> ("php apply" ("php constant" )) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("php apply" ("php constant" "pow") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + + @.scheme + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> ("scheme apply" ("scheme constant" )) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceiling"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + ) + +(def: .public (round it) + (-> Frac Frac) + (let [floored (floor it) + diff ("lux f64 -" floored it)] + (cond ("lux f64 <" diff +0.5) + ("lux f64 +" +1.0 floored) + + ("lux f64 <" -0.5 diff) + ("lux f64 +" -1.0 floored) + + ... else + floored))) + +(def: .public (atan/2 x y) + (-> Frac Frac Frac) + (cond ("lux f64 <" x +0.0) + (..atan ("lux f64 /" x y)) + + ("lux f64 <" +0.0 x) + (if (or ("lux f64 <" y +0.0) + ("lux f64 =" +0.0 y)) + (|> y ("lux f64 /" x) atan ("lux f64 +" pi)) + (|> y ("lux f64 /" x) atan ("lux f64 -" pi))) + + ... ("lux f64 =" +0.0 x) + (cond ("lux f64 <" y +0.0) + (|> pi ("lux f64 /" +2.0)) + + ("lux f64 <" +0.0 y) + (|> pi ("lux f64 /" -2.0)) + + ... ("lux f64 =" +0.0 y) + ("lux f64 /" +0.0 +0.0)))) + +(def: .public (log_by base it) + (-> Frac Frac Frac) + ("lux f64 /" + (..log base) + (..log it))) + +(def: .public (factorial it) + (-> Nat Nat) + (loop [acc 1 + it it] + (if (//nat.> 1 it) + (again (//nat.* it acc) (-- it)) + acc))) + +(def: .public (hypotenuse catA catB) + (-> Frac Frac Frac) + (..pow +0.5 ("lux f64 +" + (..pow +2.0 catA) + (..pow +2.0 catB)))) + +... Hyperbolic functions +... https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions +(template [ ] + [(def: .public ( it) + (-> Frac Frac) + (|> (..exp it) ( (..exp ("lux f64 *" -1.0 it))) ("lux f64 /" +2.0))) + + (def: .public ( it) + (-> Frac Frac) + (|> +2.0 ("lux f64 /" (|> (..exp it) ( (..exp ("lux f64 *" -1.0 it)))))))] + + [sinh "lux f64 -" csch] + [cosh "lux f64 +" sech] + ) + +(template [ ] + [(def: .public ( it) + (-> Frac Frac) + (let [e+ (exp it) + e- (exp ("lux f64 *" -1.0 it)) + sinh' (|> e+ ("lux f64 -" e-)) + cosh' (|> e+ ("lux f64 +" e-))] + (|> ("lux f64 /" ))))] + + [tanh sinh' cosh'] + [coth cosh' sinh'] + ) + +... https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms +(template [ ] + [(def: .public ( it) + (-> Frac Frac) + (|> it (pow +2.0) ( +1.0) (pow +0.5) ("lux f64 +" it) log))] + + [asinh "lux f64 +"] + [acosh "lux f64 -"] + ) + +(template [ ] + [(def: .public ( it) + (-> Frac Frac) + (let [it+ (|> ("lux f64 +" )) + it- (|> ("lux f64 -" ))] + (|> it+ ("lux f64 /" it-) log ("lux f64 /" +2.0))))] + + [atanh +1.0 it] + [acoth it +1.0] + ) + +(template [ ] + [(def: .public ( it) + (-> Frac Frac) + (let [it^2 (|> it (pow +2.0))] + (|> +1.0 ( it^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" it) log)))] + + [asech "lux f64 -"] + [acsch "lux f64 +"] + ) + +(template [ ] + [(def: .public ( param subject) + (-> Frac Frac Bit) + ( param subject))] + + [= "lux f64 ="] + [< "lux f64 <"] + ) (def: .public (<= reference sample) (-> Frac Frac Bit) @@ -167,13 +573,13 @@ (def: .public smallest Frac - (///.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) - +2.0)) + (..pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) + +2.0)) (def: .public biggest Frac - (let [f2^-52 (///.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) - f2^+1023 (///.pow ..max_exponent +2.0)] + (let [f2^-52 (..pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) + f2^+1023 (..pow ..max_exponent +2.0)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) @@ -214,8 +620,8 @@ (def: log/2 (-> Frac Frac) - (|>> ///.log - (../ (///.log +2.0)))) + (|>> ..log + (../ (..log +2.0)))) (def: double_bias Nat 1023) @@ -268,7 +674,7 @@ it (..abs it) exponent (|> it ..log/2 - ///.floor + ..floor (..min ..max_exponent)) min_gap (..- (//int.frac ..min_exponent) exponent) power (|> (//nat.frac ..mantissa_size) @@ -276,9 +682,9 @@ (..- exponent)) max_gap (..- ..max_exponent power) mantissa (|> it - (..* (///.pow (..min ..max_exponent power) +2.0)) + (..* (..pow (..min ..max_exponent power) +2.0)) (..* (if (..> +0.0 max_gap) - (///.pow max_gap +2.0) + (..pow max_gap +2.0) +1.0))) exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) @@ -339,7 +745,7 @@ (//int.- (.int ..mantissa_size)))] [(//i64.one ..mantissa_size M) (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) - exponent (///.pow (//int.frac power) +2.0)] + exponent (..pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 8214514a7..7d8d19fe6 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -21,13 +21,14 @@ ["[1][0]" nat] ["[1][0]" i64]]) -(def: .public (= reference sample) - (-> Int Int Bit) - ("lux i64 =" reference sample)) +(template [ ] + [(def: .public ( param subject) + (-> Int Int Bit) + ( param subject))] -(def: .public (< reference sample) - (-> Int Int Bit) - ("lux i64 <" reference sample)) + [= "lux i64 ="] + [< "lux i64 <"] + ) (def: .public (<= reference sample) (-> Int Int Bit) @@ -55,27 +56,27 @@ [..= zero?] ) -(template [ ] +(template [ ] [(def: .public ( left right) (-> Int Int Int) (if ( right left) left right))] - [min ..< "Int(eger) minimum."] - [max ..> "Int(eger) maximum."] + [min ..<] + [max ..>] ) -(template [ ] +(template [ ] [(def: .public ( param subject) (-> Int Int Int) ( param subject))] - [+ "lux i64 +" "Int(eger) addition."] - [- "lux i64 -" "Int(eger) substraction."] - [* "lux i64 *" "Int(eger) multiplication."] - [/ "lux i64 /" "Int(eger) division."] - [% "lux i64 %" "Int(eger) remainder."] + [+ "lux i64 +"] + [- "lux i64 -"] + [* "lux i64 *"] + [/ "lux i64 /"] + [% "lux i64 %"] ) (def: .public (/% param subject) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index c52647e32..9ead2ee82 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -49,9 +49,8 @@ (def: .public (<= reference sample) (-> Nat Nat Bit) - (if (..< reference sample) - #1 - ("lux i64 =" reference sample))) + (or (..< reference sample) + ("lux i64 =" reference sample))) (def: .public (> reference sample) (-> Nat Nat Bit) @@ -59,9 +58,8 @@ (def: .public (>= reference sample) (-> Nat Nat Bit) - (if (..< sample reference) - #1 - ("lux i64 =" reference sample))) + (or (..< sample reference) + ("lux i64 =" reference sample))) (template [ ] [(def: .public ( left right) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 8b5e28996..f00cc8dd7 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -53,9 +53,8 @@ (def: .public (<= reference sample) (-> Rev Rev Bit) - (if (//nat.< (.nat reference) (.nat sample)) - true - ("lux i64 =" reference sample))) + (or (//nat.< (.nat reference) (.nat sample)) + ("lux i64 =" reference sample))) (def: .public (> reference sample) (-> Rev Rev Bit) @@ -63,9 +62,8 @@ (def: .public (>= reference sample) (-> Rev Rev Bit) - (if (..< sample reference) - true - ("lux i64 =" reference sample))) + (or (..< sample reference) + ("lux i64 =" reference sample))) (template [ ] [(def: .public ( left right) diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index e8d213dd8..e4ccd2c3c 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -1,7 +1,7 @@ (.using [library [lux {"-" nat int rev if cond} - ["[0]" meta] + ["[0]" meta ("[1]#[0]" functor)] [abstract [monad {"+" do}]] [control @@ -57,6 +57,9 @@ .let [[format expression] (:as pair)]] (in (list#each format expression))))) +(syntax: .public (seed []) + (meta#each (|>> code.nat list) meta.seed)) + (template [ ] [(syntax: .public ( []) (do meta.monad @@ -117,3 +120,11 @@ (~ else)))) else (list.reversed test,then/*))))) + +(syntax: .public (when [test .any + then .any]) + (do meta.monad + [test (meta.eval .Bit test)] + (in (.if (:as .Bit test) + (list then) + (list))))) -- cgit v1.2.3