(.require [library [lux (.except nat int rev) [abstract [hash (.only Hash)] [monoid (.only Monoid)] [equivalence (.only Equivalence)] [codec (.only Codec)] [order (.only Order)] [monad (.only do)]] [control ["[0]" maybe] ["[0]" try (.only Try)] [function [predicate (.only Predicate)]]] [data ["[0]" text]] [meta ["@" target]]]] ["[0]" // ["[1][0]" i64] ["[1][0]" nat] ["[1][0]" int] ["[1][0]" rev]]) (with_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 (these (with_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 (these (def !double (template (_ value) [(|> value (as (Primitive "java.lang.Double")) "jvm object cast")])) (def !frac (template (_ value) [(|> value "jvm object cast" (is (Primitive "java.lang.Double")) (as Frac))])) (with_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 (these (with_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 (these (with_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 (these (with_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 (these (with_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"] ) (with_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 (these (with_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 (these (with_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 (again [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 (with_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] ) (with_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 (with_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 -"] ) (with_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] ) (with_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 +"] ) (with_template [ ] [(def .public ( param subject) (-> Frac Frac Bit) ( param subject))] [= "lux f64 ="] [< "lux f64 <"] ) (def .public (<= reference sample) (-> Frac Frac Bit) (or ("lux f64 <" reference sample) ("lux f64 =" reference sample))) (def .public (> reference sample) (-> Frac Frac Bit) ("lux f64 <" sample reference)) (def .public (>= reference sample) (-> Frac Frac Bit) (or ("lux f64 <" sample reference) ("lux f64 =" sample reference))) (with_template [ ] [(def .public (Predicate Frac) ( +0.0))] [..> positive?] [..< negative?] [..= zero?] ) (with_template [ ] [(def .public ( param subject) (-> Frac Frac Frac) ( param subject))] [+ "lux f64 +"] [- "lux f64 -"] [* "lux f64 *"] [/ "lux f64 /"] [% "lux f64 %"] ) (def .public (/% param subject) (-> Frac Frac [Frac Frac]) [(../ param subject) (..% param subject)]) (def .public opposite (-> Frac Frac) (..* -1.0)) (def .public (abs it) (-> Frac Frac) (if (..< +0.0 it) (..* -1.0 it) it)) (def .public (signum it) (-> Frac Frac) (cond (..= +0.0 it) +0.0 (..< +0.0 it) -1.0 ... else +1.0)) (def min_exponent -1022) (def max_exponent (//int.frac +1023)) (with_template [ ] [(def .public ( left right) (-> Frac Frac Frac) (if ( right left) left right))] [min ..<] [max ..>] ) (def .public nat (-> Frac Nat) (|>> "lux f64 i64" .nat)) (def .public int (-> Frac Int) (|>> "lux f64 i64")) (def mantissa_size Nat 52) (def exponent_size Nat 11) (def frac_denominator (|> -1 ("lux i64 right-shift" ..exponent_size) "lux i64 f64")) (def .public rev (-> Frac Rev) (|>> ..abs (..% +1.0) (..* ..frac_denominator) "lux f64 i64" ("lux i64 left-shift" ..exponent_size))) (with_template [ ] [(def .public Frac (../ +0.0 ))] [not_a_number +0.0] [positive_infinity +1.0] ) (def .public negative_infinity Frac (..* -1.0 ..positive_infinity)) (def .public (not_a_number? it) (-> Frac Bit) (not (..= it it))) (def .public (number? it) (-> Frac Bit) (not (or (..not_a_number? it) (..= ..positive_infinity it) (..= ..negative_infinity it)))) (def .public equivalence (Equivalence Frac) (implementation (def (= left right) (or (..= left right) (and (..not_a_number? left) (..not_a_number? right)))))) (def .public order (Order Frac) (implementation (def equivalence ..equivalence) (def < ..<))) (def .public smallest Frac (..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)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) (with_template [ ] [(def .public (Monoid Frac) (implementation (def identity ) (def composite )))] [addition ..+ +0.0] [multiplication ..* +1.0] [minimum ..min ..biggest] [maximum ..max (..* -1.0 ..biggest)] ) (def .public decimal (Codec Text Frac) (implementation (def (encoded x) (case x -0.0 (let [output ("lux f64 encode" x)] (if (text.starts_with? "-" output) output ("lux text concat" "+" output))) _ (if (..< +0.0 x) ("lux f64 encode" x) ("lux text concat" "+" ("lux f64 encode" x))))) (def (decoded input) (case ("lux f64 decode" input) {.#Some value} {try.#Success value} {.#None} {try.#Failure "Could not decode Frac"})))) (def log/2 (-> Frac Frac) (|>> ..log (../ (..log +2.0)))) (def double_bias Nat 1023) (def exponent_mask (//i64.mask ..exponent_size)) (def exponent_offset ..mantissa_size) (def sign_offset (//nat.+ ..exponent_size ..exponent_offset)) (with_template [ ] [(def (|> (at //nat.hex decoded) try.trusted ))] [.i64 "FFF8000000000000" not_a_number_bits] [.i64 "7FF0000000000000" positive_infinity_bits] [.i64 "FFF0000000000000" negative_infinity_bits] [.i64 "0000000000000000" positive_zero_bits] [.i64 "8000000000000000" negative_zero_bits] [.nat "7FF" special_exponent_bits] ) (def smallest_exponent (..log/2 ..smallest)) (def .public (bits it) (-> Frac I64) (.i64 (cond (..not_a_number? it) ..not_a_number_bits (..= positive_infinity it) ..positive_infinity_bits (..= negative_infinity it) ..negative_infinity_bits (..= +0.0 it) (let [reciprocal (../ it +1.0)] (if (..= positive_infinity reciprocal) ... Positive zero ..positive_zero_bits ... Negative zero ..negative_zero_bits)) ... else (let [sign_bit (if (..< +0.0 it) 1 0) it (..abs it) exponent (|> it ..log/2 ..floor (..min ..max_exponent)) min_gap (..- (//int.frac ..min_exponent) exponent) power (|> (//nat.frac ..mantissa_size) (..+ (..min +0.0 min_gap)) (..- exponent)) max_gap (..- ..max_exponent power) mantissa (|> it (..* (..pow (..min ..max_exponent power) +2.0)) (..* (if (..> +0.0 max_gap) (..pow max_gap +2.0) +1.0))) exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) (//int.- (..int min_gap)) --) (..int exponent)) (//int.+ (.int ..double_bias)) (//i64.and ..exponent_mask)) mantissa_bits (..int mantissa)] (all //i64.or (//i64.left_shifted ..sign_offset sign_bit) (//i64.left_shifted ..exponent_offset exponent_bits) (//i64.zero ..mantissa_size mantissa_bits))) ))) (with_template [ ] [(def (-> (I64 Any) I64) (let [mask (|> 1 (//i64.left_shifted ) -- (//i64.left_shifted ))] (|>> (//i64.and mask) (//i64.right_shifted ) .i64)))] [mantissa ..mantissa_size 0] [exponent ..exponent_size ..mantissa_size] [sign 1 ..sign_offset] ) (def .public (of_bits it) (-> I64 Frac) (case [(is Nat (..exponent it)) (is Nat (..mantissa it)) (is Nat (..sign it))] [..special_exponent_bits 0 0] ..positive_infinity [..special_exponent_bits 0 1] ..negative_infinity [..special_exponent_bits _ _] ..not_a_number ... Positive zero [0 0 0] +0.0 ... Negative zero [0 0 1] (..* -1.0 +0.0) [E M S] (let [sign (if (//nat.= 0 S) +1.0 -1.0) [mantissa power] (if (//nat.< ..mantissa_size E) [(if (//nat.= 0 E) M (//i64.one ..mantissa_size M)) (|> E (//nat.- ..double_bias) .int (//int.max ..min_exponent) (//int.- (.int ..mantissa_size)))] [(//i64.one ..mantissa_size M) (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) exponent (..pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) (`` (def (representation_exponent codec representation) (-> (Codec Text Nat) Text (Try [Text Int])) (case [("lux text index" 0 "e+" representation) ("lux text index" 0 "E+" representation) ("lux text index" 0 "e-" representation) ("lux text index" 0 "E-" representation)] (,, (with_template [ ] [ (do try.monad [.let [after_offset (//nat.+ 2 split_index) after_length (//nat.- after_offset ("lux text size" representation))] exponent (|> representation ("lux text clip" after_offset after_length) (at codec decoded))] (in [("lux text clip" 0 split_index representation) (//int.* (.int exponent))]))] [+1 [{.#Some split_index} {.#None} {.#None} {.#None}]] [+1 [{.#None} {.#Some split_index} {.#None} {.#None}]] [-1 [{.#None} {.#None} {.#Some split_index} {.#None}]] [-1 [{.#None} {.#None} {.#None} {.#Some split_index}]])) _ {try.#Success [representation +0]}))) (with_template [ ] [(def .public (Codec Text Frac) (implementation (def (encoded value) (let [bits (..bits value) mantissa (..mantissa bits) exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] (all "lux text concat" (case (.nat sign) 1 "-" 0 "+" _ (undefined)) (at encoded (.nat mantissa)) ".0E" (at encoded exponent)))) (def (decoded representation) (let [negative? (text.starts_with? "-" representation) positive? (text.starts_with? "+" representation)] (if (or negative? positive?) (do [! try.monad] [[mantissa exponent] (..representation_exponent representation) [whole decimal] (case ("lux text index" 0 "." mantissa) {.#Some split_index} (do ! [.let [after_offset (++ split_index) after_length (//nat.- after_offset ("lux text size" mantissa))] decimal (|> mantissa ("lux text clip" after_offset after_length) (at decoded))] (in [("lux text clip" 0 split_index mantissa) decimal])) {.#None} {try.#Failure ("lux text concat" representation)}) .let [whole ("lux text clip" 1 (-- ("lux text size" whole)) whole)] mantissa (at decoded (case decimal 0 whole _ ("lux text concat" whole (at encoded decimal)))) .let [sign (if negative? 1 0)]] (in (..of_bits (all //i64.or (//i64.left_shifted ..sign_offset (.i64 sign)) (//i64.left_shifted ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) (//i64.zero ..mantissa_size (.i64 mantissa)))))) {try.#Failure ("lux text concat" representation)})))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] [octal //nat.octal //int.octal "Invalid octaladecimal syntax: "] [hex //nat.hex //int.hex "Invalid hexadecimal syntax: "] ) (def .public hash (Hash Frac) (implementation (def equivalence ..equivalence) (def hash ..bits))) (def .public (approximately? margin_of_error standard value) (-> Frac Frac Frac Bit) (|> value (..- standard) ..abs (..< margin_of_error))) (def .public (mod divisor dividend) (All (_ m) (-> Frac Frac Frac)) (let [remainder (..% divisor dividend)] (if (or (and (..< +0.0 divisor) (..> +0.0 remainder)) (and (..> +0.0 divisor) (..< +0.0 remainder))) (..+ divisor remainder) remainder)))