diff options
Diffstat (limited to 'stdlib/source/test/lux/control/interval.lux')
| -rw-r--r-- | stdlib/source/test/lux/control/interval.lux | 432 |
1 files changed, 215 insertions, 217 deletions
diff --git a/stdlib/source/test/lux/control/interval.lux b/stdlib/source/test/lux/control/interval.lux index 6d00a36e9..30d0dfa50 100644 --- a/stdlib/source/test/lux/control/interval.lux +++ b/stdlib/source/test/lux/control/interval.lux @@ -1,235 +1,233 @@ (.module: - lux/test [lux #* + ["_" test (#+ Test)] [control - ["M" monad (#+ do Monad)] - pipe - ["&" interval]] - [math - ["r" random]] + [pipe (#+ case>)] + [monad (#+ do)]] [data - ["." number] + [number + ["." nat]] [collection - ["S" set] - ["L" list]]]]) - -(context: "Equivalence." - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "Every interval is equal to itself." - (and (let [self (&.between number.enum bottom top)] - (&/= self self)) - (let [self (&.between number.enum top bottom)] - (&/= self self)) - (let [self (&.singleton number.enum bottom)] - (&/= self self)))))))) - -(context: "Boundaries" - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [interval (&.between number.enum bottom top)]] - ($_ seq - (test "Every boundary value belongs to it's interval." - (and (&.within? interval bottom) - (&.within? interval top))) - (test "Every interval starts with its bottom." - (&.starts-with? bottom interval)) - (test "Every interval ends with its top." - (&.ends-with? top interval)) - (test "The boundary values border the interval." - (and (&.borders? interval bottom) - (&.borders? interval top))) - )))) - -(def: (list-to-4tuple list) - (-> (List Int) [Int Int Int Int]) - (case list - (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined))) - + ["." set] + ["." list]]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Interval) ("_/." equivalence)]} + {0 + [test + [lux + [control + [".T" equivalence]]]]}) (do-template [<name> <cmp>] - [(def: <name> - (r.Random (&.Interval Int)) + [(def: #export <name> + (Random (Interval Nat)) (do r.monad - [bottom r.int - top (|> r.int (r.filter (|>> (i/= bottom) not)))] + [bottom r.nat + top (|> r.nat (r.filter (|>> (n/= bottom) not)))] (if (<cmp> top bottom) - (wrap (&.between number.enum bottom top)) - (wrap (&.between number.enum top bottom)))))] + (wrap (/.between nat.enum bottom top)) + (wrap (/.between nat.enum top bottom)))))] - [gen-inner i/<] - [gen-outer i/>] + [inner n/<] + [outer n/>] ) -(def: gen-singleton - (r.Random (&.Interval Int)) +(def: #export singleton + (Random (Interval Nat)) (do r.monad - [point r.int] - (wrap (&.singleton number.enum point)))) + [point r.nat] + (wrap (/.singleton nat.enum point)))) -(def: gen-interval - (r.Random (&.Interval Int)) +(def: #export interval + (Random (Interval Nat)) ($_ r.either - gen-inner - gen-outer - gen-singleton)) - -(context: "Unions" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The union of an interval to itself yields the same interval." - (&/= some-interval (&.union some-interval some-interval))) - (test "The union of 2 inner intervals is another inner interval." - (&.inner? (&.union left-inner right-inner))) - (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (&.overlaps? (&.complement left-outer) (&.complement right-outer)) - (&.outer? (&.union left-outer right-outer)) - (&.inner? (&.union left-outer right-outer)))) - )))) - -(context: "Intersections" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The intersection of an interval to itself yields the same interval." - (&/= some-interval (&.intersection some-interval some-interval))) - (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (&.overlaps? left-inner right-inner) - (&.inner? (&.intersection left-inner right-inner)) - (&.outer? (&.intersection left-inner right-inner)))) - (test "The intersection of 2 outer intervals is another outer interval." - (&.outer? (&.intersection left-outer right-outer))) - )))) - -(context: "Complement" - (<| (times 100) - (do @ - [some-interval gen-interval - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The complement of a complement is the same as the original." - (&/= some-interval (|> some-interval &.complement &.complement))) - (test "The complement of an interval does not overlap it." - (not (&.overlaps? some-interval (&.complement some-interval)))) - )))) - -(context: "Positioning/location" - (<| (times 100) - (do @ - [[l m r] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] + ..inner + ..outer + ..singleton)) - _ - (undefined))))) - #let [left (&.singleton number.enum l) - right (&.singleton number.enum r)]] - ($_ seq - (test "'precedes?' and 'succeeds?' are symetric." - (and (&.precedes? right left) - (&.succeeds? left right))) - (test "Can check if an interval is before or after some element." - (and (&.before? m left) - (&.after? m right))) - )))) - -(context: "Touching intervals" - (<| (times 100) - (do @ - [[b t1 t2] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] +(def: boundaries + Test + (do r.monad + [bottom r.nat + top r.nat + #let [interval (/.between nat.enum bottom top)]] + ($_ _.and + (_.test "A boundary value belongs to its interval." + (and (/.within? interval bottom) + (/.within? interval top))) + (_.test "An interval starts with its bottom." + (/.starts-with? bottom interval)) + (_.test "An interval ends with its top." + (/.ends-with? top interval)) + (_.test "The boundary values border the interval." + (and (/.borders? interval bottom) + (/.borders? interval top))) + ))) + +(def: union + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The union of an interval to itself yields the same interval." + (_/= some-interval (/.union some-interval some-interval))) + (_.test "The union of 2 inner intervals is another inner interval." + (/.inner? (/.union left-inner right-inner))) + (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." + (if (/.overlaps? (/.complement left-outer) (/.complement right-outer)) + (/.outer? (/.union left-outer right-outer)) + (/.inner? (/.union left-outer right-outer)))) + ))) + +(def: intersection + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The intersection of an interval to itself yields the same interval." + (_/= some-interval (/.intersection some-interval some-interval))) + (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." + (if (/.overlaps? left-inner right-inner) + (/.inner? (/.intersection left-inner right-inner)) + (/.outer? (/.intersection left-inner right-inner)))) + (_.test "The intersection of 2 outer intervals is another outer interval." + (/.outer? (/.intersection left-outer right-outer))) + ))) + +(def: complement + Test + (do r.monad + [some-interval ..interval] + ($_ _.and + (_.test "The complement of a complement is the same as the original." + (_/= some-interval (|> some-interval /.complement /.complement))) + (_.test "The complement of an interval does not overlap it." + (not (/.overlaps? some-interval (/.complement some-interval)))) + ))) + +(def: location + Test + (do r.monad + [[l m r] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [left (/.singleton nat.enum l) + right (/.singleton nat.enum r)]] + ($_ _.and + (_.test "'precedes?' and 'succeeds?' are symetric." + (and (/.precedes? right left) + (/.succeeds? left right))) + (_.test "Can check if an interval is before or after some element." + (and (/.before? m left) + (/.after? m right))) + ))) + +(def: touch + Test + (do r.monad + [[b t1 t2] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [int-left (/.between nat.enum t1 t2) + int-right (/.between nat.enum b t1)]] + ($_ _.and + (_.test "An interval meets another if its top is the other's bottom." + (/.meets? int-left int-right)) + (_.test "Two intervals touch one another if any one meets the other." + (/.touches? int-left int-right)) + (_.test "Can check if 2 intervals start together." + (/.starts? (/.between nat.enum b t2) + (/.between nat.enum b t1))) + (_.test "Can check if 2 intervals finish together." + (/.finishes? (/.between nat.enum b t2) + (/.between nat.enum t1 t2))) + ))) + +(def: overlap + Test + (do r.monad + [some-interval ..interval + [x0 x1 x2 x3] (|> (r.set nat.hash 4 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list x0 x1 x2 x3)) + [x0 x1 x2 x3] _ - (undefined))))) - #let [int-left (&.between number.enum t1 t2) - int-right (&.between number.enum b t1)]] - ($_ seq - (test "An interval meets another if it's top is the other's bottom." - (&.meets? int-left int-right)) - (test "Two intervals touch one another if any one meets the other." - (&.touches? int-left int-right)) - (test "Can check if 2 intervals start together." - (&.starts? (&.between number.enum b t2) - (&.between number.enum b t1))) - (test "Can check if 2 intervals finish together." - (&.finishes? (&.between number.enum b t2) - (&.between number.enum t1 t2))) - )))) - -(context: "Nesting & overlap" - (<| (times 100) - (do @ - [some-interval gen-interval - [x0 x1 x2 x3] (|> (r.set number.hash 4 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined)))))] - ($_ seq - (test "Every interval is nested into itself." - (&.nested? some-interval some-interval)) - (test "No interval overlaps with itself." - (not (&.overlaps? some-interval some-interval))) - (let [small-inner (&.between number.enum x1 x2) - large-inner (&.between number.enum x0 x3)] - (test "Inner intervals can be nested inside one another." - (and (&.nested? large-inner small-inner) - (not (&.nested? small-inner large-inner))))) - (let [left-inner (&.between number.enum x0 x2) - right-inner (&.between number.enum x1 x3)] - (test "Inner intervals can overlap one another." - (and (&.overlaps? left-inner right-inner) - (&.overlaps? right-inner left-inner)))) - (let [small-outer (&.between number.enum x2 x1) - large-outer (&.between number.enum x3 x0)] - (test "Outer intervals can be nested inside one another." - (and (&.nested? small-outer large-outer) - (not (&.nested? large-outer small-outer))))) - (let [left-inner (&.between number.enum x0 x1) - right-inner (&.between number.enum x2 x3) - outer (&.between number.enum x0 x3)] - (test "Inners can be nested inside outers." - (and (&.nested? outer left-inner) - (&.nested? outer right-inner)))) - (let [left-inner (&.between number.enum x0 x2) - right-inner (&.between number.enum x1 x3) - outer (&.between number.enum x1 x2)] - (test "Inners can overlap outers." - (and (&.overlaps? outer left-inner) - (&.overlaps? outer right-inner)))) - )))) + (undefined)))))] + ($_ _.and + (_.test "Every interval is nested into itself." + (/.nested? some-interval some-interval)) + (_.test "No interval overlaps with itself." + (not (/.overlaps? some-interval some-interval))) + (let [small-inner (/.between nat.enum x1 x2) + large-inner (/.between nat.enum x0 x3)] + (_.test "Inner intervals can be nested inside one another." + (and (/.nested? large-inner small-inner) + (not (/.nested? small-inner large-inner))))) + (let [left-inner (/.between nat.enum x0 x2) + right-inner (/.between nat.enum x1 x3)] + (_.test "Inner intervals can overlap one another." + (and (/.overlaps? left-inner right-inner) + (/.overlaps? right-inner left-inner)))) + (let [small-outer (/.between nat.enum x2 x1) + large-outer (/.between nat.enum x3 x0)] + (_.test "Outer intervals can be nested inside one another." + (and (/.nested? small-outer large-outer) + (not (/.nested? large-outer small-outer))))) + (let [left-inner (/.between nat.enum x0 x1) + right-inner (/.between nat.enum x2 x3) + outer (/.between nat.enum x0 x3)] + (_.test "Inners can be nested inside outers." + (and (/.nested? outer left-inner) + (/.nested? outer right-inner)))) + (let [left-inner (/.between nat.enum x0 x2) + right-inner (/.between nat.enum x1 x3) + outer (/.between nat.enum x1 x2)] + (_.test "Inners can overlap outers." + (and (/.overlaps? outer left-inner) + (/.overlaps? outer right-inner)))) + ))) + +(def: #export test + Test + ($_ _.and + (equivalenceT.test /.equivalence ..interval) + (<| (_.context "Boundaries.") + ..boundaries) + (<| (_.context "Union.") + ..union) + (<| (_.context "Intersection.") + ..intersection) + (<| (_.context "Complement.") + ..complement) + (<| (_.context "Positioning/location.") + ..location) + (<| (_.context "Touching intervals.") + ..touch) + (<| (_.context "Nesting & overlap.") + ..overlap))) |