From 1d7a328afcb649fa0a69f6df4bd7b1ca6aa8a59c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 Mar 2017 17:38:39 -0400 Subject: - Moved lux/random to lux/math/random. - Moved lux/math/ratio to lux/number/ratio. - Moved lux/math/complex to lux/number/complex. --- stdlib/test/test/lux.lux | 2 +- stdlib/test/test/lux/cli.lux | 2 +- stdlib/test/test/lux/codata/coll/stream.lux | 2 +- stdlib/test/test/lux/codata/cont.lux | 2 +- stdlib/test/test/lux/codata/thunk.lux | 2 +- stdlib/test/test/lux/concurrency/atom.lux | 2 +- stdlib/test/test/lux/concurrency/promise.lux | 2 +- stdlib/test/test/lux/concurrency/stm.lux | 2 +- stdlib/test/test/lux/data/bit.lux | 2 +- stdlib/test/test/lux/data/bool.lux | 2 +- stdlib/test/test/lux/data/char.lux | 2 +- stdlib/test/test/lux/data/coll/array.lux | 2 +- stdlib/test/test/lux/data/coll/dict.lux | 2 +- stdlib/test/test/lux/data/coll/list.lux | 2 +- stdlib/test/test/lux/data/coll/queue.lux | 2 +- stdlib/test/test/lux/data/coll/set.lux | 2 +- stdlib/test/test/lux/data/coll/stack.lux | 2 +- stdlib/test/test/lux/data/coll/tree/rose.lux | 2 +- stdlib/test/test/lux/data/coll/tree/zipper.lux | 2 +- stdlib/test/test/lux/data/coll/vector.lux | 2 +- stdlib/test/test/lux/data/error/exception.lux | 2 +- stdlib/test/test/lux/data/format/json.lux | 2 +- stdlib/test/test/lux/data/ident.lux | 2 +- stdlib/test/test/lux/data/number.lux | 2 +- stdlib/test/test/lux/data/number/complex.lux | 200 +++++++++++++++++++++++ stdlib/test/test/lux/data/number/ratio.lux | 107 ++++++++++++ stdlib/test/test/lux/data/text.lux | 2 +- stdlib/test/test/lux/effect.lux | 2 +- stdlib/test/test/lux/host.js.lux | 2 +- stdlib/test/test/lux/host.jvm.lux | 2 +- stdlib/test/test/lux/lexer.lux | 2 +- stdlib/test/test/lux/lexer/regex.lux | 2 +- stdlib/test/test/lux/macro/ast.lux | 2 +- stdlib/test/test/lux/macro/poly/eq.lux | 2 +- stdlib/test/test/lux/macro/poly/functor.lux | 2 +- stdlib/test/test/lux/macro/poly/text-encoder.lux | 2 +- stdlib/test/test/lux/macro/syntax.lux | 2 +- stdlib/test/test/lux/math.lux | 2 +- stdlib/test/test/lux/math/complex.lux | 200 ----------------------- stdlib/test/test/lux/math/logic/continuous.lux | 2 +- stdlib/test/test/lux/math/logic/fuzzy.lux | 3 +- stdlib/test/test/lux/math/ratio.lux | 107 ------------ stdlib/test/test/lux/math/simple.lux | 2 +- stdlib/test/test/lux/pipe.lux | 2 +- stdlib/test/test/lux/type.lux | 2 +- stdlib/test/test/lux/type/auto.lux | 2 +- stdlib/test/test/lux/type/check.lux | 2 +- stdlib/test/tests.lux | 6 +- 48 files changed, 353 insertions(+), 354 deletions(-) create mode 100644 stdlib/test/test/lux/data/number/complex.lux create mode 100644 stdlib/test/test/lux/data/number/ratio.lux delete mode 100644 stdlib/test/test/lux/math/complex.lux delete mode 100644 stdlib/test/test/lux/math/ratio.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 92ed5e2ca..225467526 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -4,7 +4,7 @@ (lux (control monad) [io] [math] - ["R" random] + ["R" math/random] (data [text "T/" Eq] text/format) [compiler] diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index 39cb8e74a..e8dbf1f82 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -10,7 +10,7 @@ (coll [list])) (codata function) ["&" cli] - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/codata/coll/stream.lux b/stdlib/test/test/lux/codata/coll/stream.lux index 36f7227a9..4c69f9f7b 100644 --- a/stdlib/test/test/lux/codata/coll/stream.lux +++ b/stdlib/test/test/lux/codata/coll/stream.lux @@ -10,7 +10,7 @@ (codata function [cont] (coll ["&" stream])) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/codata/cont.lux b/stdlib/test/test/lux/codata/cont.lux index 2562da8f8..cef7661b0 100644 --- a/stdlib/test/test/lux/codata/cont.lux +++ b/stdlib/test/test/lux/codata/cont.lux @@ -8,7 +8,7 @@ [product]) (codata function ["&" cont]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/codata/thunk.lux b/stdlib/test/test/lux/codata/thunk.lux index 789805319..eb6a24701 100644 --- a/stdlib/test/test/lux/codata/thunk.lux +++ b/stdlib/test/test/lux/codata/thunk.lux @@ -4,7 +4,7 @@ (control monad) (codata ["&" thunk]) pipe - ["R" random]) + ["R" math/random]) lux/test) (test: "Thunks" diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux index f59b9ce6d..9b6248ec8 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/concurrency/atom.lux @@ -6,7 +6,7 @@ (coll [list "" Functor]) text/format) (concurrency ["&" atom]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index c5ba46d7d..d75d6d676 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -7,7 +7,7 @@ [error #- fail]) (concurrency ["&" promise]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index 10c6a5242..f9e46b91d 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -8,7 +8,7 @@ (concurrency ["&" stm] [promise]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index 72973a5e7..0c9f5ac3d 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -4,7 +4,7 @@ (control [monad]) (data ["&" bit] number) - ["R" random]) + ["R" math/random]) lux/test) (def: width Nat +64) diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux index d9052db57..51e499779 100644 --- a/stdlib/test/test/lux/data/bool.lux +++ b/stdlib/test/test/lux/data/bool.lux @@ -3,7 +3,7 @@ (lux (control [monad]) [io] (data bool) - ["R" random]) + ["R" math/random]) lux/test) (test: "Boolean operations." diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux index 88a5d86ae..6b7175de7 100644 --- a/stdlib/test/test/lux/data/char.lux +++ b/stdlib/test/test/lux/data/char.lux @@ -5,7 +5,7 @@ (data char [text] text/format) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index e05afd1c3..b5003f703 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -5,7 +5,7 @@ (data (coll ["&" array] [list]) [number]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index 4378d4dab..ff36cc362 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -10,7 +10,7 @@ (coll ["&" dict] [list "List/" Fold Functor])) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 823266319..e1705291a 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -7,7 +7,7 @@ [number] [bool] [product]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/queue.lux b/stdlib/test/test/lux/data/coll/queue.lux index 70444516c..fac5cef12 100644 --- a/stdlib/test/test/lux/data/coll/queue.lux +++ b/stdlib/test/test/lux/data/coll/queue.lux @@ -4,7 +4,7 @@ (control monad) (data (coll ["&" queue]) [number]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/set.lux b/stdlib/test/test/lux/data/coll/set.lux index 42c3959b8..2a4f05bb1 100644 --- a/stdlib/test/test/lux/data/coll/set.lux +++ b/stdlib/test/test/lux/data/coll/set.lux @@ -5,7 +5,7 @@ (data (coll ["&" set] [list "" Fold]) [number]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/stack.lux b/stdlib/test/test/lux/data/coll/stack.lux index ec6fb2b50..4c44cbf06 100644 --- a/stdlib/test/test/lux/data/coll/stack.lux +++ b/stdlib/test/test/lux/data/coll/stack.lux @@ -5,7 +5,7 @@ (data (coll ["&" stack] [list "" Fold]) [number]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/tree/rose.lux b/stdlib/test/test/lux/data/coll/tree/rose.lux index 018164b8b..ef43fae44 100644 --- a/stdlib/test/test/lux/data/coll/tree/rose.lux +++ b/stdlib/test/test/lux/data/coll/tree/rose.lux @@ -5,7 +5,7 @@ (data (coll (tree ["&" rose]) [list "List/" Monad]) [number]) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index 5a8a3aee3..888701bbe 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -9,7 +9,7 @@ text/format [number]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index 9b3edf078..c82493df0 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -8,7 +8,7 @@ text/format [number]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux index b2c417f75..96108e448 100644 --- a/stdlib/test/test/lux/data/error/exception.lux +++ b/stdlib/test/test/lux/data/error/exception.lux @@ -8,7 +8,7 @@ text/format [number]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 7233e44e3..ad70d5c0e 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -20,7 +20,7 @@ (macro [ast] [syntax #+ syntax:] [poly #+ derived:]) - ["R" random] + ["R" math/random] pipe test) ) diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index a47a7ed0f..f88693003 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -5,7 +5,7 @@ (data ["&" ident] [text "Text/" Eq] text/format) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 6f296a628..8424c82a3 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -5,7 +5,7 @@ (data number [text "Text/" Monoid Eq] text/format) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux new file mode 100644 index 000000000..f5c89d5ee --- /dev/null +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -0,0 +1,200 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [bool "b/" Eq] + [number "r/" Number] + ["&" number/complex] + (coll [list "List/" Fold Functor]) + [product]) + (codata function) + [math] + ["R" math/random] + pipe) + lux/test) + +## Based on org.apache.commons.math4.complex.Complex +## https://github.com/apache/commons-math/blob/master/src/test/java/org/apache/commons/math4/complex/ComplexTest.java + +(def: margin-of-error Real 1.0e-10) + +(def: (within? margin standard value) + (-> Real &;Complex &;Complex Bool) + (let [real-dist (r/abs (r.- (get@ #&;real standard) + (get@ #&;real value))) + imgn-dist (r/abs (r.- (get@ #&;imaginary standard) + (get@ #&;imaginary value)))] + (and (r.< margin real-dist) + (r.< margin imgn-dist)))) + +(def: gen-dim + (R;Random Real) + (do R;Monad + [factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1)))) + measure (|> R;real (R;filter (r.> 0.0)))] + (wrap (r.* (|> factor nat-to-int int-to-real) + measure)))) + +(def: gen-complex + (R;Random &;Complex) + (do R;Monad + [real gen-dim + imaginary gen-dim] + (wrap (&;complex real imaginary)))) + +(test: "Construction" + [real gen-dim + imaginary gen-dim] + ($_ seq + (assert "Can build and tear apart complex numbers" + (let [r+i (&;complex real imaginary)] + (and (r.= real (get@ #&;real r+i)) + (r.= imaginary (get@ #&;imaginary r+i))))) + + (assert "If either the real part or the imaginary part is NaN, the composite is NaN." + (and (&;not-a-number? (&;complex number;not-a-number imaginary)) + (&;not-a-number? (&;complex real number;not-a-number)))) + )) + +(test: "Absolute value" + [real gen-dim + imaginary gen-dim] + ($_ seq + (assert "Absolute value of complex >= absolute value of any of the parts." + (let [r+i (&;complex real imaginary) + abs (get@ #&;real (&;c.abs r+i))] + (and (r.>= (r/abs real) abs) + (r.>= (r/abs imaginary) abs)))) + + (assert "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)))))) + + (assert "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." + (and (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) + )) + +(test: "Addidion, substraction, multiplication and division" + [x gen-complex + y gen-complex + factor gen-dim] + ($_ seq + (assert "Adding 2 complex numbers is the same as adding their parts." + (let [z (&;c.+ y x)] + (and (&;c.= z + (&;complex (r.+ (get@ #&;real y) + (get@ #&;real x)) + (r.+ (get@ #&;imaginary y) + (get@ #&;imaginary x))))))) + + (assert "Subtracting 2 complex numbers is the same as adding their parts." + (let [z (&;c.- y x)] + (and (&;c.= z + (&;complex (r.- (get@ #&;real y) + (get@ #&;real x)) + (r.- (get@ #&;imaginary y) + (get@ #&;imaginary x))))))) + + (assert "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)))) + + (assert "Division is the inverse of multiplication." + (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x))) + + (assert "Scalar division is the inverse of scalar multiplication." + (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x))) + + (assert "If you subtract the remainder, all divisions must be exact." + (let [rem (&;c.% y x) + quotient (|> x (&;c.- rem) (&;c./ y)) + floored (|> quotient + (update@ #&;real math;floor) + (update@ #&;imaginary math;floor)) + (^open "&/") &;Codec] + (within? 0.000000000001 + x + (|> quotient (&;c.* y) (&;c.+ rem))))) + )) + +(test: "Conjugate, reciprocal, signum, negation" + [x gen-complex] + ($_ seq + (assert "Conjugate has same real part as original, and opposite of imaginary part." + (let [cx (&;conjugate x)] + (and (r.= (get@ #&;real x) + (get@ #&;real cx)) + (r.= (r/negate (get@ #&;imaginary x)) + (get@ #&;imaginary cx))))) + + (assert "The reciprocal functions is its own inverse." + (|> x &;reciprocal &;reciprocal (within? margin-of-error x))) + + (assert "x*(x^-1) = 1" + (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one))) + + (assert "Absolute value of signum is always root2(2), 1 or 0." + (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))] + (or (r.= 0.0 signum-abs) + (r.= 1.0 signum-abs) + (r.= (math;root2 2.0) signum-abs)))) + + (assert "Negation is its own inverse." + (let [there (&;c.negate x) + back-again (&;c.negate there)] + (and (not (&;c.= there x)) + (&;c.= back-again x)))) + + (assert "Negation doesn't change the absolute value." + (r.= (get@ #&;real (&;c.abs x)) + (get@ #&;real (&;c.abs (&;c.negate x))))) + )) + +## ## Don't know how to test complex trigonometry properly. +## (test: "Trigonometry" +## [x gen-complex] +## ($_ seq +## (assert "Arc-sine is the inverse of sine." +## (|> x &;sin &;asin (within? margin-of-error x))) + +## (assert "Arc-cosine is the inverse of cosine." +## (|> x &;cos &;acos (within? margin-of-error x))) + +## (assert "Arc-tangent is the inverse of tangent." +## (|> x &;tan &;atan (within? margin-of-error x)))) +## ) + +(test: "Power 2 and exponential/logarithm" + [x gen-complex] + ($_ seq + (assert "Square root is inverse of power 2.0" + (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x))) + + (assert "Logarithm is inverse of exponentiation." + (|> x &;log &;exp (within? margin-of-error x))) + )) + +(test: "Complex roots" + [sample gen-complex + degree (|> R;nat (:: @ map (|>. (n.max +1) (n.% +5))))] + (assert "Can calculate the N roots for any complex number." + (|> sample + (&;nth-roots degree) + (List/map (&;pow' (|> degree nat-to-int int-to-real))) + (list;every? (within? margin-of-error sample))))) + +(test: "Codec" + [sample gen-complex + #let [(^open "c/") &;Codec]] + (assert "Can encode/decode complex numbers." + (|> sample c/encode c/decode + (case> (#;Right output) + (&;c.= sample output) + + _ + false)))) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux new file mode 100644 index 000000000..a082050f8 --- /dev/null +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -0,0 +1,107 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [bool "b/" Eq] + [number "r/" Number] + ["&" number/ratio "&/" Number] + (coll [list "List/" Fold Functor]) + [product]) + (codata function) + ["R" math/random] + pipe) + lux/test) + +(def: gen-part + (R;Random Nat) + (|> R;nat (:: R;Monad map (|>. (n.% +1000) (n.max +1))))) + +(def: gen-ratio + (R;Random &;Ratio) + (do R;Monad + [numerator gen-part + denominator (|> gen-part + (R;filter (|>. (n.= +0) not)) + (R;filter (. not (n.= numerator))))] + (wrap (&;ratio numerator denominator)))) + +(test: "Normalization" + [denom1 gen-part + denom2 gen-part + sample gen-ratio] + ($_ seq + (assert "All zeroes are the same." + (&;q.= (&;ratio +0 denom1) + (&;ratio +0 denom2))) + + (assert "All ratios are built normalized." + (|> sample &;normalize (&;q.= sample))) + )) + +(test: "Arithmetic" + [x gen-ratio + y gen-ratio + #let [min (&;q.min x y) + max (&;q.max x y)]] + ($_ seq + (assert "Addition and subtraction are opposites." + (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max)) + (|> max (&;q.+ min) (&;q.- min) (&;q.= max)))) + + (assert "Multiplication and division are opposites." + (and (|> max (&;q./ min) (&;q.* min) (&;q.= max)) + (|> max (&;q.* min) (&;q./ min) (&;q.= max)))) + + (assert "Modulus by a larger ratio doesn't change the value." + (|> min (&;q.% max) (&;q.= min))) + + (assert "Modulus by a smaller ratio results in a value smaller than the limit." + (|> max (&;q.% min) (&;q.< min))) + + (assert "Can get the remainder of a division." + (let [remainder (&;q.% min max) + multiple (&;q.- remainder max) + factor (&;q./ min multiple)] + (and (|> factor (get@ #&;denominator) (n.= +1)) + (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max))))) + )) + +(test: "Negation, absolute value and signum" + [sample gen-ratio] + ($_ seq + (assert "Negation is it's own inverse." + (let [there (&/negate sample) + back-again (&/negate there)] + (and (not (&;q.= there sample)) + (&;q.= back-again sample)))) + + (assert "All ratios are already at their absolute value." + (|> sample &/abs (&;q.= sample))) + + (assert "Signum is the identity." + (|> sample (&;q.* (&/signum sample)) (&;q.= sample))) + )) + +(test: "Order" + [x gen-ratio + y gen-ratio] + ($_ seq + (assert "Can compare ratios." + (and (or (&;q.<= y x) + (&;q.> y x)) + (or (&;q.>= y x) + (&;q.< y x)))) + )) + +(test: "Codec" + [sample gen-ratio + #let [(^open "&/") &;Codec]] + (assert "Can encode/decode ratios." + (|> sample &/encode &/decode + (case> (#;Right output) + (&;q.= sample output) + + _ + false)))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index 883ff0b2b..72e633847 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -8,7 +8,7 @@ [number] (coll [list])) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/effect.lux b/stdlib/test/test/lux/effect.lux index 62c46ecb1..38ca21ce1 100644 --- a/stdlib/test/test/lux/effect.lux +++ b/stdlib/test/test/lux/effect.lux @@ -6,7 +6,7 @@ (data [text] text/format) [macro] - ["R" random] + ["R" math/random] pipe effect) lux/test) diff --git a/stdlib/test/test/lux/host.js.lux b/stdlib/test/test/lux/host.js.lux index 4c2b55485..7d79b2b87 100644 --- a/stdlib/test/test/lux/host.js.lux +++ b/stdlib/test/test/lux/host.js.lux @@ -4,7 +4,7 @@ (control monad) (data text/format) ["&" host] - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 54e6cf4b9..ff875ec2a 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -8,7 +8,7 @@ [text "Text/" Eq]) (codata function) ["&" host #+ jvm-import class: interface: object] - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux index 5ce15a25b..0bfd8dec7 100644 --- a/stdlib/test/test/lux/lexer.lux +++ b/stdlib/test/test/lux/lexer.lux @@ -7,7 +7,7 @@ text/format [char "C/" Eq] (coll [list])) - ["R" random] + ["R" math/random] pipe ["&" lexer]) lux/test) diff --git a/stdlib/test/test/lux/lexer/regex.lux b/stdlib/test/test/lux/lexer/regex.lux index 5b1cce0dd..c5c21df2a 100644 --- a/stdlib/test/test/lux/lexer/regex.lux +++ b/stdlib/test/test/lux/lexer/regex.lux @@ -9,7 +9,7 @@ [compiler] (macro [ast] ["s" syntax #+ syntax:]) - ["R" random] + ["R" math/random] pipe [lexer] (lexer ["&" regex])) diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux index e8ff5e1ef..58efc1b83 100644 --- a/stdlib/test/test/lux/macro/ast.lux +++ b/stdlib/test/test/lux/macro/ast.lux @@ -6,7 +6,7 @@ (data [text "T/" Eq] text/format [number]) - ["R" random] + ["R" math/random] pipe (macro ["&" ast])) lux/test) diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index f3821f880..c2f9c0ac1 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -8,7 +8,7 @@ [number "i/" Number] [char] [text]) - ["R" random] + ["R" math/random] pipe [macro] (macro [poly #+ derived:] diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index 5f525d692..b98d75c7a 100644 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ b/stdlib/test/test/lux/macro/poly/functor.lux @@ -9,7 +9,7 @@ [number "i/" Number] [char] [text]) - ["R" random] + ["R" math/random] pipe [macro] (macro [poly #+ derived:] diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux index a79af3cff..ec312e62b 100644 --- a/stdlib/test/test/lux/macro/poly/text-encoder.lux +++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux @@ -8,7 +8,7 @@ [number "i/" Number] [char] [text]) - ["R" random] + ["R" math/random] pipe [macro] (macro [poly #+ derived:] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index fe5b48993..329e16a0f 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -11,7 +11,7 @@ [ident] [error #- fail]) (codata function) - ["R" random] + ["R" math/random] pipe [compiler] (macro [ast] diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 769a6f889..b1c9b100e 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -9,7 +9,7 @@ (coll [list "List/" Fold Functor]) [product]) (codata function) - ["R" random] + ["R" math/random] pipe ["&" math]) lux/test) diff --git a/stdlib/test/test/lux/math/complex.lux b/stdlib/test/test/lux/math/complex.lux deleted file mode 100644 index f965f9214..000000000 --- a/stdlib/test/test/lux/math/complex.lux +++ /dev/null @@ -1,200 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [bool "b/" Eq] - [number "r/" Number] - (coll [list "List/" Fold Functor]) - [product]) - (codata function) - [math] - ["R" random] - pipe - ["&" math/complex]) - lux/test) - -## Based on org.apache.commons.math4.complex.Complex -## https://github.com/apache/commons-math/blob/master/src/test/java/org/apache/commons/math4/complex/ComplexTest.java - -(def: margin-of-error Real 1.0e-10) - -(def: (within? margin standard value) - (-> Real &;Complex &;Complex Bool) - (let [real-dist (r/abs (r.- (get@ #&;real standard) - (get@ #&;real value))) - imgn-dist (r/abs (r.- (get@ #&;imaginary standard) - (get@ #&;imaginary value)))] - (and (r.< margin real-dist) - (r.< margin imgn-dist)))) - -(def: gen-dim - (R;Random Real) - (do R;Monad - [factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1)))) - measure (|> R;real (R;filter (r.> 0.0)))] - (wrap (r.* (|> factor nat-to-int int-to-real) - measure)))) - -(def: gen-complex - (R;Random &;Complex) - (do R;Monad - [real gen-dim - imaginary gen-dim] - (wrap (&;complex real imaginary)))) - -(test: "Construction" - [real gen-dim - imaginary gen-dim] - ($_ seq - (assert "Can build and tear apart complex numbers" - (let [r+i (&;complex real imaginary)] - (and (r.= real (get@ #&;real r+i)) - (r.= imaginary (get@ #&;imaginary r+i))))) - - (assert "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (&;not-a-number? (&;complex number;not-a-number imaginary)) - (&;not-a-number? (&;complex real number;not-a-number)))) - )) - -(test: "Absolute value" - [real gen-dim - imaginary gen-dim] - ($_ seq - (assert "Absolute value of complex >= absolute value of any of the parts." - (let [r+i (&;complex real imaginary) - abs (get@ #&;real (&;c.abs r+i))] - (and (r.>= (r/abs real) abs) - (r.>= (r/abs imaginary) abs)))) - - (assert "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)))))) - - (assert "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) - )) - -(test: "Addidion, substraction, multiplication and division" - [x gen-complex - y gen-complex - factor gen-dim] - ($_ seq - (assert "Adding 2 complex numbers is the same as adding their parts." - (let [z (&;c.+ y x)] - (and (&;c.= z - (&;complex (r.+ (get@ #&;real y) - (get@ #&;real x)) - (r.+ (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) - - (assert "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&;c.- y x)] - (and (&;c.= z - (&;complex (r.- (get@ #&;real y) - (get@ #&;real x)) - (r.- (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) - - (assert "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)))) - - (assert "Division is the inverse of multiplication." - (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x))) - - (assert "Scalar division is the inverse of scalar multiplication." - (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x))) - - (assert "If you subtract the remainder, all divisions must be exact." - (let [rem (&;c.% y x) - quotient (|> x (&;c.- rem) (&;c./ y)) - floored (|> quotient - (update@ #&;real math;floor) - (update@ #&;imaginary math;floor)) - (^open "&/") &;Codec] - (within? 0.000000000001 - x - (|> quotient (&;c.* y) (&;c.+ rem))))) - )) - -(test: "Conjugate, reciprocal, signum, negation" - [x gen-complex] - ($_ seq - (assert "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (&;conjugate x)] - (and (r.= (get@ #&;real x) - (get@ #&;real cx)) - (r.= (r/negate (get@ #&;imaginary x)) - (get@ #&;imaginary cx))))) - - (assert "The reciprocal functions is its own inverse." - (|> x &;reciprocal &;reciprocal (within? margin-of-error x))) - - (assert "x*(x^-1) = 1" - (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one))) - - (assert "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))] - (or (r.= 0.0 signum-abs) - (r.= 1.0 signum-abs) - (r.= (math;root2 2.0) signum-abs)))) - - (assert "Negation is its own inverse." - (let [there (&;c.negate x) - back-again (&;c.negate there)] - (and (not (&;c.= there x)) - (&;c.= back-again x)))) - - (assert "Negation doesn't change the absolute value." - (r.= (get@ #&;real (&;c.abs x)) - (get@ #&;real (&;c.abs (&;c.negate x))))) - )) - -## ## Don't know how to test complex trigonometry properly. -## (test: "Trigonometry" -## [x gen-complex] -## ($_ seq -## (assert "Arc-sine is the inverse of sine." -## (|> x &;sin &;asin (within? margin-of-error x))) - -## (assert "Arc-cosine is the inverse of cosine." -## (|> x &;cos &;acos (within? margin-of-error x))) - -## (assert "Arc-tangent is the inverse of tangent." -## (|> x &;tan &;atan (within? margin-of-error x)))) -## ) - -(test: "Power 2 and exponential/logarithm" - [x gen-complex] - ($_ seq - (assert "Square root is inverse of power 2.0" - (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x))) - - (assert "Logarithm is inverse of exponentiation." - (|> x &;log &;exp (within? margin-of-error x))) - )) - -(test: "Complex roots" - [sample gen-complex - degree (|> R;nat (:: @ map (|>. (n.max +1) (n.% +5))))] - (assert "Can calculate the N roots for any complex number." - (|> sample - (&;nth-roots degree) - (List/map (&;pow' (|> degree nat-to-int int-to-real))) - (list;every? (within? margin-of-error sample))))) - -(test: "Codec" - [sample gen-complex - #let [(^open "c/") &;Codec]] - (assert "Can encode/decode complex numbers." - (|> sample c/encode c/decode - (case> (#;Right output) - (&;c.= sample output) - - _ - false)))) diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux index 2c13e123e..ab907d6bd 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -3,7 +3,7 @@ (lux [io] (control monad) (codata function) - ["R" random] + ["R" math/random] pipe ["&" math/logic/continuous]) lux/test) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 5b25ecf44..45c54bb44 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -8,7 +8,7 @@ [bool "B/" Eq] [number] text/format) - ["R" random] + ["R" math/random] pipe (math/logic ["&" fuzzy] continuous)) @@ -94,7 +94,6 @@ ) (test: "Gaussian" - #seed +1485654865687 [deviation R;real center R;real #let [gaussian (&;gaussian deviation center)]] diff --git a/stdlib/test/test/lux/math/ratio.lux b/stdlib/test/test/lux/math/ratio.lux deleted file mode 100644 index 8af9127a1..000000000 --- a/stdlib/test/test/lux/math/ratio.lux +++ /dev/null @@ -1,107 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [bool "b/" Eq] - [number "r/" Number] - (coll [list "List/" Fold Functor]) - [product]) - (codata function) - ["R" random] - pipe - ["&" math/ratio "&/" Number]) - lux/test) - -(def: gen-part - (R;Random Nat) - (|> R;nat (:: R;Monad map (|>. (n.% +1000) (n.max +1))))) - -(def: gen-ratio - (R;Random &;Ratio) - (do R;Monad - [numerator gen-part - denominator (|> gen-part - (R;filter (|>. (n.= +0) not)) - (R;filter (. not (n.= numerator))))] - (wrap (&;ratio numerator denominator)))) - -(test: "Normalization" - [denom1 gen-part - denom2 gen-part - sample gen-ratio] - ($_ seq - (assert "All zeroes are the same." - (&;q.= (&;ratio +0 denom1) - (&;ratio +0 denom2))) - - (assert "All ratios are built normalized." - (|> sample &;normalize (&;q.= sample))) - )) - -(test: "Arithmetic" - [x gen-ratio - y gen-ratio - #let [min (&;q.min x y) - max (&;q.max x y)]] - ($_ seq - (assert "Addition and subtraction are opposites." - (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max)) - (|> max (&;q.+ min) (&;q.- min) (&;q.= max)))) - - (assert "Multiplication and division are opposites." - (and (|> max (&;q./ min) (&;q.* min) (&;q.= max)) - (|> max (&;q.* min) (&;q./ min) (&;q.= max)))) - - (assert "Modulus by a larger ratio doesn't change the value." - (|> min (&;q.% max) (&;q.= min))) - - (assert "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&;q.% min) (&;q.< min))) - - (assert "Can get the remainder of a division." - (let [remainder (&;q.% min max) - multiple (&;q.- remainder max) - factor (&;q./ min multiple)] - (and (|> factor (get@ #&;denominator) (n.= +1)) - (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max))))) - )) - -(test: "Negation, absolute value and signum" - [sample gen-ratio] - ($_ seq - (assert "Negation is it's own inverse." - (let [there (&/negate sample) - back-again (&/negate there)] - (and (not (&;q.= there sample)) - (&;q.= back-again sample)))) - - (assert "All ratios are already at their absolute value." - (|> sample &/abs (&;q.= sample))) - - (assert "Signum is the identity." - (|> sample (&;q.* (&/signum sample)) (&;q.= sample))) - )) - -(test: "Order" - [x gen-ratio - y gen-ratio] - ($_ seq - (assert "Can compare ratios." - (and (or (&;q.<= y x) - (&;q.> y x)) - (or (&;q.>= y x) - (&;q.< y x)))) - )) - -(test: "Codec" - [sample gen-ratio - #let [(^open "&/") &;Codec]] - (assert "Can encode/decode ratios." - (|> sample &/encode &/decode - (case> (#;Right output) - (&;q.= sample output) - - _ - false)))) diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux index ddd914bdf..7a70ec1a6 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -9,7 +9,7 @@ (coll [list "List/" Fold Functor]) [product]) (codata function) - ["R" random] + ["R" math/random] pipe ["&" math/simple]) lux/test) diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux index cf53335d3..383043ebb 100644 --- a/stdlib/test/test/lux/pipe.lux +++ b/stdlib/test/test/lux/pipe.lux @@ -8,7 +8,7 @@ identity [text "T/" Eq]) (codata function) - ["R" random] + ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index 6d1f677c7..e9401c738 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -7,7 +7,7 @@ [number] maybe (coll [list])) - ["R" random] + ["R" math/random] pipe ["&" type]) lux/test) diff --git a/stdlib/test/test/lux/type/auto.lux b/stdlib/test/test/lux/type/auto.lux index dc28b8797..536e3b851 100644 --- a/stdlib/test/test/lux/type/auto.lux +++ b/stdlib/test/test/lux/type/auto.lux @@ -10,7 +10,7 @@ [bool "B/" Eq] maybe (coll [list])) - ["R" random] + ["R" math/random] pipe [type] type/auto) diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index 1e8f4c648..47904c41b 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -7,7 +7,7 @@ [number] maybe (coll [list])) - ["R" random] + ["R" math/random] pipe [type] ["&" type/check]) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index e3d0e15c3..ce01da97e 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -32,6 +32,8 @@ [log] [maybe] [number] + (number ["_;" ratio] + ["_;" complex]) [product] [sum] [text] @@ -49,9 +51,7 @@ (text [format]) ) ["_;" math] - (math ["_;" ratio] - ["_;" complex] - ## ["_;" random] + (math ## ["_;" random] ["_;" simple] (logic ["_;" continuous] ["_;" fuzzy])) -- cgit v1.2.3