diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 142 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concatenative.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css/value.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/rev.lux | 144 | ||||
| -rw-r--r-- | stdlib/source/lux/math/logic/continuous.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/math/logic/fuzzy.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 75 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/rev.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/logic/continuous.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/logic/fuzzy.lux | 85 |
10 files changed, 281 insertions, 277 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index f347c281a..4f684d34d 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2203,42 +2203,6 @@ (fail "Wrong syntax for template")} tokens)) -(def:''' #export (r/= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) equivalence.")]) - (-> Rev Rev Bit) - ("lux i64 =" reference sample)) - -(def:''' #export (r/< reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) less-than.")]) - (-> Rev Rev Bit) - (n/< ("lux coerce" Nat reference) - ("lux coerce" Nat sample))) - -(def:''' #export (r/<= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) less-than-equal.")]) - (-> Rev Rev Bit) - (if (n/< ("lux coerce" Nat reference) - ("lux coerce" Nat sample)) - #1 - ("lux i64 =" reference sample))) - -(def:''' #export (r/> reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) greater-than.")]) - (-> Rev Rev Bit) - (r/< sample reference)) - -(def:''' #export (r/>= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) greater-than-equal.")]) - (-> Rev Rev Bit) - (if (r/< sample reference) - #1 - ("lux i64 =" reference sample))) - (template [<type> <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] @@ -2319,110 +2283,21 @@ ("lux coerce" Int (n// param subject)))] ("lux i64 -" flat subject))) -(template [<type> <name> <op> <doc>] +(template [<name> <op> <doc>] [(def:''' #export (<name> param subject) (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) - (-> <type> <type> <type>) + (-> Int Int Int) (<op> param subject))] - [ Int i/+ "lux i64 +" "Int(eger) addition."] - [ Int i/- "lux i64 -" "Int(eger) substraction."] + [i/+ "lux i64 +" "Int(eger) addition."] + [i/- "lux i64 -" "Int(eger) substraction."] - [ Rev r/+ "lux i64 +" "Rev(olution) addition."] - [ Rev r/- "lux i64 -" "Rev(olution) substraction."] + [i/* "lux i64 *" "Int(eger) multiplication."] + [i// "lux i64 /" "Int(eger) division."] + [i/% "lux i64 %" "Int(eger) remainder."] ) -(template [<type> <name> <op> <doc>] - [(def:''' #export (<name> param subject) - (list [(tag$ ["lux" "doc"]) - (text$ <doc>)]) - (-> <type> <type> <type>) - (<op> param subject))] - - [Int i/* "lux i64 *" "Int(eger) multiplication."] - [Int i// "lux i64 /" "Int(eger) division."] - [Int i/% "lux i64 %" "Int(eger) remainder."] - ) - -(def:''' #export (r/* param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) multiplication.")]) - (-> Rev Rev Rev) - (let' [subjectH (high-bits subject) - subjectL (low-bits subject) - paramH (high-bits param) - paramL (low-bits param) - bottom (|> subjectL - ("lux i64 *" paramL) - ("lux i64 logical-right-shift" 32)) - middle ("lux i64 +" - ("lux i64 *" paramL subjectH) - ("lux i64 *" paramH subjectL)) - top ("lux i64 *" subjectH paramH)] - (|> bottom - ("lux i64 +" middle) - high-bits - ("lux i64 +" top)))) - -(def:''' least-significant-bit-mask (list) ($' I64 Any) 1) - -(def:''' (without-trailing-zeroes count remaining) - (list) - (-> Nat Nat (#Product Nat Nat)) - (if (|> remaining - ("lux i64 and" least-significant-bit-mask) - ("lux i64 =" 0)) - (without-trailing-zeroes - ("lux i64 +" 1 count) - ("lux i64 logical-right-shift" 1 remaining)) - [count remaining])) - -(def:''' #export (r// param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) division.")]) - (-> Rev Rev Rev) - (if ("lux i64 =" +0 param) - ("lux io error" "Cannot divide Rev by zero!") - (let' [[trailing-zeroes remaining] (without-trailing-zeroes 0 ("lux coerce" Nat param)) - [trailing-zeroes denominator] ("lux check" (#Product Nat Nat) - (if ("lux i64 =" +0 trailing-zeroes) - [1 ("lux i64 logical-right-shift" 1 remaining)] - [trailing-zeroes remaining])) - shift ("lux i64 -" trailing-zeroes 64) - numerator ("lux i64 left-shift" shift 1)] - (|> ("lux coerce" Int numerator) - ("lux i64 /" ("lux coerce" Int denominator)) - ("lux i64 *" ("lux coerce" Int subject)) - ("lux coerce" Rev))))) - -(def:''' #export (r/% param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) remainder.")]) - (-> Rev Rev Rev) - (|> ("lux coerce" Nat subject) - (n/% ("lux coerce" Nat param)) - ("lux coerce" Rev))) - -(def:''' #export (r/scale param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) scale.")]) - (-> Nat Rev Rev) - (|> ("lux coerce" Int subject) - ("lux i64 *" ("lux coerce" Int param)) - ("lux coerce" Rev))) - -(def:''' #export (r/reciprocal numerator) - (list [(tag$ ["lux" "doc"]) - (text$ "Rev(olution) reciprocal of a Nat(ural).")]) - (-> Nat Rev) - ("lux coerce" Rev - (let' [[trailing-zeroes remaining] (without-trailing-zeroes 0 numerator)] - (n// remaining - ({0 ("lux coerce" Nat -1) - _ ("lux i64 left-shift" (n/- trailing-zeroes 64) 1)} - trailing-zeroes))))) - (template [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) (list [(tag$ ["lux" "doc"]) @@ -2437,9 +2312,6 @@ [i/min Int i/< "Int(eger) minimum."] [i/max Int i/> "Int(eger) maximum."] - - [r/min Rev r/< "Rev(olution) minimum."] - [r/max Rev r/> "Rev(olution) maximum."] ) (def:''' (bit@encode x) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index ebf1905f1..53ae6cd77 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,8 +1,7 @@ (.module: [lux (#- if loop when n/+ n/- n/* n// n/% n/= n/< n/<= n/> n/>= - i/+ i/- i/* i// i/% i/= i/< i/<= i/> i/>= - r/+ r/- r/* r// r/% r/= r/< r/<= r/> r/>=) + i/+ i/- i/* i// i/% i/= i/< i/<= i/> i/>=) [abstract ["." monad]] [data @@ -12,6 +11,7 @@ [collection ["." list ("#;." fold functor)]] [number + ["r" rev] ["f" frac]]] ["." macro (#+ with-gensyms) ["." code] @@ -229,16 +229,16 @@ [Int Bit i/> .i/>] [Int Bit i/>= .i/>=] - [Rev Rev r/+ .r/+] - [Rev Rev r/- .r/-] - [Rev Rev r/* .r/*] - [Rev Rev r// .r//] - [Rev Rev r/% .r/%] - [Rev Bit r/= .r/=] - [Rev Bit r/< .r/<] - [Rev Bit r/<= .r/<=] - [Rev Bit r/> .r/>] - [Rev Bit r/>= .r/>=] + [Rev Rev r/+ r.+] + [Rev Rev r/- r.-] + [Rev Rev r/* r.*] + [Rev Rev r// r./] + [Rev Rev r/% r.%] + [Rev Bit r/= r.=] + [Rev Bit r/< r.<] + [Rev Bit r/<= r.<=] + [Rev Bit r/> r.>] + [Rev Bit r/>= r.>=] [Frac Frac f/+ f.+] [Frac Frac f/- f.-] diff --git a/stdlib/source/lux/data/format/css/value.lux b/stdlib/source/lux/data/format/css/value.lux index 2c77554c3..169d926c3 100644 --- a/stdlib/source/lux/data/format/css/value.lux +++ b/stdlib/source/lux/data/format/css/value.lux @@ -9,7 +9,7 @@ ["." maybe] [number ["." nat] - ["." rev] + ["r" rev] ["f" frac]] ["." text ["%" format (#+ Format format)]] @@ -834,7 +834,7 @@ (..apply "rgba" (list (%.nat red) (%.nat green) (%.nat blue) - (if (r/= (:: rev.interval top) alpha) + (if (r.= (:: r.interval top) alpha) "1.0" (format "0" (%.rev alpha))))))) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index 4091b292e..b260fe085 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -20,15 +20,139 @@ ["#." nat] ["#." int]]) -(def: #export + (-> Rev Rev Rev) r/+) - -(def: #export - (-> Rev Rev Rev) r/-) +(def: #export (= reference sample) + {#.doc "Rev(olution) equivalence."} + (-> Rev Rev Bit) + ("lux i64 =" reference sample)) + +(def: #export (< reference sample) + {#.doc "Rev(olution) less-than."} + (-> Rev Rev Bit) + (n/< ("lux coerce" Nat reference) + ("lux coerce" Nat sample))) + +(def: #export (<= reference sample) + {#.doc "Rev(olution) less-than-equal."} + (-> Rev Rev Bit) + (if (n/< ("lux coerce" Nat reference) + ("lux coerce" Nat sample)) + #1 + ("lux i64 =" reference sample))) + +(def: #export (> reference sample) + {#.doc "Rev(olution) greater-than."} + (-> Rev Rev Bit) + (..< sample reference)) + +(def: #export (>= reference sample) + {#.doc "Rev(olution) greater-than-equal."} + (-> Rev Rev Bit) + (if (..< sample reference) + #1 + ("lux i64 =" reference sample))) + +(template [<name> <test> <doc>] + [(def: #export (<name> left right) + {#.doc <doc>} + (-> Rev Rev Rev) + (if (<test> right left) + left + right))] + + [min ..< "Rev(olution) minimum."] + [max ..> "Rev(olution) maximum."] + ) -(def: #export * (-> Rev Rev Rev) r/*) +(template [<name> <op> <doc>] + [(def: #export (<name> param subject) + {#.doc <doc>} + (-> Rev Rev Rev) + (<op> param subject))] -(def: #export / (-> Rev Rev Rev) r//) + [+ "lux i64 +" "Rev(olution) addition."] + [- "lux i64 -" "Rev(olution) substraction."] + ) -(def: #export % (-> Rev Rev Rev) r/%) +(def: high + (-> (I64 Any) I64) + (|>> ("lux i64 logical-right-shift" 32))) + +(def: low + (-> (I64 Any) I64) + (let [mask (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))] + (|>> ("lux i64 and" mask)))) + +(def: #export (* param subject) + {#.doc "Rev(olution) multiplication."} + (-> Rev Rev Rev) + (let [subjectH (..high subject) + subjectL (..low subject) + paramH (..high param) + paramL (..low param) + bottom (|> subjectL + ("lux i64 *" paramL) + ("lux i64 logical-right-shift" 32)) + middle ("lux i64 +" + ("lux i64 *" paramL subjectH) + ("lux i64 *" paramH subjectL)) + top ("lux i64 *" subjectH paramH)] + (|> bottom + ("lux i64 +" middle) + ..high + ("lux i64 +" top)))) + +(def: least-significant-bit-mask (I64 Any) 1) + +(def: (without-trailing-zeroes count remaining) + (-> Nat Nat [Nat Nat]) + (if (|> remaining + ("lux i64 and" least-significant-bit-mask) + ("lux i64 =" 0)) + (without-trailing-zeroes + ("lux i64 +" 1 count) + ("lux i64 logical-right-shift" 1 remaining)) + [count remaining])) + +(def: #export (/ param subject) + {#.doc "Rev(olution) division."} + (-> Rev Rev Rev) + (if ("lux i64 =" +0 param) + (error! "Cannot divide Rev by zero!") + (let [[trailing-zeroes remaining] (without-trailing-zeroes 0 (:coerce Nat param)) + [trailing-zeroes denominator] (: [Nat Nat] + (if ("lux i64 =" +0 trailing-zeroes) + [1 ("lux i64 logical-right-shift" 1 remaining)] + [trailing-zeroes remaining])) + shift ("lux i64 -" trailing-zeroes 64) + numerator ("lux i64 left-shift" shift 1)] + (|> (:coerce Int numerator) + ("lux i64 /" ("lux coerce" Int denominator)) + ("lux i64 *" ("lux coerce" Int subject)) + (:coerce Rev))))) + +(def: #export (% param subject) + {#.doc "Rev(olution) remainder."} + (-> Rev Rev Rev) + (|> (:coerce Nat subject) + (n/% (:coerce Nat param)) + (:coerce Rev))) + +(def: #export (scale param subject) + {#.doc "Rev(olution) scale."} + (-> Nat Rev Rev) + (|> (:coerce Int subject) + ("lux i64 *" ("lux coerce" Int param)) + (:coerce Rev))) + +(def: #export (reciprocal numerator) + {#.doc "Rev(olution) reciprocal of a Nat(ural)."} + (-> Nat Rev) + (:coerce Rev + (let [[trailing-zeroes remaining] (without-trailing-zeroes 0 numerator)] + (n// remaining + ({0 (:coerce Nat -1) + _ ("lux i64 left-shift" (n/- trailing-zeroes 64) 1)} + trailing-zeroes))))) (def: #export (/% param subject) (-> Rev Rev [Rev Rev]) @@ -47,11 +171,11 @@ (|>> to-significand ("lux f64 /" frac-denominator))) (structure: #export equivalence (Equivalence Rev) - (def: = r/=)) + (def: = ..=)) (structure: #export order (Order Rev) (def: &equivalence ..equivalence) - (def: < r/<)) + (def: < ..<)) (structure: #export enum (Enum Rev) (def: &order ..order) @@ -69,8 +193,8 @@ (def: compose <compose>))] [addition ..+ bottom] - [maximum r/max bottom] - [minimum r/min top] + [maximum ..max bottom] + [minimum ..min top] ) (def: (de-prefix input) diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux index 2faa761b3..b959593ea 100644 --- a/stdlib/source/lux/math/logic/continuous.lux +++ b/stdlib/source/lux/math/logic/continuous.lux @@ -2,23 +2,23 @@ [lux (#- false true or and not) [data [number - ["." rev ("#@." interval)]]]]) + ["r" rev ("#@." interval)]]]]) -(def: #export true Rev rev@top) -(def: #export false Rev rev@bottom) +(def: #export true Rev r@top) +(def: #export false Rev r@bottom) (template [<name> <chooser>] [(def: #export <name> (-> Rev Rev Rev) <chooser>)] - [and r/min] - [or r/max] + [and r.min] + [or r.max] ) (def: #export (not input) (-> Rev Rev) - (r/- input ..true)) + (r.- input ..true)) (def: #export (implies consequent antecedent) (-> Rev Rev Rev) @@ -28,9 +28,9 @@ (def: #export (includes sub super) (-> Rev Rev Rev) (let [-sub (not sub) - sum (r/+ -sub super) - no-overflow? (.and (r/>= -sub sum) - (r/>= super sum))] + sum (r.+ -sub super) + no-overflow? (.and (r.>= -sub sum) + (r.>= super sum))] (if no-overflow? sum ..true))) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index f27c51ec7..59343163e 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -3,6 +3,8 @@ [abstract [predicate (#+ Predicate)]] [data + [number + ["r" rev]] [collection ["." list] ["." set (#+ Set)]]]] @@ -53,38 +55,38 @@ (def: (ascending from to) (-> Rev Rev (Fuzzy Rev)) (function (_ elem) - (cond (r/<= from elem) + (cond (r.<= from elem) &.false - (r/>= to elem) + (r.>= to elem) &.true ## in the middle... - (r// (r/- from to) - (r/- from elem))))) + (r./ (r.- from to) + (r.- from elem))))) (def: (descending from to) (-> Rev Rev (Fuzzy Rev)) (function (_ elem) - (cond (r/<= from elem) + (cond (r.<= from elem) &.true - (r/>= to elem) + (r.>= to elem) &.false ## in the middle... - (r// (r/- from to) - (r/- elem to))))) + (r./ (r.- from to) + (r.- elem to))))) (def: #export (gradient from to) (-> Rev Rev (Fuzzy Rev)) - (if (r/< to from) + (if (r.< to from) (ascending from to) (descending from to))) (def: #export (triangle bottom middle top) (-> Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r/< (list bottom middle top)) + (case (list.sort r.< (list bottom middle top)) (^ (list bottom middle top)) (intersection (ascending bottom middle) (descending middle top)) @@ -94,7 +96,7 @@ (def: #export (trapezoid bottom middle-bottom middle-top top) (-> Rev Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r/< (list bottom middle-bottom middle-top top)) + (case (list.sort r.< (list bottom middle-bottom middle-top top)) (^ (list bottom middle-bottom middle-top top)) (intersection (ascending bottom middle-bottom) (descending middle-top top)) @@ -106,14 +108,14 @@ (All [a] (-> Rev (Fuzzy a) (Fuzzy a))) (function (_ elem) (let [membership (set elem)] - (if (r/> treshold membership) - (|> membership (r/- treshold) (r/* &.true)) + (if (r.> treshold membership) + (|> membership (r.- treshold) (r.* &.true)) &.false)))) (def: #export (to-predicate treshold set) (All [a] (-> Rev (Fuzzy a) (Predicate a))) (function (_ elem) - (r/> treshold (set elem)))) + (r.> treshold (set elem)))) (type: #export (Fuzzy2 a) (-> a [Rev Rev])) @@ -123,6 +125,6 @@ (function (_ elem) (let [l-rev (lower elem) u-rev (upper elem)] - [(r/min l-rev + [(r.min l-rev u-rev) u-rev]))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index e1039d506..597f6d83e 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -21,7 +21,7 @@ [number ["." i64] ["." int] - ["." rev] + ["r" rev] ["f" frac]]] ["." math] ["_" test (#+ Test)] @@ -32,7 +32,8 @@ [language (#+)] [territory (#+)]] ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random) ("#@." functor)] + [math + ["." random (#+ Random) ("#@." functor)]] ## TODO: Test these modules [data [format @@ -137,23 +138,23 @@ (def: identity Test - (do r.monad - [self (r.unicode 1)] + (do random.monad + [self (random.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." (is? self self)) (_.test "The identity function doesn't change values in any way." (is? self (function.identity self))) (do @ - [other (r.unicode 1)] + [other (random.unicode 1)] (_.test "Values created separately can't be identical." (not (is? self other)))) ))) (def: increment-and-decrement Test - (do r.monad - [value r.i64] + (do random.monad + [value random.i64] ($_ _.and (_.test "'inc' and 'dec' are opposites." (and (|> value inc dec (n/= value)) @@ -169,7 +170,7 @@ (def: (even-or-odd rand-gen even? odd?) (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) - (do r.monad + (do random.monad [value rand-gen] ($_ _.and (_.test "Every number is either even or odd." @@ -192,7 +193,7 @@ (def: (choice rand-gen = [< choose]) (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) - (do r.monad + (do random.monad [left rand-gen right rand-gen #let [choice (choose left right)]] @@ -215,22 +216,22 @@ (def: (conversion rand-gen forward backward =) (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) - (do r.monad + (do random.monad [value rand-gen] (_.test "Can convert between types in a lossless way." (|> value forward backward (= value))))) (def: frac-rev - (r.Random Rev) + (Random Rev) (let [bits-to-ignore 11] - (:: r.functor map (i64.left-shift bits-to-ignore) r.rev))) + (:: random.functor map (i64.left-shift bits-to-ignore) random.rev))) (def: prelude-macros Test ($_ _.and - (do r.monad - [factor (r@map (|>> (n/% 10) (n/max 1)) r.nat) - iterations (r@map (n/% 100) r.nat) + (do random.monad + [factor (random@map (|>> (n/% 10) (n/max 1)) random.nat) + iterations (random@map (n/% 100) random.nat) #let [expected (n/* factor iterations)]] (_.test "Can write loops." (n/= expected @@ -240,10 +241,10 @@ (recur (inc counter) (n/+ factor value)) value))))) - (do r.monad - [first r.nat - second r.nat - third r.nat] + (do random.monad + [first random.nat + second random.nat + third random.nat] (_.test "Can create lists easily through macros." (and (case (list first second third) (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) @@ -276,19 +277,19 @@ (def: templates Test - (do r.monad - [cat0 r.nat - cat1 r.nat] + (do random.monad + [cat0 random.nat + cat1 random.nat] (_.test "Template application is a stand-in for the templated code." (n/= (n/+ (n/* cat0 cat0) (n/* cat1 cat1)) (quadrance cat0 cat1))))) (def: cross-platform-support Test - (do r.monad - [on-default r.nat - on-fake-host r.nat - on-valid-host r.nat] + (do random.monad + [on-default random.nat + on-fake-host random.nat + on-valid-host random.nat] ($_ _.and (_.test "Can provide default in case there is no particular host/platform support." (n/= on-default @@ -311,19 +312,19 @@ (<| (_.context "Even or odd.") ($_ _.and (<| (_.context "Natural numbers.") - (..even-or-odd r.nat n/even? n/odd?)) + (..even-or-odd random.nat n/even? n/odd?)) (<| (_.context "Integers.") - (..even-or-odd r.int i/even? i/odd?)))) + (..even-or-odd random.int i/even? i/odd?)))) (<| (_.context "Minimum and maximum.") (`` ($_ _.and (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>] [(<| (_.context <context>) (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] - [i/= i/< i/min i/> i/max r.int "Integers."] - [n/= n/< n/min n/> n/max r.nat "Natural numbers."] - [r/= r/< r/min r/> r/max r.rev "Revolutions."] - [f.= f.< f.min f.> f.max r.safe-frac "Fractions."] + [i/= i/< i/min i/> i/max random.int "Integers."] + [n/= n/< n/min n/> n/max random.nat "Natural numbers."] + [r.= r.< r.min r.> r.max random.rev "Revolutions."] + [f.= f.< f.min f.> f.max random.safe-frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and @@ -332,11 +333,11 @@ " " (%.name (name-of <backward>)))) (..conversion <gen> <forward> <backward> <=>))] - [i/= .nat .int (r@map (i/% +1,000,000) r.int)] - [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] - [i/= int.frac f.int (r@map (i/% +1,000,000) r.int)] - [f.= f.int int.frac (r@map (|>> (i/% +1,000,000) int.frac) r.int)] - [r/= rev.frac f.rev frac-rev] + [i/= .nat .int (random@map (i/% +1,000,000) random.int)] + [n/= .int .nat (random@map (n/% 1,000,000) random.nat)] + [i/= int.frac f.int (random@map (i/% +1,000,000) random.int)] + [f.= f.int int.frac (random@map (|>> (i/% +1,000,000) int.frac) random.int)] + [r.= r.frac f.rev frac-rev] ))))) (<| (_.context "Prelude macros.") ..prelude-macros) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 1a0bc4571..b84943a14 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -42,10 +42,10 @@ [/.binary] [/.octal] [/.decimal] [/.hex] )) (_.test "Alternate notations." - (and (r/= (bin ".11001001") + (and (/.= (bin ".11001001") (bin ".11,00,10,01")) - (r/= (oct ".615243") + (/.= (oct ".615243") (oct ".615,243")) - (r/= (hex ".deadBEEF") + (/.= (hex ".deadBEEF") (hex ".dead,BEEF")))) )))) diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux index 6895060c1..6c4b8a721 100644 --- a/stdlib/source/test/lux/math/logic/continuous.lux +++ b/stdlib/source/test/lux/math/logic/continuous.lux @@ -2,31 +2,35 @@ [lux #* ["%" data/text/format (#+ format)] [abstract/monad (#+ do)] - ["r" math/random] - ["_" test (#+ Test)]] + ["_" test (#+ Test)] + [math + ["." random]] + [data + [number + ["r" rev]]]] {1 ["." /]}) (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad - [left r.rev - right r.rev] + (do random.monad + [left random.rev + right random.rev] ($_ _.and (_.test "AND is the minimum." (let [result (/.and left right)] - (and (r/<= left result) - (r/<= right result)))) + (and (r.<= left result) + (r.<= right result)))) (_.test "OR is the maximum." (let [result (/.or left right)] - (and (r/>= left result) - (r/>= right result)))) + (and (r.>= left result) + (r.>= right result)))) (_.test "Double negation results in the original value." - (r/= left (/.not (/.not left)))) + (r.= left (/.not (/.not left)))) (_.test "Every value is equivalent to itself." - (and (r/>= left + (and (r.>= left (/.= left left)) - (r/>= right + (r.>= right (/.= right right)))) )))) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 3d21a1f21..35dff4a03 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -2,13 +2,14 @@ [lux #* ["%" data/text/format (#+ format)] [abstract/monad (#+ do)] - ["r" math/random (#+ Random)] + [math + ["." random (#+ Random)]] ["_" test (#+ Test)] [data ["." bit ("#@." equivalence)] [number ["." nat] - ["." rev]] + ["r" rev]] [collection ["." list] ["." set]]]] @@ -21,8 +22,8 @@ [(def: <name> Test (<| (_.context (%.name (name-of <triangle>))) - (do r.monad - [values (r.set <hash> 3 <gen>) + (do random.monad + [values (random.set <hash> 3 <gen>) #let [[x y z] (case (set.to-list values) (^ (list x y z)) [x y z] @@ -39,29 +40,29 @@ triangle (<triangle> x y z)]] ($_ _.and (_.test "The middle value will always have maximum membership." - (r/= //.true (/.membership middle triangle))) + (r.= //.true (/.membership middle triangle))) (_.test "Boundary values will always have 0 membership." - (and (r/= //.false (/.membership bottom triangle)) - (r/= //.false (/.membership top triangle)))) + (and (r.= //.false (/.membership bottom triangle)) + (r.= //.false (/.membership top triangle)))) (_.test "Values within range, will have membership > 0." - (bit@= (r/> //.false (/.membership sample triangle)) + (bit@= (r.> //.false (/.membership sample triangle)) (and (<gt> bottom sample) (<lt> top sample)))) (_.test "Values outside of range, will have membership = 0." - (bit@= (r/= //.false (/.membership sample triangle)) + (bit@= (r.= //.false (/.membership sample triangle)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] - [rev-triangles "Rev" rev.hash r.rev /.triangle r/< r/<= r/> r/>=] + [rev-triangles "Rev" r.hash random.rev /.triangle r.< r.<= r.> r.>=] ) (template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] [(def: <name> Test (<| (_.context (%.name (name-of <trapezoid>))) - (do r.monad - [values (r.set <hash> 4 <gen>) + (do random.monad + [values (random.set <hash> 4 <gen>) #let [[w x y z] (case (set.to-list values) (^ (list w x y z)) [w x y z] @@ -78,96 +79,96 @@ trapezoid (<trapezoid> w x y z)]] ($_ _.and (_.test "The middle values will always have maximum membership." - (and (r/= //.true (/.membership middle-bottom trapezoid)) - (r/= //.true (/.membership middle-top trapezoid)))) + (and (r.= //.true (/.membership middle-bottom trapezoid)) + (r.= //.true (/.membership middle-top trapezoid)))) (_.test "Boundary values will always have 0 membership." - (and (r/= //.false (/.membership bottom trapezoid)) - (r/= //.false (/.membership top trapezoid)))) + (and (r.= //.false (/.membership bottom trapezoid)) + (r.= //.false (/.membership top trapezoid)))) (_.test "Values within inner range will have membership = 1" - (bit@= (r/= //.true (/.membership sample trapezoid)) + (bit@= (r.= //.true (/.membership sample trapezoid)) (and (<gte> middle-bottom sample) (<lte> middle-top sample)))) (_.test "Values within range, will have membership > 0." - (bit@= (r/> //.false (/.membership sample trapezoid)) + (bit@= (r.> //.false (/.membership sample trapezoid)) (and (<gt> bottom sample) (<lt> top sample)))) (_.test "Values outside of range, will have membership = 0." - (bit@= (r/= //.false (/.membership sample trapezoid)) + (bit@= (r.= //.false (/.membership sample trapezoid)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] - [rev-trapezoids "Rev" rev.hash r.rev /.trapezoid r/< r/<= r/> r/>=] + [rev-trapezoids "Rev" r.hash random.rev /.trapezoid r.< r.<= r.> r.>=] ) (def: #export triangle (Random (Fuzzy Rev)) - (do r.monad - [x r.rev - y r.rev - z r.rev] + (do random.monad + [x random.rev + y random.rev + z random.rev] (wrap (/.triangle x y z)))) (def: combinators Test (<| (_.context "Combinators") - (do r.monad + (do random.monad [left ..triangle right ..triangle - sample r.rev] + sample random.rev] ($_ _.and (_.test (%.name (name-of /.union)) (let [combined (/.union left right) combined-membership (/.membership sample combined)] - (and (r/>= (/.membership sample left) + (and (r.>= (/.membership sample left) combined-membership) - (r/>= (/.membership sample right) + (r.>= (/.membership sample right) combined-membership)))) (_.test (%.name (name-of /.intersection)) (let [combined (/.intersection left right) combined-membership (/.membership sample combined)] - (and (r/<= (/.membership sample left) + (and (r.<= (/.membership sample left) combined-membership) - (r/<= (/.membership sample right) + (r.<= (/.membership sample right) combined-membership)))) (_.test (%.name (name-of /.complement)) - (r/= (/.membership sample left) + (r.= (/.membership sample left) (//.not (/.membership sample (/.complement left))))) (_.test (%.name (name-of /.difference)) - (r/<= (/.membership sample right) + (r.<= (/.membership sample right) (/.membership sample (/.difference left right)))) )))) (def: predicates-and-sets Test - (do r.monad + (do random.monad [#let [set-10 (set.from-list nat.hash (list.n/range 0 10))] - sample (|> r.nat (:: @ map (n/% 20)))] + sample (|> random.nat (:: @ map (n/% 20)))] ($_ _.and (_.test (%.name (name-of /.from-predicate)) - (bit@= (r/= //.true (/.membership sample (/.from-predicate n/even?))) + (bit@= (r.= //.true (/.membership sample (/.from-predicate n/even?))) (n/even? sample))) (_.test (%.name (name-of /.from-set)) - (bit@= (r/= //.true (/.membership sample (/.from-set set-10))) + (bit@= (r.= //.true (/.membership sample (/.from-set set-10))) (set.member? set-10 sample))) ))) (def: thresholds Test - (do r.monad + (do random.monad [fuzzy ..triangle - sample r.rev - threshold r.rev + sample random.rev + threshold random.rev #let [vip-fuzzy (/.cut threshold fuzzy) member? (/.to-predicate threshold fuzzy)]] (<| (_.context (%.name (name-of /.cut))) ($_ _.and (_.test "Can increase the threshold of membership of a fuzzy set." - (bit@= (r/> //.false (/.membership sample vip-fuzzy)) - (r/> threshold (/.membership sample fuzzy)))) + (bit@= (r.> //.false (/.membership sample vip-fuzzy)) + (r.> threshold (/.membership sample fuzzy)))) (_.test "Can turn fuzzy sets into predicates through a threshold." (bit@= (member? sample) - (r/> threshold (/.membership sample fuzzy)))) + (r.> threshold (/.membership sample fuzzy)))) )))) (def: #export test |