diff options
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/MinMaxPSQ.hs | 57 | ||||
-rw-r--r-- | src/Data/Wrapper/PSQ.hs | 26 |
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 | ||
4 | import Data.Ord | 4 | import Data.Ord |
5 | import qualified Data.Wrapper.PSQ as PSQ | 5 | import 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) |
7 | import Prelude hiding (null, take) | 7 | import Prelude hiding (null, take) |
8 | 8 | ||
9 | data MinMaxPSQ k p = MinMaxPSQ !(PSQ k p) !(PSQ k (Down p)) | 9 | data MinMaxPSQ' k p v = MinMaxPSQ !(PSQ' k p v) !(PSQ' k (Down p) v) |
10 | type MinMaxPSQ k p = MinMaxPSQ' k p () | ||
10 | 11 | ||
11 | empty :: MinMaxPSQ k p | 12 | empty :: MinMaxPSQ' k p v |
12 | empty = MinMaxPSQ PSQ.empty PSQ.empty | 13 | empty = MinMaxPSQ PSQ.empty PSQ.empty |
13 | 14 | ||
14 | null :: MinMaxPSQ k p -> Bool | 15 | null :: MinMaxPSQ' k p v -> Bool |
15 | null (MinMaxPSQ nq xq) = PSQ.null nq | 16 | null (MinMaxPSQ nq xq) = PSQ.null nq |
16 | 17 | ||
17 | size :: MinMaxPSQ k p -> Int | 18 | size :: MinMaxPSQ' k p v -> Int |
18 | size (MinMaxPSQ nq xq) = PSQ.size nq | 19 | size (MinMaxPSQ nq xq) = PSQ.size nq |
19 | 20 | ||
20 | toList :: (PSQKey k, Ord p) => MinMaxPSQ k p -> [Binding k p] | 21 | toList :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> [Binding' k p v] |
21 | toList (MinMaxPSQ nq xq) = PSQ.toList nq | 22 | toList (MinMaxPSQ nq xq) = PSQ.toList nq |
22 | 23 | ||
23 | fromList :: (PSQKey k, Ord p) => [Binding k p] -> MinMaxPSQ k p | 24 | fromList :: (PSQKey k, Ord p) => [Binding' k p v] -> MinMaxPSQ' k p v |
24 | fromList kps = MinMaxPSQ (PSQ.fromList kps) | 25 | fromList 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 | ||
27 | findMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) | 28 | findMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v) |
28 | findMin (MinMaxPSQ nq xq) = PSQ.findMin nq | 29 | findMin (MinMaxPSQ nq xq) = PSQ.findMin nq |
29 | 30 | ||
30 | findMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) | 31 | findMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v) |
31 | findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq | 32 | findMax (MinMaxPSQ nq xq) = fmap (\(Binding k v (Down p)) -> Binding k v p) $ PSQ.findMin xq |
32 | 33 | ||
33 | insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p | 34 | insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p |
34 | insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq) | 35 | insert 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 | ||
37 | delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p | 38 | insert' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v |
39 | insert' k v p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert' k v p nq) | ||
40 | (PSQ.insert' k v (Down p) xq) | ||
41 | |||
42 | delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v | ||
38 | delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) | 43 | delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) |
39 | 44 | ||
40 | deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p | 45 | deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v |
41 | deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of | 46 | deleteMin (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 | ||
45 | deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p | 50 | deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v |
46 | deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of | 51 | deleteMax (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 | ||
50 | minView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) | 55 | minView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v) |
51 | minView (MinMaxPSQ nq xq) = fmap (\(k :-> p, nq') -> (k :-> p, MinMaxPSQ nq' (PSQ.delete k xq))) | 56 | minView (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 | ||
54 | maxView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) | 59 | maxView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v) |
55 | maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) | 60 | maxView (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 | |||
60 | insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p | 65 | insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p |
61 | insertTake n k p q = take n $ insert k p q | 66 | insertTake 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. | ||
70 | insertTake' :: (PSQKey k, Ord p) => Int -> k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v | ||
71 | insertTake' 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. |
64 | take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p | 75 | take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v |
65 | take !n !q | (size q <= n) = q | 76 | take !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) | |||
26 | import qualified Data.HashPSQ as Q | 26 | import qualified Data.HashPSQ as Q |
27 | import Data.Hashable | 27 | import Data.Hashable |
28 | 28 | ||
29 | type PSQ k p = HashPSQ k p () | 29 | type PSQ' k p v = HashPSQ k p v |
30 | type Binding k p = (k,p,()) | 30 | type PSQ k p = PSQ' k p () |
31 | |||
32 | type Binding' k p v = (k,p,v) | ||
33 | type Binding k p = Binding' k p () | ||
31 | 34 | ||
32 | type PSQKey k = (Hashable k, Ord k) | 35 | type PSQKey k = (Hashable k, Ord k) |
33 | 36 | ||
34 | pattern (:->) :: k -> p -> Binding k p | 37 | pattern (:->) :: k -> p -> Binding k p |
35 | pattern k :-> p <- (k,p,()) where k :-> p = (k,p,()) | 38 | pattern 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... | ||
42 | pattern Binding :: k -> v -> p -> Binding' k p v | ||
43 | pattern Binding k v p <- (k,p,v) where Binding k v p = (k,p,v) | ||
36 | 44 | ||
37 | key :: Binding k p -> k | 45 | key :: (k,p,v) -> k |
38 | key (k,p,v) = k | 46 | key (k,p,v) = k |
39 | {-# INLINE key #-} | 47 | {-# INLINE key #-} |
40 | 48 | ||
41 | prio :: Binding k p -> p | 49 | prio :: (k,p,v) -> p |
42 | prio (k,p,v) = p | 50 | prio (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 | |||
46 | insert k p q = Q.insert k p () q | 54 | insert k p q = Q.insert k p () q |
47 | {-# INLINE insert #-} | 55 | {-# INLINE insert #-} |
48 | 56 | ||
57 | insert' :: (PSQKey k, Ord p) => k -> v -> p -> PSQ' k p v -> PSQ' k p v | ||
58 | insert' k v p q = Q.insert k p v q | ||
59 | {-# INLINE insert' #-} | ||
60 | |||
49 | insertWith :: (PSQKey k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p | 61 | insertWith :: (PSQKey k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p |
50 | insertWith f k p0 q = snd $ Q.alter f' k q | 62 | insertWith 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 | |||
57 | singleton k p = Q.singleton k p () | 69 | singleton k p = Q.singleton k p () |
58 | {-# INLINE singleton #-} | 70 | {-# INLINE singleton #-} |
59 | 71 | ||
60 | minView :: (PSQKey k, Ord p) => PSQ k p -> Maybe (Binding k p, PSQ k p) | 72 | minView :: (PSQKey k, Ord p) => PSQ' k p v -> Maybe (Binding' k p v, PSQ' k p v) |
61 | minView q = fmap (\(k,p,(),q') -> (k :-> p, q')) $ Q.minView q | 73 | minView 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 |