summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/MinMaxPSQ.hs57
-rw-r--r--src/Data/Wrapper/PSQ.hs26
2 files changed, 53 insertions, 30 deletions
diff --git a/src/Data/MinMaxPSQ.hs b/src/Data/MinMaxPSQ.hs
index f385f258..a48e62f9 100644
--- a/src/Data/MinMaxPSQ.hs
+++ b/src/Data/MinMaxPSQ.hs
@@ -3,56 +3,61 @@ module Data.MinMaxPSQ where
3 3
4import Data.Ord 4import Data.Ord
5import qualified Data.Wrapper.PSQ as PSQ 5import qualified Data.Wrapper.PSQ as PSQ
6 ;import Data.Wrapper.PSQ as PSQ hiding (insert, null, size) 6 ;import Data.Wrapper.PSQ as PSQ hiding (insert, insert', null, size)
7import Prelude hiding (null, take) 7import Prelude hiding (null, take)
8 8
9data MinMaxPSQ k p = MinMaxPSQ !(PSQ k p) !(PSQ k (Down p)) 9data MinMaxPSQ' k p v = MinMaxPSQ !(PSQ' k p v) !(PSQ' k (Down p) v)
10type MinMaxPSQ k p = MinMaxPSQ' k p ()
10 11
11empty :: MinMaxPSQ k p 12empty :: MinMaxPSQ' k p v
12empty = MinMaxPSQ PSQ.empty PSQ.empty 13empty = MinMaxPSQ PSQ.empty PSQ.empty
13 14
14null :: MinMaxPSQ k p -> Bool 15null :: MinMaxPSQ' k p v -> Bool
15null (MinMaxPSQ nq xq) = PSQ.null nq 16null (MinMaxPSQ nq xq) = PSQ.null nq
16 17
17size :: MinMaxPSQ k p -> Int 18size :: MinMaxPSQ' k p v -> Int
18size (MinMaxPSQ nq xq) = PSQ.size nq 19size (MinMaxPSQ nq xq) = PSQ.size nq
19 20
20toList :: (PSQKey k, Ord p) => MinMaxPSQ k p -> [Binding k p] 21toList :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> [Binding' k p v]
21toList (MinMaxPSQ nq xq) = PSQ.toList nq 22toList (MinMaxPSQ nq xq) = PSQ.toList nq
22 23
23fromList :: (PSQKey k, Ord p) => [Binding k p] -> MinMaxPSQ k p 24fromList :: (PSQKey k, Ord p) => [Binding' k p v] -> MinMaxPSQ' k p v
24fromList kps = MinMaxPSQ (PSQ.fromList kps) 25fromList kps = MinMaxPSQ (PSQ.fromList kps)
25 (PSQ.fromList $ map (\(k :-> p) -> (k :-> Down p)) kps) 26 (PSQ.fromList $ map (\(Binding k v p) -> Binding k v (Down p)) kps)
26 27
27findMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) 28findMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
28findMin (MinMaxPSQ nq xq) = PSQ.findMin nq 29findMin (MinMaxPSQ nq xq) = PSQ.findMin nq
29 30
30findMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) 31findMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
31findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq 32findMax (MinMaxPSQ nq xq) = fmap (\(Binding k v (Down p)) -> Binding k v p) $ PSQ.findMin xq
32 33
33insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p 34insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
34insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq) 35insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq)
35 (PSQ.insert k (Down p) xq) 36 (PSQ.insert k (Down p) xq)
36 37
37delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p 38insert' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
39insert' k v p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert' k v p nq)
40 (PSQ.insert' k v (Down p) xq)
41
42delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
38delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) 43delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq)
39 44
40deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p 45deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
41deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of 46deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of
42 Just (k :-> _, nq') -> MinMaxPSQ nq' (PSQ.delete k xq) 47 Just (Binding k _ _, nq') -> MinMaxPSQ nq' (PSQ.delete k xq)
43 Nothing -> MinMaxPSQ nq xq 48 Nothing -> MinMaxPSQ nq xq
44 49
45deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p 50deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
46deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of 51deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of
47 Just (k :-> _, xq') -> MinMaxPSQ (PSQ.delete k nq) xq' 52 Just (Binding k _ _, xq') -> MinMaxPSQ (PSQ.delete k nq) xq'
48 Nothing -> MinMaxPSQ nq xq 53 Nothing -> MinMaxPSQ nq xq
49 54
50minView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) 55minView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
51minView (MinMaxPSQ nq xq) = fmap (\(k :-> p, nq') -> (k :-> p, MinMaxPSQ nq' (PSQ.delete k xq))) 56minView (MinMaxPSQ nq xq) = fmap (\(Binding k v p, nq') -> (Binding k v p, MinMaxPSQ nq' (PSQ.delete k xq)))
52 $ PSQ.minView nq 57 $ PSQ.minView nq
53 58
54maxView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) 59maxView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
55maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) 60maxView (MinMaxPSQ nq xq) = fmap (\(Binding k v (Down p), xq') -> (Binding k v p, MinMaxPSQ (PSQ.delete k nq) xq'))
56 $ PSQ.minView xq 61 $ PSQ.minView xq
57 62
58-- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the 63-- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the
@@ -60,8 +65,14 @@ maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (P
60insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p 65insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
61insertTake n k p q = take n $ insert k p q 66insertTake n k p q = take n $ insert k p q
62 67
68-- | Maintains a bounded 'MinMaxPSQ\'' by deleting the maximum element if the
69-- insertion would cause the queue to have too many elements.
70insertTake' :: (PSQKey k, Ord p) => Int -> k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
71insertTake' n k v p q = take n $ insert' k v p q
72
73
63-- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements. 74-- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements.
64take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p 75take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
65take !n !q | (size q <= n) = q 76take !n !q | (size q <= n) = q
66 | null q = q 77 | null q = q
67 | otherwise = take n $ deleteMax q 78 | otherwise = take n $ deleteMax q
diff --git a/src/Data/Wrapper/PSQ.hs b/src/Data/Wrapper/PSQ.hs
index 54365a1d..87648e84 100644
--- a/src/Data/Wrapper/PSQ.hs
+++ b/src/Data/Wrapper/PSQ.hs
@@ -26,19 +26,27 @@ import Data.HashPSQ as HashPSQ hiding (insert, map, singleton, minView)
26import qualified Data.HashPSQ as Q 26import qualified Data.HashPSQ as Q
27import Data.Hashable 27import Data.Hashable
28 28
29type PSQ k p = HashPSQ k p () 29type PSQ' k p v = HashPSQ k p v
30type Binding k p = (k,p,()) 30type PSQ k p = PSQ' k p ()
31
32type Binding' k p v = (k,p,v)
33type Binding k p = Binding' k p ()
31 34
32type PSQKey k = (Hashable k, Ord k) 35type PSQKey k = (Hashable k, Ord k)
33 36
34pattern (:->) :: k -> p -> Binding k p 37pattern (:->) :: k -> p -> Binding k p
35pattern k :-> p <- (k,p,()) where k :-> p = (k,p,()) 38pattern k :-> p <- (k,p,_) where k :-> p = (k,p,())
39
40-- I tried defining (::->) :: (k,v) -> p -> Binding' k p v
41-- but no luck...
42pattern Binding :: k -> v -> p -> Binding' k p v
43pattern Binding k v p <- (k,p,v) where Binding k v p = (k,p,v)
36 44
37key :: Binding k p -> k 45key :: (k,p,v) -> k
38key (k,p,v) = k 46key (k,p,v) = k
39{-# INLINE key #-} 47{-# INLINE key #-}
40 48
41prio :: Binding k p -> p 49prio :: (k,p,v) -> p
42prio (k,p,v) = p 50prio (k,p,v) = p
43{-# INLINE prio #-} 51{-# INLINE prio #-}
44 52
@@ -46,6 +54,10 @@ insert :: (PSQKey k, Ord p) => k -> p -> PSQ k p -> PSQ k p
46insert k p q = Q.insert k p () q 54insert k p q = Q.insert k p () q
47{-# INLINE insert #-} 55{-# INLINE insert #-}
48 56
57insert' :: (PSQKey k, Ord p) => k -> v -> p -> PSQ' k p v -> PSQ' k p v
58insert' k v p q = Q.insert k p v q
59{-# INLINE insert' #-}
60
49insertWith :: (PSQKey k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p 61insertWith :: (PSQKey k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
50insertWith f k p0 q = snd $ Q.alter f' k q 62insertWith f k p0 q = snd $ Q.alter f' k q
51 where 63 where
@@ -57,8 +69,8 @@ singleton :: (PSQKey k, Ord p) => k -> p -> PSQ k p
57singleton k p = Q.singleton k p () 69singleton k p = Q.singleton k p ()
58{-# INLINE singleton #-} 70{-# INLINE singleton #-}
59 71
60minView :: (PSQKey k, Ord p) => PSQ k p -> Maybe (Binding k p, PSQ k p) 72minView :: (PSQKey k, Ord p) => PSQ' k p v -> Maybe (Binding' k p v, PSQ' k p v)
61minView q = fmap (\(k,p,(),q') -> (k :-> p, q')) $ Q.minView q 73minView q = fmap (\(k,p,v,q') -> (Binding k v p, q')) $ Q.minView q
62{-# INLINE minView #-} 74{-# INLINE minView #-}
63 75
64#endif 76#endif