aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/text/format.lux14
-rw-r--r--stdlib/source/lux/math/modular.lux167
-rw-r--r--stdlib/test/test/lux/math/modular.lux146
-rw-r--r--stdlib/test/tests.lux2
4 files changed, 324 insertions, 5 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)))
+ )
diff --git a/stdlib/test/test/lux/math/modular.lux b/stdlib/test/test/lux/math/modular.lux
new file mode 100644
index 000000000..76d56cbc2
--- /dev/null
+++ b/stdlib/test/test/lux/math/modular.lux
@@ -0,0 +1,146 @@
+(.module:
+ lux
+ (lux (control [monad #+ do])
+ (data [product]
+ [bool "bool/" Eq<Bool>]
+ ["e" error]
+ text/format)
+ (math ["r" random]
+ ["/" modular])
+ (lang [type "type/" Eq<Type>]))
+ lux/test)
+
+(def: %3 (/.modulus 3))
+(def: Mod3 Type (type-of %3))
+
+(def: modulusR
+ (r.Random Int)
+ (|> r.int
+ (:: r.Monad<Random> map (i/% 1000))
+ (r.filter (|>> (i/= 0) not))))
+
+(def: valueR
+ (r.Random Int)
+ (|> r.int (:: r.Monad<Random> map (i/% 1000))))
+
+(def: (modR modulus)
+ (All [m] (-> (/.Modulus m) (r.Random [Int (/.Mod m)])))
+ (do r.Monad<Random>
+ [raw valueR]
+ (wrap [raw (/.mod modulus raw)])))
+
+(def: value
+ (All [m] (-> (/.Mod m) Int))
+ (|>> /.un-mod product.left))
+
+(def: (comparison m/? i/?)
+ (All [m]
+ (-> (-> (/.Mod m) (/.Mod m) Bool)
+ (-> Int Int Bool)
+ (-> (/.Mod m) (/.Mod m) Bool)))
+ (function [param subject]
+ (bool/= (m/? param subject)
+ (i/? (value param)
+ (value subject)))))
+
+(def: (arithmetic modulus m/! i/!)
+ (All [m]
+ (-> (/.Modulus m)
+ (-> (/.Mod m) (/.Mod m) (/.Mod m))
+ (-> Int Int Int)
+ (-> (/.Mod m) (/.Mod m) Bool)))
+ (function [param subject]
+ (|> (i/! (value param)
+ (value subject))
+ (/.mod modulus)
+ (/.m/= (m/! param subject)))))
+
+(context: "Modular arithmetic."
+ (<| (times +100)
+ (do @
+ [_normalM modulusR
+ _alternativeM (|> modulusR (r.filter (|>> (i/= _normalM) not)))
+ #let [normalM (|> _normalM /.from-int e.assume)
+ alternativeM (|> _alternativeM /.from-int e.assume)]
+ [_param param] (modR normalM)
+ [_subject subject] (modR normalM)
+ #let [copyM (|> normalM /.to-int /.from-int e.assume)]]
+ ($_ seq
+ (test "Every modulus has a unique type, even if the numeric value is the same as another."
+ (and (type/= (type-of normalM)
+ (type-of normalM))
+ (not (type/= (type-of normalM)
+ (type-of alternativeM)))
+ (not (type/= (type-of normalM)
+ (type-of copyM)))))
+
+ (test "Can extract the original integer from the modulus."
+ (i/= _normalM
+ (/.to-int normalM)))
+
+ (test "Can compare mod'ed values."
+ (and (/.m/= subject subject)
+ ((comparison /.m/= i/=) param subject)
+ ((comparison /.m/< i/<) param subject)
+ ((comparison /.m/<= i/<=) param subject)
+ ((comparison /.m/> i/>) param subject)
+ ((comparison /.m/>= i/>=) param subject)))
+
+ (test "Mod'ed values are ordered."
+ (and (bool/= (/.m/< param subject)
+ (not (/.m/>= param subject)))
+ (bool/= (/.m/> param subject)
+ (not (/.m/<= param subject)))
+ (bool/= (/.m/= param subject)
+ (not (or (/.m/< param subject)
+ (/.m/> param subject))))))
+
+ (test "Can do arithmetic."
+ (and ((arithmetic normalM /.m/+ i/+) param subject)
+ ((arithmetic normalM /.m/- i/-) param subject)
+ ((arithmetic normalM /.m/* i/*) param subject)))
+
+ (test "Can sometimes find multiplicative inverse."
+ (case (/.inverse subject)
+ (#.Some subject^-1)
+ (|> subject
+ (/.m/* subject^-1)
+ (/.m/= (/.mod normalM 1)))
+
+ #.None
+ true))
+
+ (test "Can encode/decode to text."
+ (let [(^open "mod/") (/.Codec<Text,Mod> normalM)]
+ (case (|> subject mod/encode mod/decode)
+ (#e.Success output)
+ (/.m/= subject output)
+
+ (#e.Error error)
+ false)))
+
+ (test "Can equalize 2 moduli if they are equal."
+ (case (/.equalize (/.mod normalM _subject)
+ (/.mod copyM _param))
+ (#e.Success paramC)
+ (/.m/= param paramC)
+
+ (#e.Error error)
+ false))
+
+ (test "Cannot equalize 2 moduli if they are the different."
+ (case (/.equalize (/.mod normalM _subject)
+ (/.mod alternativeM _param))
+ (#e.Success paramA)
+ false
+
+ (#e.Error error)
+ true))
+
+ (test "All numbers are congruent to themselves."
+ (/.congruent? normalM _subject _subject))
+
+ (test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus."
+ (bool/= (/.congruent? normalM _param _subject)
+ (/.m/= param subject)))
+ ))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 899582b54..1742334d8 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -56,6 +56,7 @@
["_." regex]))
["_." math]
(math ["_." random]
+ ["_." modular]
(logic ["_." continuous]
["_." fuzzy]))
(macro ["_." code]
@@ -82,7 +83,6 @@
[html]
[css])
(coll (tree ["tree_." parser])))
- (math [random])
[macro]
(macro (poly [json]))
(type [unit])