Write a priority queue module to handle dependencies efficiently
This commit is contained in:
parent
e751a60f47
commit
6b254dcdeb
2 changed files with 51 additions and 0 deletions
|
@ -23,6 +23,7 @@ executable sjw
|
||||||
, Context
|
, Context
|
||||||
, Module
|
, Module
|
||||||
, Paths_SJW
|
, Paths_SJW
|
||||||
|
, Priority
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: attoparsec
|
build-depends: attoparsec
|
||||||
, base >=4.12 && <4.13
|
, base >=4.12 && <4.13
|
||||||
|
|
50
src/Priority.hs
Normal file
50
src/Priority.hs
Normal file
|
@ -0,0 +1,50 @@
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Priority (
|
||||||
|
Queue(..)
|
||||||
|
, empty
|
||||||
|
, set
|
||||||
|
, toList
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Map as Map (
|
||||||
|
adjust, alter, delete, empty, insert, lookup, lookupMax
|
||||||
|
)
|
||||||
|
|
||||||
|
data Queue a = Queue {
|
||||||
|
byElement :: Map a Int
|
||||||
|
, byRank :: Map Int [a]
|
||||||
|
}
|
||||||
|
|
||||||
|
empty :: Queue a
|
||||||
|
empty = Queue {byElement = Map.empty, byRank = Map.empty}
|
||||||
|
|
||||||
|
set :: Ord a => a -> Int -> Queue a -> Queue a
|
||||||
|
set x priority queue@(Queue {byElement, byRank}) =
|
||||||
|
case Map.lookup x byElement of
|
||||||
|
Nothing -> Queue {
|
||||||
|
byElement = Map.insert x priority byElement
|
||||||
|
, byRank = Map.alter (push x) priority byRank
|
||||||
|
}
|
||||||
|
Just formerPriority
|
||||||
|
| formerPriority >= priority -> queue
|
||||||
|
| otherwise -> queue {
|
||||||
|
byElement = Map.insert x priority byElement
|
||||||
|
, byRank = move x formerPriority priority byRank
|
||||||
|
}
|
||||||
|
|
||||||
|
push :: a -> Maybe [a] -> Maybe [a]
|
||||||
|
push a Nothing = Just [a]
|
||||||
|
push a (Just as) = Just (a:as)
|
||||||
|
|
||||||
|
move :: Eq a => a -> Int -> Int -> Map Int [a] -> Map Int [a]
|
||||||
|
move a from to =
|
||||||
|
Map.alter (push a) to . Map.adjust (filter (/= a)) from
|
||||||
|
|
||||||
|
toList :: Queue a -> [(Int, a)]
|
||||||
|
toList = extract . byRank
|
||||||
|
where
|
||||||
|
extract tmpMap =
|
||||||
|
case Map.lookupMax tmpMap of
|
||||||
|
Nothing -> []
|
||||||
|
Just (k, elems) -> ((,) k <$> elems) ++ extract (Map.delete k tmpMap)
|
Loading…
Reference in a new issue