From bdf674249b993b1135d59420033a92ba39278fea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 1 May 2018 22:02:27 -0400 Subject: - Re-organized priority-queue modules. --- stdlib/source/lux/data/coll/priority-queue.lux | 102 ---------------------- stdlib/source/lux/data/coll/queue/priority.lux | 102 ++++++++++++++++++++++ stdlib/test/test/lux/data/coll/priority-queue.lux | 52 ----------- stdlib/test/test/lux/data/coll/queue/priority.lux | 52 +++++++++++ stdlib/test/tests.lux | 12 +-- 5 files changed, 160 insertions(+), 160 deletions(-) delete mode 100644 stdlib/source/lux/data/coll/priority-queue.lux create mode 100644 stdlib/source/lux/data/coll/queue/priority.lux delete mode 100644 stdlib/test/test/lux/data/coll/priority-queue.lux create mode 100644 stdlib/test/test/lux/data/coll/queue/priority.lux diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux deleted file mode 100644 index 833d3b3e1..000000000 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ /dev/null @@ -1,102 +0,0 @@ -(.module: - lux - (lux (control [eq #+ Eq] - [monad #+ do Monad]) - (data (coll (tree ["F" finger])) - [number] - [maybe]))) - -(type: #export Priority Nat) - -(type: #export (Queue a) - (Maybe (F.Fingers Priority a))) - -(def: max-priority Priority ("lux nat max")) -(def: min-priority Priority ("lux nat min")) - -(def: #export empty - Queue - #.None) - -(def: #export (peek queue) - (All [a] (-> (Queue a) (Maybe a))) - (do maybe.Monad - [fingers queue] - (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) - -(def: #export (size queue) - (All [a] (-> (Queue a) Nat)) - (case queue - #.None - +0 - - (#.Some fingers) - (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf _ _) - +1 - - (#F.Branch _ left right) - (n/+ (recur left) (recur right)))))) - -(def: #export (member? Eq queue member) - (All [a] (-> (Eq a) (Queue a) a Bool)) - (case queue - #.None - false - - (#.Some fingers) - (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf _ reference) - (:: Eq = reference member) - - (#F.Branch _ left right) - (or (recur left) - (recur right)))))) - -(def: #export (pop queue) - (All [a] (-> (Queue a) (Queue a))) - (do maybe.Monad - [fingers queue - #let [highest-priority (F.tag fingers)] - node' (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf priority reference) - (if (n/= highest-priority priority) - #.None - (#.Some node)) - - (#F.Branch priority left right) - (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) - (case (recur left) - #.None - (#.Some right) - - (#.Some =left) - (|> (F.branch (set@ #F.tree =left fingers) - (set@ #F.tree right fingers)) - (get@ #F.tree) - #.Some)) - (case (recur right) - #.None - (#.Some left) - - (#.Some =right) - (|> (F.branch (set@ #F.tree left fingers) - (set@ #F.tree =right fingers)) - (get@ #F.tree) - #.Some)) - )))] - (wrap (set@ #F.tree node' fingers)))) - -(def: #export (push priority value queue) - (All [a] (-> Priority a (Queue a) (Queue a))) - (let [addition {#F.monoid number.Max@Monoid - #F.tree (#F.Leaf priority value)}] - (case queue - #.None - (#.Some addition) - - (#.Some fingers) - (#.Some (F.branch fingers addition))))) diff --git a/stdlib/source/lux/data/coll/queue/priority.lux b/stdlib/source/lux/data/coll/queue/priority.lux new file mode 100644 index 000000000..833d3b3e1 --- /dev/null +++ b/stdlib/source/lux/data/coll/queue/priority.lux @@ -0,0 +1,102 @@ +(.module: + lux + (lux (control [eq #+ Eq] + [monad #+ do Monad]) + (data (coll (tree ["F" finger])) + [number] + [maybe]))) + +(type: #export Priority Nat) + +(type: #export (Queue a) + (Maybe (F.Fingers Priority a))) + +(def: max-priority Priority ("lux nat max")) +(def: min-priority Priority ("lux nat min")) + +(def: #export empty + Queue + #.None) + +(def: #export (peek queue) + (All [a] (-> (Queue a) (Maybe a))) + (do maybe.Monad + [fingers queue] + (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) + +(def: #export (size queue) + (All [a] (-> (Queue a) Nat)) + (case queue + #.None + +0 + + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf _ _) + +1 + + (#F.Branch _ left right) + (n/+ (recur left) (recur right)))))) + +(def: #export (member? Eq queue member) + (All [a] (-> (Eq a) (Queue a) a Bool)) + (case queue + #.None + false + + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf _ reference) + (:: Eq = reference member) + + (#F.Branch _ left right) + (or (recur left) + (recur right)))))) + +(def: #export (pop queue) + (All [a] (-> (Queue a) (Queue a))) + (do maybe.Monad + [fingers queue + #let [highest-priority (F.tag fingers)] + node' (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf priority reference) + (if (n/= highest-priority priority) + #.None + (#.Some node)) + + (#F.Branch priority left right) + (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) + (case (recur left) + #.None + (#.Some right) + + (#.Some =left) + (|> (F.branch (set@ #F.tree =left fingers) + (set@ #F.tree right fingers)) + (get@ #F.tree) + #.Some)) + (case (recur right) + #.None + (#.Some left) + + (#.Some =right) + (|> (F.branch (set@ #F.tree left fingers) + (set@ #F.tree =right fingers)) + (get@ #F.tree) + #.Some)) + )))] + (wrap (set@ #F.tree node' fingers)))) + +(def: #export (push priority value queue) + (All [a] (-> Priority a (Queue a) (Queue a))) + (let [addition {#F.monoid number.Max@Monoid + #F.tree (#F.Leaf priority value)}] + (case queue + #.None + (#.Some addition) + + (#.Some fingers) + (#.Some (F.branch fingers addition))))) diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux deleted file mode 100644 index 00238dc63..000000000 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ /dev/null @@ -1,52 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do Monad]) - (data (coll ["&" priority-queue]) - [number] - [maybe]) - ["r" math/random]) - lux/test) - -(def: (gen-queue size) - (-> Nat (r.Random (&.Queue Nat))) - (do r.Monad - [inputs (r.list size r.nat)] - (monad.fold @ (function (_ head tail) - (do @ - [priority r.nat] - (wrap (&.push priority head tail)))) - &.empty - inputs))) - -(context: "Queues" - (<| (times +100) - (do @ - [size (|> r.nat (:: @ map (n/% +100))) - sample (gen-queue size) - non-member-priority r.nat - non-member (|> r.nat (r.filter (|>> (&.member? number.Eq sample) not)))] - ($_ seq - (test "I can query the size of a queue (and empty queues have size 0)." - (n/= size (&.size sample))) - - (test "Enqueueing and dequeing affects the size of queues." - (and (n/= (n/inc size) - (&.size (&.push non-member-priority non-member sample))) - (or (n/= +0 (&.size sample)) - (n/= (n/dec size) - (&.size (&.pop sample)))))) - - (test "I can query whether an element belongs to a queue." - (and (and (not (&.member? number.Eq sample non-member)) - (&.member? number.Eq - (&.push non-member-priority non-member sample) - non-member)) - (or (n/= +0 (&.size sample)) - (and (&.member? number.Eq - sample - (maybe.assume (&.peek sample))) - (not (&.member? number.Eq - (&.pop sample) - (maybe.assume (&.peek sample)))))))) - )))) diff --git a/stdlib/test/test/lux/data/coll/queue/priority.lux b/stdlib/test/test/lux/data/coll/queue/priority.lux new file mode 100644 index 000000000..2ccb58ec4 --- /dev/null +++ b/stdlib/test/test/lux/data/coll/queue/priority.lux @@ -0,0 +1,52 @@ +(.module: + lux + (lux [io] + (control [monad #+ do Monad]) + (data (coll (queue ["&" priority])) + [number] + [maybe]) + ["r" math/random]) + lux/test) + +(def: (gen-queue size) + (-> Nat (r.Random (&.Queue Nat))) + (do r.Monad + [inputs (r.list size r.nat)] + (monad.fold @ (function (_ head tail) + (do @ + [priority r.nat] + (wrap (&.push priority head tail)))) + &.empty + inputs))) + +(context: "Queues" + (<| (times +100) + (do @ + [size (|> r.nat (:: @ map (n/% +100))) + sample (gen-queue size) + non-member-priority r.nat + non-member (|> r.nat (r.filter (|>> (&.member? number.Eq sample) not)))] + ($_ seq + (test "I can query the size of a queue (and empty queues have size 0)." + (n/= size (&.size sample))) + + (test "Enqueueing and dequeing affects the size of queues." + (and (n/= (n/inc size) + (&.size (&.push non-member-priority non-member sample))) + (or (n/= +0 (&.size sample)) + (n/= (n/dec size) + (&.size (&.pop sample)))))) + + (test "I can query whether an element belongs to a queue." + (and (and (not (&.member? number.Eq sample non-member)) + (&.member? number.Eq + (&.push non-member-priority non-member sample) + non-member)) + (or (n/= +0 (&.size sample)) + (and (&.member? number.Eq + sample + (maybe.assume (&.peek sample))) + (not (&.member? number.Eq + (&.pop sample) + (maybe.assume (&.peek sample)))))))) + )))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 7351c8746..a25d419bc 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -43,16 +43,16 @@ ["_." xml]) (coll ["_." array] ["_." bits] - ["_." dictionary/unordered] - ["_." dictionary/ordered] ["_." list] - ["_." queue] - ["_." set/unordered] - ["_." set/ordered] ["_." stack] ["_." sequence] - ["_." priority-queue] ["_." stream] + ["_." dictionary/unordered] + ["_." dictionary/ordered] + ["_." set/unordered] + ["_." set/ordered] + ["_." queue] + (queue ["_." priority]) (tree ["tree_." rose] ["tree_." zipper])) (text ["_." format] -- cgit v1.2.3