1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
-- | Validity testing
module Validity.BinomialQueue
( validShape
, precedesProperly
) where
import BinomialQueue.Internals
-- | Does the heap have a valid shape?
validShape :: MinQueue a -> Bool
validShape (MinQueue f) = validShapeF f
validShapeF :: BinomForest rk a -> Bool
validShapeF (Cons _ f) = validShapeF f
validShapeF (Skip Nil) = False
validShapeF (Skip _f) = True
validShapeF Nil = True
-- | Takes an element and a priority queue. Checks that the queue is in heap
-- order and that the element is less than or equal to all elements of the
-- queue.
precedesProperly :: Ord a => a -> MinQueue a -> Bool
precedesProperly a (MinQueue q) = precedesProperlyF a q
-- | Takes an element and a forest. Checks that the forest is in heap order
-- and that the element is less than or equal to all elements of the forest.
precedesProperlyF :: (Ord a, TreeValidity rk) => a -> BinomForest rk a -> Bool
precedesProperlyF _ Nil = True
precedesProperlyF the_min (Skip f) = precedesProperlyF the_min f
precedesProperlyF the_min (Cons t ts) = precedesProperlyTree the_min t
&& precedesProperlyF the_min ts
-- | Takes an element and a tree. Checks that the tree is in heap order
-- and that the element is less than or equal to all elements of the tree.
precedesProperlyTree :: (Ord a, TreeValidity rk) => a -> BinomTree rk a -> Bool
precedesProperlyTree the_min (BinomTree a ts) = the_min <= a && precedesProperlyRk a ts
-- | A helper class for order validity checking
class TreeValidity rk where
-- | Takes an element and a collection of trees. Checks that the collection
-- is in heap order and that the element is less than or equal to all
-- elements of the collection.
precedesProperlyRk :: Ord a => a -> rk a -> Bool
instance TreeValidity Zero where
precedesProperlyRk _ ~Zero = True
instance TreeValidity rk => TreeValidity (Succ rk) where
precedesProperlyRk the_min (Succ t q) =
precedesProperlyTree the_min t &&
precedesProperlyRk the_min q
|
