diff options
Diffstat (limited to 'stdlib/source/lux/math/number/ratio.lux')
-rw-r--r-- | stdlib/source/lux/math/number/ratio.lux | 161 |
1 files changed, 0 insertions, 161 deletions
diff --git a/stdlib/source/lux/math/number/ratio.lux b/stdlib/source/lux/math/number/ratio.lux deleted file mode 100644 index ad2092fbd..000000000 --- a/stdlib/source/lux/math/number/ratio.lux +++ /dev/null @@ -1,161 +0,0 @@ -(.module: - {#.doc "Rational numbers."} - [lux (#- nat) - [abstract - [equivalence (#+ Equivalence)] - [order (#+ Order)] - [monoid (#+ Monoid)] - [codec (#+ Codec)] - [monad (#+ do)]] - [control - ["." function] - ["." try] - ["<>" parser - ["<.>" code (#+ Parser)]]] - [data - ["." product] - ["." maybe] - ["." text ("#\." monoid)]] - [macro - [syntax (#+ syntax:)] - ["." code]]] - [// - ["n" nat ("#\." decimal)]]) - -(type: #export Ratio - {#numerator Nat - #denominator Nat}) - -(def: #export (nat value) - (-> Ratio (Maybe Nat)) - (case (get@ #denominator value) - 1 (#.Some (get@ #numerator value)) - _ #.None)) - -(def: (normalize (^slots [#numerator #denominator])) - (-> Ratio Ratio) - (let [common (n.gcd numerator denominator)] - {#numerator (n./ common numerator) - #denominator (n./ common denominator)})) - -(syntax: #export (ratio numerator {?denominator (<>.maybe <code>.any)}) - {#.doc (doc "Rational literals." - (ratio numerator denominator) - "The denominator can be omitted if it's 1." - (ratio numerator))} - (wrap (list (` ((~! ..normalize) {#..numerator (~ numerator) - #..denominator (~ (maybe.default (' 1) - ?denominator))}))))) - -(def: #export (= parameter subject) - (-> Ratio Ratio Bit) - (and (n.= (get@ #numerator parameter) - (get@ #numerator subject)) - (n.= (get@ #denominator parameter) - (get@ #denominator subject)))) - -(implementation: #export equivalence - (Equivalence Ratio) - - (def: = ..=)) - -(def: (equalize parameter subject) - (-> Ratio Ratio [Nat Nat]) - [(n.* (get@ #denominator subject) - (get@ #numerator parameter)) - (n.* (get@ #denominator parameter) - (get@ #numerator subject))]) - -(def: #export (< parameter subject) - (-> Ratio Ratio Bit) - (let [[parameter' subject'] (..equalize parameter subject)] - (n.< parameter' subject'))) - -(def: #export (<= parameter subject) - (-> Ratio Ratio Bit) - (or (< parameter subject) - (= parameter subject))) - -(def: #export (> parameter subject) - (-> Ratio Ratio Bit) - (..< subject parameter)) - -(def: #export (>= parameter subject) - (-> Ratio Ratio Bit) - (or (> parameter subject) - (= parameter subject))) - -(implementation: #export order - (Order Ratio) - - (def: &equivalence ..equivalence) - (def: < ..<)) - -(def: #export (+ parameter subject) - (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [(n.+ parameter' subject') - (n.* (get@ #denominator parameter) - (get@ #denominator subject))]))) - -(def: #export (- parameter subject) - (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [(n.- parameter' subject') - (n.* (get@ #denominator parameter) - (get@ #denominator subject))]))) - -(def: #export (* parameter subject) - (-> Ratio Ratio Ratio) - (normalize [(n.* (get@ #numerator parameter) - (get@ #numerator subject)) - (n.* (get@ #denominator parameter) - (get@ #denominator subject))])) - -(def: #export (/ parameter subject) - (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [subject' parameter']))) - -(def: #export (% parameter subject) - (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject) - quot (n./ parameter' subject')] - (..- (update@ #numerator (n.* quot) parameter) - subject))) - -(def: #export (reciprocal (^slots [#numerator #denominator])) - (-> Ratio Ratio) - {#numerator denominator - #denominator numerator}) - -(def: separator ":") - -(implementation: #export codec - (Codec Text Ratio) - - (def: (encode (^slots [#numerator #denominator])) - ($_ text\compose (n\encode numerator) ..separator (n\encode denominator))) - - (def: (decode input) - (case (text.split_with ..separator input) - (#.Some [num denom]) - (do try.monad - [numerator (n\decode num) - denominator (n\decode denom)] - (wrap (normalize {#numerator numerator - #denominator denominator}))) - - #.None - (#.Left (text\compose "Invalid syntax for ratio: " input))))) - -(template [<identity> <compose> <name>] - [(implementation: #export <name> - (Monoid Ratio) - - (def: identity (..ratio <identity>)) - (def: compose <compose>))] - - [0 ..+ addition] - [1 ..* multiplication] - ) |