From 376ed521cd92c2c53f2e9cc3cb16b85b67e2fdea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 4 Jul 2018 22:38:56 -0400 Subject: - Re-named "degree" to "revolution". --- stdlib/test/test/lux.lux | 24 ++++---- stdlib/test/test/lux/data/number.lux | 32 +++++----- stdlib/test/test/lux/data/number/complex.lux | 68 +++++++++++----------- stdlib/test/test/lux/data/number/ratio.lux | 48 +++++++-------- stdlib/test/test/lux/data/text/format.lux | 2 +- .../test/test/lux/lang/compiler/analysis/case.lux | 2 +- .../test/lux/lang/compiler/analysis/primitive.lux | 4 +- .../test/lux/lang/compiler/synthesis/primitive.lux | 8 +-- stdlib/test/test/lux/lang/syntax.lux | 2 +- stdlib/test/test/lux/macro/syntax.lux | 2 +- stdlib/test/test/lux/math/logic/continuous.lux | 18 +++--- stdlib/test/test/lux/math/logic/fuzzy.lux | 66 ++++++++++----------- 12 files changed, 138 insertions(+), 138 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 6061f4829..fc649eec3 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -83,7 +83,7 @@ ["Int" r.int i/= i/< i/> i/<= i/>= i/min i/max] ["Nat" r.nat n/= n/< n/> n/<= n/>= n/min n/max] ["Frac" r.frac f/= f/< f/> f/<= f/>= f/min f/max] - ["Deg" r.deg d/= d/< d/> d/<= d/>= d/min d/max] + ["Rev" r.rev r/= r/< r/> r/<= r/>= r/min r/max] ) (do-template [category rand-gen = + - * / <%> > <0> <1> ] @@ -111,10 +111,10 @@ (do @ [x rand-gen] (test "" - ## Skip this test for Deg - ## because Deg division loses the last + ## Skip this test for Rev + ## because Rev division loses the last ## 32 bits of precision. - (or (text/= "Deg" category) + (or (text/= "Rev" category) (and (|> x (* <1>) (= x)) (|> x (/ <1>) (= x)))))))) @@ -128,10 +128,10 @@ #let [r (<%> y x) x' (- r x)]] (test "" - ## Skip this test for Deg - ## because Deg division loses the last + ## Skip this test for Rev + ## because Rev division loses the last ## 32 bits of precision. - (or (text/= "Deg" category) + (or (text/= "Rev" category) (or (> x' y) (|> x' (/ y) (* y) (= x')))) ))))] @@ -139,12 +139,12 @@ ["Nat" r.nat n/= n/+ n/- n/* n// n/% n/> +0 +1 +1_000_000 (n/% +1_000) id] ["Int" r.int i/= i/+ i/- i/* i// i/% i/> 0 1 1_000_000 (i/% 1_000) id] ["Frac" r.frac f/= f/+ f/- f/* f// f/% f/> 0.0 1.0 1_000_000.0 id math.floor] - ["Deg" r.deg d/= d/+ d/- d/* d// d/% d/> .0 (.deg -1) (.deg -1) id id] + ["Rev" r.rev r/= r/+ r/- r/* r// r/% r/> .0 (.rev -1) (.rev -1) id id] ) -(def: frac-deg - (r.Random Deg) - (|> r.deg +(def: frac-rev + (r.Random Rev) + (|> r.rev (:: r.Functor map (|>> (bit.left-shift +11) (bit.right-shift +11))))) (do-template [category rand-gen -> <- = ] @@ -160,7 +160,7 @@ ["Nat->Int" r.nat .int .nat n/= (n/% +1_000_000)] ["Int->Frac" r.int int-to-frac frac-to-int i/= (i/% 1_000_000)] ["Frac->Int" r.frac frac-to-int int-to-frac f/= math.floor] - ["Deg->Frac" frac-deg deg-to-frac frac-to-deg d/= id] + ["Rev->Frac" frac-rev rev-to-frac frac-to-rev r/= id] ) (context: "Simple macros and constructs" diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index e6692fb3d..9f3d94a2e 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -22,8 +22,8 @@ ["Nat" r.nat Eq Order] ["Int" r.int Eq Order] + ["Rev" r.rev Eq Order] ["Frac" r.frac Eq Order] - ["Deg" r.deg Eq Order] ) (do-template [category rand-gen ] @@ -39,14 +39,14 @@ (not (= x (negate x)))) (= x (negate (negate x))) ## There is loss of precision when multiplying - (or (Text/= "Deg" category) + (or (Text/= "Rev" category) (= x (* (signum x) (abs x)))))))))] - ## ["Nat" r.nat Number] + ["Nat" r.nat Number Order] ["Int" r.int Number Order] + ["Rev" r.rev Number Order] ["Frac" r.frac Number Order] - ["Deg" r.deg Number Order] ) (do-template [category rand-gen ] @@ -84,8 +84,8 @@ ["Nat" r.nat Number Order Interval (function (_ _) true)] ["Int" r.int Number Order Interval (function (_ _) true)] ## Both min and max values will be positive (thus, greater than zero) + ["Rev" r.rev Number Order Interval (function (_ _) true)] ["Frac" r.frac Number Order Interval (f/> 0.0)] - ["Deg" r.deg Number Order Interval (function (_ _) true)] ) (do-template [category rand-gen ] @@ -109,14 +109,14 @@ ["Int/Mul" r.int Number Order Mul@Monoid (i/% 1000) (function (_ _) true)] ["Int/Min" r.int Number Order Min@Monoid (i/% 1000) (function (_ _) true)] ["Int/Max" r.int Number Order Max@Monoid (i/% 1000) (function (_ _) true)] + ["Rev/Add" r.rev Number Order Add@Monoid (r/% .125) (function (_ _) true)] + ["Rev/Mul" r.rev Number Order Mul@Monoid (r/% .125) (function (_ _) true)] + ["Rev/Min" r.rev Number Order Min@Monoid (r/% .125) (function (_ _) true)] + ["Rev/Max" r.rev Number Order Max@Monoid (r/% .125) (function (_ _) true)] ["Frac/Add" r.frac Number Order Add@Monoid (f/% 1000.0) (f/> 0.0)] ["Frac/Mul" r.frac Number Order Mul@Monoid (f/% 1000.0) (f/> 0.0)] ["Frac/Min" r.frac Number Order Min@Monoid (f/% 1000.0) (f/> 0.0)] ["Frac/Max" r.frac Number Order Max@Monoid (f/% 1000.0) (f/> 0.0)] - ["Deg/Add" r.deg Number Order Add@Monoid (d/% .125) (function (_ _) true)] - ## ["Deg/Mul" r.deg Number Order Mul@Monoid (d/% .125) (function (_ _) true)] - ["Deg/Min" r.deg Number Order Min@Monoid (d/% .125) (function (_ _) true)] - ["Deg/Max" r.deg Number Order Max@Monoid (d/% .125) (function (_ _) true)] ) (do-template [ ] @@ -144,10 +144,10 @@ ["Int/Decimal" r.int Eq Codec] ["Int/Hex" r.int Eq Hex@Codec] - ["Deg/Binary" r.deg Eq Binary@Codec] - ["Deg/Octal" r.deg Eq Octal@Codec] - ["Deg/Decimal" r.deg Eq Codec] - ["Deg/Hex" r.deg Eq Hex@Codec] + ["Rev/Binary" r.rev Eq Binary@Codec] + ["Rev/Octal" r.rev Eq Octal@Codec] + ["Rev/Decimal" r.rev Eq Codec] + ["Rev/Hex" r.rev Eq Hex@Codec] ["Frac/Binary" r.frac Eq Binary@Codec] ["Frac/Octal" r.frac Eq Octal@Codec] @@ -169,15 +169,15 @@ (test "Binary." (and (n/= (bin "+11001001") (bin "+11_00_10_01")) (i/= (bin "11001001") (bin "11_00_10_01")) - (d/= (bin ".11001001") (bin ".11_00_10_01")) + (r/= (bin ".11001001") (bin ".11_00_10_01")) (f/= (bin "1100.1001") (bin "11_00.10_01")))) (test "Octal." (and (n/= (oct "+615243") (oct "+615_243")) (i/= (oct "615243") (oct "615_243")) - (d/= (oct ".615243") (oct ".615_243")) + (r/= (oct ".615243") (oct ".615_243")) (f/= (oct "6152.43") (oct "615_2.43")))) (test "Hexadecimal." (and (n/= (hex "+deadBEEF") (hex "+dead_BEEF")) (i/= (hex "deadBEEF") (hex "dead_BEEF")) - (d/= (hex ".deadBEEF") (hex ".dead_BEEF")) + (r/= (hex ".deadBEEF") (hex ".dead_BEEF")) (f/= (hex "deadBE.EF") (hex "dead_BE.EF")))))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index 14ab1c76c..6219eedcc 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -62,19 +62,19 @@ ($_ seq (test "Absolute value of complex >= absolute value of any of the parts." (let [r+i (&.complex real imaginary) - abs (get@ #&.real (&.c/abs r+i))] + abs (get@ #&.real (&.abs r+i))] (and (f/>= (frac/abs real) abs) (f/>= (frac/abs imaginary) abs)))) (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (number.not-a-number? (get@ #&.real (&.c/abs (&.complex number.not-a-number imaginary)))) - (number.not-a-number? (get@ #&.real (&.c/abs (&.complex real number.not-a-number)))))) + (and (number.not-a-number? (get@ #&.real (&.abs (&.complex number.not-a-number imaginary)))) + (number.not-a-number? (get@ #&.real (&.abs (&.complex real number.not-a-number)))))) (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex number.positive-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex real number.positive-infinity)))) - (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex number.negative-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex real number.negative-infinity)))))) + (and (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.positive-infinity imaginary)))) + (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.positive-infinity)))) + (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.negative-infinity imaginary)))) + (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.negative-infinity)))))) )))) (context: "Addidion, substraction, multiplication and division" @@ -85,40 +85,40 @@ factor gen-dim] ($_ seq (test "Adding 2 complex numbers is the same as adding their parts." - (let [z (&.c/+ y x)] - (and (&.c/= z - (&.complex (f/+ (get@ #&.real y) - (get@ #&.real x)) - (f/+ (get@ #&.imaginary y) - (get@ #&.imaginary x))))))) + (let [z (&.+ y x)] + (and (&.= z + (&.complex (f/+ (get@ #&.real y) + (get@ #&.real x)) + (f/+ (get@ #&.imaginary y) + (get@ #&.imaginary x))))))) (test "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&.c/- y x)] - (and (&.c/= z - (&.complex (f/- (get@ #&.real y) - (get@ #&.real x)) - (f/- (get@ #&.imaginary y) - (get@ #&.imaginary x))))))) + (let [z (&.- y x)] + (and (&.= z + (&.complex (f/- (get@ #&.real y) + (get@ #&.real x)) + (f/- (get@ #&.imaginary y) + (get@ #&.imaginary x))))))) (test "Subtraction is the inverse of addition." - (and (|> x (&.c/+ y) (&.c/- y) (within? margin-of-error x)) - (|> x (&.c/- y) (&.c/+ y) (within? margin-of-error x)))) + (and (|> x (&.+ y) (&.- y) (within? margin-of-error x)) + (|> x (&.- y) (&.+ y) (within? margin-of-error x)))) (test "Division is the inverse of multiplication." - (|> x (&.c/* y) (&.c// y) (within? margin-of-error x))) + (|> x (&.* y) (&./ y) (within? margin-of-error x))) (test "Scalar division is the inverse of scalar multiplication." - (|> x (&.c/*' factor) (&.c//' factor) (within? margin-of-error x))) + (|> x (&.*' factor) (&./' factor) (within? margin-of-error x))) (test "If you subtract the remainder, all divisions must be exact." - (let [rem (&.c/% y x) - quotient (|> x (&.c/- rem) (&.c// y)) + (let [rem (&.% y x) + quotient (|> x (&.- rem) (&./ y)) floored (|> quotient (update@ #&.real math.floor) (update@ #&.imaginary math.floor))] (within? 0.000000000001 x - (|> quotient (&.c/* y) (&.c/+ rem))))) + (|> quotient (&.* y) (&.+ rem))))) )))) (context: "Conjugate, reciprocal, signum, negation" @@ -137,23 +137,23 @@ (|> x &.reciprocal &.reciprocal (within? margin-of-error x))) (test "x*(x^-1) = 1" - (|> x (&.c/* (&.reciprocal x)) (within? margin-of-error &.one))) + (|> x (&.* (&.reciprocal x)) (within? margin-of-error &.one))) (test "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &.c/signum &.c/abs (get@ #&.real))] + (let [signum-abs (|> x &.signum &.abs (get@ #&.real))] (or (f/= 0.0 signum-abs) (f/= 1.0 signum-abs) (f/= (math.pow 0.5 2.0) signum-abs)))) (test "Negation is its own inverse." - (let [there (&.c/negate x) - back-again (&.c/negate there)] - (and (not (&.c/= there x)) - (&.c/= back-again x)))) + (let [there (&.negate x) + back-again (&.negate there)] + (and (not (&.= there x)) + (&.= back-again x)))) (test "Negation doesn't change the absolute value." - (f/= (get@ #&.real (&.c/abs x)) - (get@ #&.real (&.c/abs (&.c/negate x))))) + (f/= (get@ #&.real (&.abs x)) + (get@ #&.real (&.abs (&.negate x))))) )))) (def: (trigonometric-symmetry forward backward angle) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index 73e43e6c5..c96c6f5ca 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -28,14 +28,14 @@ sample gen-ratio] ($_ seq (test "All zeroes are the same." - (&.r/= (&.ratio +0 denom1) - (&.ratio +0 denom2))) + (&.= (&.ratio +0 denom1) + (&.ratio +0 denom2))) (test "All ratios are built normalized." (|> sample &.normalize ("lux in-module" "lux/data/number/ratio") - (&.r/= sample))) + (&.= sample))) )))) (context: "Arithmetic" @@ -43,29 +43,29 @@ (do @ [x gen-ratio y gen-ratio - #let [min (&.r/min x y) - max (&.r/max x y)]] + #let [min (&.min x y) + max (&.max x y)]] ($_ seq (test "Addition and subtraction are opposites." - (and (|> max (&.r/- min) (&.r/+ min) (&.r/= max)) - (|> max (&.r/+ min) (&.r/- min) (&.r/= max)))) + (and (|> max (&.- min) (&.+ min) (&.= max)) + (|> max (&.+ min) (&.- min) (&.= max)))) (test "Multiplication and division are opposites." - (and (|> max (&.r// min) (&.r/* min) (&.r/= max)) - (|> max (&.r/* min) (&.r// min) (&.r/= max)))) + (and (|> max (&./ min) (&.* min) (&.= max)) + (|> max (&.* min) (&./ min) (&.= max)))) (test "Modulus by a larger ratio doesn't change the value." - (|> min (&.r/% max) (&.r/= min))) + (|> min (&.% max) (&.= min))) (test "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&.r/% min) (&.r/< min))) + (|> max (&.% min) (&.< min))) (test "Can get the remainder of a division." - (let [remainder (&.r/% min max) - multiple (&.r/- remainder max) - factor (&.r// min multiple)] + (let [remainder (&.% min max) + multiple (&.- remainder max) + factor (&./ min multiple)] (and (|> factor (get@ #&.denominator) (n/= +1)) - (|> factor (&.r/* min) (&.r/+ remainder) (&.r/= max))))) + (|> factor (&.* min) (&.+ remainder) (&.= max))))) )))) (context: "Negation, absolute value and signum" @@ -76,14 +76,14 @@ (test "Negation is it's own inverse." (let [there (&/negate sample) back-again (&/negate there)] - (and (not (&.r/= there sample)) - (&.r/= back-again sample)))) + (and (not (&.= there sample)) + (&.= back-again sample)))) (test "All ratios are already at their absolute value." - (|> sample &/abs (&.r/= sample))) + (|> sample &/abs (&.= sample))) (test "Signum is the identity." - (|> sample (&.r/* (&/signum sample)) (&.r/= sample))) + (|> sample (&.* (&/signum sample)) (&.= sample))) )))) (context: "Order" @@ -93,10 +93,10 @@ y gen-ratio] ($_ seq (test "Can compare ratios." - (and (or (&.r/<= y x) - (&.r/> y x)) - (or (&.r/>= y x) - (&.r/< y x)))) + (and (or (&.<= y x) + (&.> y x)) + (or (&.>= y x) + (&.< y x)))) )))) (context: "Codec" @@ -107,7 +107,7 @@ (test "Can encode/decode ratios." (|> sample &/encode &/decode (case> (#.Right output) - (&.r/= sample output) + (&.= sample output) _ false)))))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index 8232fe82d..ccffe2fcf 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -15,7 +15,7 @@ (&/= "+123" (%n +123)) (&/= "123" (%i 123)) (&/= "123.456" (%f 123.456)) - (&/= ".5" (%d .5)) + (&/= ".5" (%r .5)) (&/= "\"YOLO\"" (%t "YOLO")) (&/= "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))))) ))) diff --git a/stdlib/test/test/lux/lang/compiler/analysis/case.lux b/stdlib/test/test/lux/lang/compiler/analysis/case.lux index d2836558e..cbf11b164 100644 --- a/stdlib/test/test/lux/lang/compiler/analysis/case.lux +++ b/stdlib/test/test/lux/lang/compiler/analysis/case.lux @@ -61,7 +61,7 @@ (r/wrap (list (' _))))) ([#.Nat r.nat code.nat] [#.Int r.int code.int] - [#.Deg r.deg code.deg] + [#.Rev r.rev code.rev] [#.Frac r.frac code.frac] [#.Text (r.unicode +5) code.text]) diff --git a/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux b/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux index 0d4bffb39..6f4cd1afc 100644 --- a/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux +++ b/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux @@ -33,7 +33,7 @@ [Bool code.bool r.bool] [Nat code.nat r.nat] [Int code.int r.int] - [Deg code.deg r.deg] + [Rev code.rev r.rev] [Frac code.frac r.frac] [Text code.text (r.unicode +5)] ))))) @@ -80,7 +80,7 @@ ["bool" Bool #analysis.Bool r.bool code.bool] ["nat" Nat #analysis.Nat r.nat code.nat] ["int" Int #analysis.Int r.int code.int] - ["deg" Deg #analysis.Deg r.deg code.deg] + ["rev" Rev #analysis.Rev r.rev code.rev] ["frac" Frac #analysis.Frac r.frac code.frac] ["text" Text #analysis.Text (r.unicode +5) code.text] ))))))) diff --git a/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux index aa0da89ea..0fd4d58c1 100644 --- a/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux +++ b/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux @@ -23,7 +23,7 @@ r.bool r.nat r.int - r.deg + r.rev r.frac (r.unicode +5)))] (wrap (#analysisL.Primitive primitive)))) @@ -48,7 +48,7 @@ (is? valueS (.i64 valueA)) [(#//.Primitive (#//.I64 valueS)) - (#analysisL.Primitive (#analysisL.Deg valueA))] + (#analysisL.Primitive (#analysisL.Rev valueA))] (is? valueS (.i64 valueA)) [(#//.Primitive (#//.F64 valueS)) @@ -68,7 +68,7 @@ [%bool% r.bool %nat% r.nat %int% r.int - %deg% r.deg + %rev% r.rev %frac% r.frac %text% (r.unicode +5)] (`` ($_ seq @@ -87,6 +87,6 @@ ["bool" #analysisL.Bool #//.Bool %bool%] ["nat" #analysisL.Nat #//.I64 (.i64 %nat%)] ["int" #analysisL.Int #//.I64 (.i64 %int%)] - ["deg" #analysisL.Deg #//.I64 (.i64 %deg%)] + ["rev" #analysisL.Rev #//.I64 (.i64 %rev%)] ["frac" #analysisL.Frac #//.F64 %frac%] ["text" #analysisL.Text #//.Text %text%]))))))) diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux index 0645bfe25..0ea9c5b9c 100644 --- a/stdlib/test/test/lux/lang/syntax.lux +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -46,7 +46,7 @@ (|> r.bool (r/map code.bool)) (|> r.nat (r/map code.nat)) (|> r.int (r/map code.int)) - (|> r.deg (r/map code.deg)) + (|> r.rev (r/map code.rev)) (|> r.frac (r/map code.frac)))) textual^ (: (r.Random Code) ($_ r.either diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index ba45ff6e4..342845337 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -73,7 +73,7 @@ ["Can parse Bool syntax." true code.bool bool.Eq s.bool] ["Can parse Nat syntax." +123 code.nat number.Eq s.nat] ["Can parse Int syntax." 123 code.int number.Eq s.int] - ["Can parse Deg syntax." .123 code.deg number.Eq s.deg] + ["Can parse Rev syntax." .123 code.rev number.Eq s.rev] ["Can parse Frac syntax." 123.0 code.frac number.Eq s.frac] ["Can parse Text syntax." "\n" code.text text.Eq s.text] ["Can parse Symbol syntax." ["yolo" "lol"] code.symbol ident.Eq s.symbol] diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux index 68ddc376c..f5eb9d1c7 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -9,25 +9,25 @@ (context: "Operations" (<| (times +100) (do @ - [left r.deg - right r.deg] + [left r.rev + right r.rev] ($_ seq (test "AND is the minimum." (let [result (&.~and left right)] - (and (d/<= left result) - (d/<= right result)))) + (and (r/<= left result) + (r/<= right result)))) (test "OR is the maximum." (let [result (&.~or left right)] - (and (d/>= left result) - (d/>= right result)))) + (and (r/>= left result) + (r/>= right result)))) (test "Double negation results in the original value." - (d/= left (&.~not (&.~not left)))) + (r/= left (&.~not (&.~not left)))) (test "Every value is equivalent to itself." - (and (d/>= left + (and (r/>= left (&.~= left left)) - (d/>= right + (r/>= right (&.~= right right)))) )))) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 6530fcb4a..c5c70c5a0 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -33,24 +33,24 @@ triangle ( x y z)]] ($_ seq (test "The middle value will always have maximum membership." - (d/= ~true (&.membership middle triangle))) + (r/= ~true (&.membership middle triangle))) (test "Boundary values will always have 0 membership." - (and (d/= ~false (&.membership bottom triangle)) - (d/= ~false (&.membership top triangle)))) + (and (r/= ~false (&.membership bottom triangle)) + (r/= ~false (&.membership top triangle)))) (test "Values within range, will have membership > 0." - (B/= (d/> ~false (&.membership sample triangle)) + (B/= (r/> ~false (&.membership sample triangle)) (and ( bottom sample) ( top sample)))) (test "Values outside of range, will have membership = 0." - (B/= (d/= ~false (&.membership sample triangle)) + (B/= (r/= ~false (&.membership sample triangle)) (or ( bottom sample) ( top sample)))) ))))] - ["Deg" number.Hash r.deg &.triangle d/< d/<= d/> d/>=] + ["Rev" number.Hash r.rev &.triangle r/< r/<= r/> r/>=] ) (do-template [ ] @@ -74,38 +74,38 @@ trapezoid ( w x y z)]] ($_ seq (test "The middle values will always have maximum membership." - (and (d/= ~true (&.membership middle-bottom trapezoid)) - (d/= ~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 (d/= ~false (&.membership bottom trapezoid)) - (d/= ~false (&.membership top trapezoid)))) + (and (r/= ~false (&.membership bottom trapezoid)) + (r/= ~false (&.membership top trapezoid)))) (test "Values within inner range will have membership = 1" - (B/= (d/= ~true (&.membership sample trapezoid)) + (B/= (r/= ~true (&.membership sample trapezoid)) (and ( middle-bottom sample) ( middle-top sample)))) (test "Values within range, will have membership > 0." - (B/= (d/> ~false (&.membership sample trapezoid)) + (B/= (r/> ~false (&.membership sample trapezoid)) (and ( bottom sample) ( top sample)))) (test "Values outside of range, will have membership = 0." - (B/= (d/= ~false (&.membership sample trapezoid)) + (B/= (r/= ~false (&.membership sample trapezoid)) (or ( bottom sample) ( top sample)))) ))))] - ["Deg" number.Hash r.deg &.trapezoid d/< d/<= d/> d/>=] + ["Rev" number.Hash r.rev &.trapezoid r/< r/<= r/> r/>=] ) (def: gen-triangle - (r.Random (&.Fuzzy Deg)) + (r.Random (&.Fuzzy Rev)) (do r.Monad - [x r.deg - y r.deg - z r.deg] + [x r.rev + y r.rev + z r.rev] (wrap (&.triangle x y z)))) (context: "Combinators" @@ -113,32 +113,32 @@ (do @ [left gen-triangle right gen-triangle - sample r.deg] + sample r.rev] ($_ seq (test "Union membership as as high as membership in any of its members." (let [combined (&.union left right) combined-membership (&.membership sample combined)] - (and (d/>= (&.membership sample left) + (and (r/>= (&.membership sample left) combined-membership) - (d/>= (&.membership sample right) + (r/>= (&.membership sample right) combined-membership)))) (test "Intersection membership as as low as membership in any of its members." (let [combined (&.intersection left right) combined-membership (&.membership sample combined)] - (and (d/<= (&.membership sample left) + (and (r/<= (&.membership sample left) combined-membership) - (d/<= (&.membership sample right) + (r/<= (&.membership sample right) combined-membership)))) (test "Complement membership is the opposite of normal membership." - (d/= (&.membership sample left) + (r/= (&.membership sample left) (~not (&.membership sample (&.complement left))))) (test "Membership in the difference will never be higher than in the set being subtracted." - (B/= (d/> (&.membership sample right) + (B/= (r/> (&.membership sample right) (&.membership sample left)) - (d/< (&.membership sample left) + (r/< (&.membership sample left) (&.membership sample (&.difference left right))))) )))) @@ -150,12 +150,12 @@ ($_ seq (test "Values that satisfy a predicate have membership = 1. Values that don't have membership = 0." - (B/= (d/= ~true (&.membership sample (&.from-predicate n/even?))) + (B/= (r/= ~true (&.membership sample (&.from-predicate n/even?))) (n/even? sample))) (test "Values that belong to a set have membership = 1. Values that don't have membership = 0." - (B/= (d/= ~true (&.membership sample (&.from-set set-10))) + (B/= (r/= ~true (&.membership sample (&.from-set set-10))) (set.member? set-10 sample))) )))) @@ -163,16 +163,16 @@ (<| (times +100) (do @ [fuzzy gen-triangle - sample r.deg - threshold r.deg + sample r.rev + threshold r.rev #let [vip-fuzzy (&.cut threshold fuzzy) member? (&.to-predicate threshold fuzzy)]] ($_ seq (test "Can increase the threshold of membership of a fuzzy set." - (B/= (d/> ~false (&.membership sample vip-fuzzy)) - (d/> threshold (&.membership sample fuzzy)))) + (B/= (r/> ~false (&.membership sample vip-fuzzy)) + (r/> threshold (&.membership sample fuzzy)))) (test "Can turn fuzzy sets into predicates through a threshold." (B/= (member? sample) - (d/> threshold (&.membership sample fuzzy)))) + (r/> threshold (&.membership sample fuzzy)))) )))) -- cgit v1.2.3