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
|
-- | Validity testing
module Validity.PQueue.Prio.BinomialQueue
( validShapeF
, precedesProperlyF
) where
import Data.PQueue.Prio.Internals
-- | Does the heap have a valid shape?
validShapeF :: BinomForest rk k a -> Bool
validShapeF (Cons _ f) = validShapeF f
validShapeF (Skip Nil) = False
validShapeF (Skip _f) = True
validShapeF Nil = True
-- | 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 k, TreeValidity rk) => k -> BinomForest rk k 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 k, TreeValidity rk) => k -> BinomTree rk k a -> Bool
precedesProperlyTree the_min (BinomTree k ts) = the_min <= k && precedesProperlyRk k 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 k => k -> rk k 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
|
