From 9465270e1f800199ef98f878b6f457331bf7dcab Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Apr 2019 19:09:56 -0400 Subject: Re-named "lux/data/collection/tree/rose" to "lux/data/collection/tree". --- stdlib/source/test/lux/data/collection.lux | 9 +- stdlib/source/test/lux/data/collection/tree.lux | 63 +++++++++++ .../source/test/lux/data/collection/tree/rose.lux | 63 ----------- .../test/lux/data/collection/tree/rose/zipper.lux | 116 --------------------- .../test/lux/data/collection/tree/zipper.lux | 115 ++++++++++++++++++++ 5 files changed, 182 insertions(+), 184 deletions(-) create mode 100644 stdlib/source/test/lux/data/collection/tree.lux delete mode 100644 stdlib/source/test/lux/data/collection/tree/rose.lux delete mode 100644 stdlib/source/test/lux/data/collection/tree/rose/zipper.lux create mode 100644 stdlib/source/test/lux/data/collection/tree/zipper.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index ad86d3225..0d6cb1e64 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -14,9 +14,8 @@ ["#/." priority]] ["#." set ["#/." ordered]] - ["#." tree #_ - ["#/." rose - ["#/." zipper]]]]) + ["#." tree + ["#/." zipper]]]) (def: dictionary Test @@ -42,8 +41,8 @@ (def: tree Test ($_ _.and - /tree/rose.test - /tree/rose/zipper.test + /tree.test + /tree/zipper.test )) (def: #export test diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux new file mode 100644 index 000000000..65b46e382 --- /dev/null +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -0,0 +1,63 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." fold] + ["$." functor]]}] + [data + [number + ["." nat]] + [collection + ["." list ("#@." functor fold)]]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Tree)]}) + +(def: #export (tree size gen-value) + (All [a] (-> Nat (Random a) (Random (Tree a)))) + (let [singleton (:: r.monad map /.leaf gen-value)] + (case size + 0 + singleton + + 1 + singleton + + 2 + (do r.monad + [value gen-value + single (tree 1 gen-value)] + (wrap (/.branch value (list single)))) + + _ + (do r.monad + [value gen-value + #let [size (dec size)] + left (tree (n// 2 size) gen-value) + right (tree (n/+ (n/% 2 size) (n// 2 size)) + gen-value)] + (wrap (/.branch value (list left right)))) + ))) + +(def: #export test + Test + (<| (_.context (%name (name-of /.Tree))) + (do r.monad + [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)] + ($_ _.and + ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat)) + ($fold.spec /.leaf /.equivalence /.fold) + ($functor.spec /.leaf /.equivalence /.functor) + + (do @ + [sample (..tree size r.nat)] + (_.test "Can flatten a tree to get all the nodes as a flat tree." + (n/= size + (list.size (/.flatten sample))))) + )))) diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux deleted file mode 100644 index 65b46e382..000000000 --- a/stdlib/source/test/lux/data/collection/tree/rose.lux +++ /dev/null @@ -1,63 +0,0 @@ -(.module: - [lux #* - data/text/format - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - {[0 #test] - [/ - ["$." equivalence] - ["$." fold] - ["$." functor]]}] - [data - [number - ["." nat]] - [collection - ["." list ("#@." functor fold)]]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Tree)]}) - -(def: #export (tree size gen-value) - (All [a] (-> Nat (Random a) (Random (Tree a)))) - (let [singleton (:: r.monad map /.leaf gen-value)] - (case size - 0 - singleton - - 1 - singleton - - 2 - (do r.monad - [value gen-value - single (tree 1 gen-value)] - (wrap (/.branch value (list single)))) - - _ - (do r.monad - [value gen-value - #let [size (dec size)] - left (tree (n// 2 size) gen-value) - right (tree (n/+ (n/% 2 size) (n// 2 size)) - gen-value)] - (wrap (/.branch value (list left right)))) - ))) - -(def: #export test - Test - (<| (_.context (%name (name-of /.Tree))) - (do r.monad - [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)] - ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat)) - ($fold.spec /.leaf /.equivalence /.fold) - ($functor.spec /.leaf /.equivalence /.functor) - - (do @ - [sample (..tree size r.nat)] - (_.test "Can flatten a tree to get all the nodes as a flat tree." - (n/= size - (list.size (/.flatten sample))))) - )))) diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux deleted file mode 100644 index e8f59a43a..000000000 --- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux +++ /dev/null @@ -1,116 +0,0 @@ -(.module: - [lux #* - data/text/format - ["_" test (#+ Test)] - [abstract/monad (#+ do Monad)] - [control - pipe] - [data - ["." maybe] - ["." text] - [number - ["." nat]] - [collection - ["." list] - [tree - ["." rose]]]] - [math - ["r" random]]] - ["." //] - {1 - ["." / (#+ Zipper)]} - ) - -(def: #export test - Test - (<| (_.context (%name (name-of /.Zipper))) - (do r.monad - [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat) - sample (//.tree size r.nat) - mid-val r.nat - new-val r.nat - pre-val r.nat - post-val r.nat - #let [(^open "tree@.") (rose.equivalence nat.equivalence) - (^open "list@.") (list.equivalence nat.equivalence)]] - ($_ _.and - (_.test "Trees can be converted to/from zippers." - (|> sample - /.zip /.unzip - (tree@= sample))) - (_.test "Creating a zipper gives you a start node." - (|> sample /.zip /.start?)) - (_.test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (/.zip sample)] - (if (/.branch? zipper) - (let [child (|> zipper /.down)] - (and (not (tree@= sample (/.unzip child))) - (|> child /.up (is? zipper) not) - (|> child /.start (is? zipper) not))) - (and (/.leaf? zipper) - (|> zipper (/.prepend-child new-val) /.branch?))))) - (do @ - [branch-value r.nat - #let [zipper (|> (/.zip (rose.branch branch-value (list (rose.leaf mid-val)))) - (/.prepend-child pre-val) - (/.append-child post-val))]] - (_.test "Can prepend and append children." - (and (and (|> zipper /.down /.value (is? pre-val)) - (|> zipper /.down /.right /.left /.value (is? pre-val)) - (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))) - (|> zipper /.down /.right /.value (is? mid-val)) - (and (|> zipper /.down /.right /.right /.value (is? post-val)) - (|> zipper /.down /.rightmost /.value (is? post-val)))))) - (do @ - [branch-value r.nat - #let [zipper (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))]] - (_.test "Can insert children around a node (unless it's start)." - (and (let [zipper (|> zipper - /.down - (/.insert-left pre-val) - maybe.assume - (/.insert-right post-val) - maybe.assume - /.up)] - (and (|> zipper /.down /.value (is? pre-val)) - (|> zipper /.down /.right /.value (is? mid-val)) - (|> zipper /.down /.right /.right /.value (is? post-val)) - (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)) - (|> zipper /.down /.right /.left /.value (is? pre-val)) - (|> zipper /.down /.rightmost /.value (is? post-val)))) - (and (|> zipper - (/.insert-left pre-val) - (case> (#.Some _) false - #.None true)) - (|> zipper - (/.insert-right post-val) - (case> (#.Some _) false - #.None true)))))) - (_.test "Can set and update the value of a node." - (|> sample /.zip (/.set new-val) /.value (n/= new-val))) - (_.test "Zipper traversal follows the outline of the tree depth-first." - (let [root (/.zip sample)] - (list@= (rose.flatten sample) - (loop [zipper (/.start root)] - (let [zipper' (/.next zipper)] - (#.Cons (/.value zipper) - (if (:: (/.equivalence nat.equivalence) = root zipper') - (list) - (recur zipper')))))))) - (_.test "Backwards zipper traversal yield reverse tree flatten." - (let [root (/.zip sample)] - (list@= (list.reverse (rose.flatten sample)) - (loop [zipper (/.end root)] - (#.Cons (/.value zipper) - (if (:: (/.equivalence nat.equivalence) = root zipper) - (list) - (recur (/.prev zipper)))))))) - (_.test "Can remove nodes (except start nodes)." - (let [zipper (/.zip sample)] - (if (/.branch? zipper) - (and (|> zipper /.down /.start? not) - (|> zipper /.down /.remove (case> #.None false - (#.Some node) (/.start? node)))) - (|> zipper /.remove (case> #.None true - (#.Some _) false))))) - )))) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux new file mode 100644 index 000000000..f4b812420 --- /dev/null +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -0,0 +1,115 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [abstract/monad (#+ do Monad)] + [control + pipe] + [data + ["." maybe] + ["." text] + [number + ["." nat]] + [collection + ["." list]]] + [math + ["r" random]]] + ["." //] + {1 + ["." / (#+ Zipper) + ["tree" //]]} + ) + +(def: #export test + Test + (<| (_.context (%name (name-of /.Zipper))) + (do r.monad + [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat) + sample (//.tree size r.nat) + mid-val r.nat + new-val r.nat + pre-val r.nat + post-val r.nat + #let [(^open "tree@.") (tree.equivalence nat.equivalence) + (^open "list@.") (list.equivalence nat.equivalence)]] + ($_ _.and + (_.test "Trees can be converted to/from zippers." + (|> sample + /.zip /.unzip + (tree@= sample))) + (_.test "Creating a zipper gives you a start node." + (|> sample /.zip /.start?)) + (_.test "Can move down inside branches. Can move up from lower nodes." + (let [zipper (/.zip sample)] + (if (/.branch? zipper) + (let [child (|> zipper /.down)] + (and (not (tree@= sample (/.unzip child))) + (|> child /.up (is? zipper) not) + (|> child /.start (is? zipper) not))) + (and (/.leaf? zipper) + (|> zipper (/.prepend-child new-val) /.branch?))))) + (do @ + [branch-value r.nat + #let [zipper (|> (/.zip (tree.branch branch-value (list (tree.leaf mid-val)))) + (/.prepend-child pre-val) + (/.append-child post-val))]] + (_.test "Can prepend and append children." + (and (and (|> zipper /.down /.value (is? pre-val)) + (|> zipper /.down /.right /.left /.value (is? pre-val)) + (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))) + (|> zipper /.down /.right /.value (is? mid-val)) + (and (|> zipper /.down /.right /.right /.value (is? post-val)) + (|> zipper /.down /.rightmost /.value (is? post-val)))))) + (do @ + [branch-value r.nat + #let [zipper (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))]] + (_.test "Can insert children around a node (unless it's start)." + (and (let [zipper (|> zipper + /.down + (/.insert-left pre-val) + maybe.assume + (/.insert-right post-val) + maybe.assume + /.up)] + (and (|> zipper /.down /.value (is? pre-val)) + (|> zipper /.down /.right /.value (is? mid-val)) + (|> zipper /.down /.right /.right /.value (is? post-val)) + (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)) + (|> zipper /.down /.right /.left /.value (is? pre-val)) + (|> zipper /.down /.rightmost /.value (is? post-val)))) + (and (|> zipper + (/.insert-left pre-val) + (case> (#.Some _) false + #.None true)) + (|> zipper + (/.insert-right post-val) + (case> (#.Some _) false + #.None true)))))) + (_.test "Can set and update the value of a node." + (|> sample /.zip (/.set new-val) /.value (n/= new-val))) + (_.test "Zipper traversal follows the outline of the tree depth-first." + (let [root (/.zip sample)] + (list@= (tree.flatten sample) + (loop [zipper (/.start root)] + (let [zipper' (/.next zipper)] + (#.Cons (/.value zipper) + (if (:: (/.equivalence nat.equivalence) = root zipper') + (list) + (recur zipper')))))))) + (_.test "Backwards zipper traversal yield reverse tree flatten." + (let [root (/.zip sample)] + (list@= (list.reverse (tree.flatten sample)) + (loop [zipper (/.end root)] + (#.Cons (/.value zipper) + (if (:: (/.equivalence nat.equivalence) = root zipper) + (list) + (recur (/.prev zipper)))))))) + (_.test "Can remove nodes (except start nodes)." + (let [zipper (/.zip sample)] + (if (/.branch? zipper) + (and (|> zipper /.down /.start? not) + (|> zipper /.down /.remove (case> #.None false + (#.Some node) (/.start? node)))) + (|> zipper /.remove (case> #.None true + (#.Some _) false))))) + )))) -- cgit v1.2.3