diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/text/format.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/math/modular.lux | 167 |
2 files changed, 177 insertions, 4 deletions
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 1c56f1cb9..80d672d67 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -12,6 +12,7 @@ (time [instant] [duration] [date]) + (math [modular]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) @@ -26,14 +27,14 @@ (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid<Text>) (~' compose))] ($_ (~ g!compose) (~+ fragments)))))))) -## [Formatters] -(type: #export (Formatter a) +## [Formats] +(type: #export (Format a) {#.doc "A way to produce readable text from values."} (-> a Text)) (do-template [<name> <type> <formatter>] [(def: #export <name> - (Formatter <type>) + (Format <type>) <formatter>)] [%b Bool (:: bool.Codec<Text,Bool> encode)] @@ -55,8 +56,13 @@ [%date date.Date (:: date.Codec<Text,Date> encode)] ) +(def: #export (%mod modular) + (All [m] (Format (modular.Mod m))) + (let [[_ modulus] (modular.un-mod modular)] + (:: (modular.Codec<Text,Mod> modulus) encode modular))) + (def: #export (%list formatter) - (All [a] (-> (Formatter a) (Formatter (List a)))) + (All [a] (-> (Format a) (Format (List a)))) (function [values] (case values #.Nil diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux new file mode 100644 index 000000000..7618a3a55 --- /dev/null +++ b/stdlib/source/lux/math/modular.lux @@ -0,0 +1,167 @@ +(.module: + lux + (lux (control ["ex" exception #+ exception:] + ["p" parser] + [codec #+ Codec] + [monad #+ do]) + (data ["e" error #+ Error] + [number "int/" Codec<Text,Int>] + [text "text/" Monoid<Text>] + (text ["l" lexer #+ Lexer])) + (type abstract) + (macro [code] + ["s" syntax #+ syntax:]) + [math])) + +(exception: #export Zero-Cannot-Be-A-Modulus) +(exception: #export Cannot-Equalize-Numbers) +(exception: #export Incorrect-Modulus) + +(abstract: #export (Modulus m) + {#.doc "A number used as a modulus in modular arithmetic. + It cannot be 0."} + + Int + + (def: #export (from-int value) + (Ex [m] (-> Int (Error (Modulus m)))) + (if (i/= 0 value) + (#e.Error (Zero-Cannot-Be-A-Modulus "")) + (#e.Success (@abstraction value)))) + + (def: #export (to-int modulus) + (All [m] (-> (Modulus m) Int)) + (|> modulus @representation)) + ) + +(def: #export (congruent? modulus reference sample) + (All [m] (-> (Modulus m) Int Int Bool)) + (|> sample + (i/- reference) + (i/% (to-int modulus)) + (i/= 0))) + +(syntax: #export (modulus [modulus s.int]) + (case (from-int modulus) + (#e.Success _) + (wrap (list (` (e.assume (..from-int (~ (code.int modulus))))))) + + (#e.Error error) + (p.fail error))) + +(def: (i/mod (^|> modulus [to-int]) + value) + (All [m] (-> (Modulus m) Int Int)) + (let [raw (i/% modulus value)] + (if (i/< 0 raw) + (let [shift (if (i/< 0 modulus) i/- i/+)] + (|> raw (shift modulus))) + raw))) + +(def: intL + (Lexer Int) + (p.codec number.Codec<Text,Int> + (p.either (l.seq (l.one-of "-") (l.many l.decimal)) + (l.many l.decimal)))) + +(abstract: #export (Mod m) + {#.doc "A number under a modulus."} + + {#remainder Int + #modulus (Modulus m)} + + (def: #export (mod modulus) + (All [m] (-> (Modulus m) (-> Int (Mod m)))) + (function [value] + (@abstraction {#remainder (i/mod modulus value) + #modulus modulus}))) + + (def: #export (un-mod modular) + (All [m] (-> (Mod m) [Int (Modulus m)])) + (@representation modular)) + + (def: separator Text " mod ") + + (struct: #export (Codec<Text,Mod> modulus) + (All [m] (-> (Modulus m) (Codec Text (Mod m)))) + + (def: (encode modular) + (let [[remainder modulus] (@representation modular)] + ($_ text/compose + (int/encode remainder) + separator + (int/encode (to-int modulus))))) + + (def: (decode text) + (<| (l.run text) + (do p.Monad<Parser> + [[remainder _ _modulus] ($_ p.seq intL (l.this separator) intL) + _ (p.assert (Incorrect-Modulus + ($_ text/compose + "Expected modulus: " (int/encode (to-int modulus)) "\n" + " Actual modulus: " (int/encode _modulus) "\n")) + (i/= (to-int modulus) _modulus))] + (wrap (mod modulus remainder)))))) + + (def: #export (equalize reference sample) + (All [r s] (-> (Mod r) (Mod s) (Error (Mod r)))) + (let [[reference reference-modulus] (@representation reference) + [sample sample-modulus] (@representation sample)] + (if (i/= (to-int reference-modulus) + (to-int sample-modulus)) + (#e.Success (@abstraction {#remainder sample + #modulus reference-modulus})) + (#e.Error (Cannot-Equalize-Numbers + ($_ text/compose + "Reference modulus: " (int/encode (to-int reference-modulus)) "\n" + " Sample modulus: " (int/encode (to-int sample-modulus)) "\n")))))) + + (do-template [<name> <op>] + [(def: #export (<name> reference sample) + (All [m] (-> (Mod m) (Mod m) Bool)) + (let [[reference _] (@representation reference) + [sample _] (@representation sample)] + (<op> reference sample)))] + + [m/= i/=] + [m/< i/<] + [m/<= i/<=] + [m/> i/>] + [m/>= i/>=] + ) + + (do-template [<name> <op>] + [(def: #export (<name> param subject) + (All [m] (-> (Mod m) (Mod m) (Mod m))) + (let [[param modulus] (@representation param) + [subject _] (@representation subject)] + (@abstraction {#remainder (|> subject + (<op> param) + (i/mod modulus)) + #modulus modulus})))] + + [m/+ i/+] + [m/- i/-] + [m/* i/*]) + + (def: (i/gcd+ a b) + (-> Int Int [Int Int Int]) + (if (i/= 0 a) + [0 1 b] + (let [[ak bk gcd] (i/gcd+ (i/% a b) a)] + [(i/- (i/* ak + (i// a b)) + bk) + ak + gcd]))) + + (def: #export (inverse modular) + (All [m] (-> (Mod m) (Maybe (Mod m)))) + (let [[value modulus] (@representation modular) + _modulus (to-int modulus) + [vk mk gcd] (i/gcd+ value _modulus) + co-prime? (i/= 1 gcd)] + (if co-prime? + (#.Some (mod modulus vk)) + #.None))) + ) |