module Graphs.TopSort(
topSort,
topSort1,
) where
import qualified Data.Map as Map
data Ord a => TopSortState a = TopSortState {
TopSortState a -> [a]
soFar :: [a],
TopSortState a -> [a]
maximal :: [a],
TopSortState a -> Map a (Int, [a])
remaining :: Map.Map a (Int,[a])
}
topSort :: Ord a => [(a,a)] -> [a]
topSort :: [(a, a)] -> [a]
topSort [(a, a)]
relations = [(a, a)] -> [a] -> [a]
forall a. Ord a => [(a, a)] -> [a] -> [a]
topSort1 [(a, a)]
relations []
topSort1 :: Ord a => [(a,a)] -> [a] -> [a]
topSort1 :: [(a, a)] -> [a] -> [a]
topSort1 [(a, a)]
relations [a]
nodes =
let
topSortState0 :: TopSortState a
topSortState0 = [(a, a)] -> TopSortState a
forall a. Ord a => [(a, a)] -> TopSortState a
initialise [(a, a)]
relations
topSortState1 :: TopSortState a
topSortState1 = TopSortState a -> [a] -> TopSortState a
forall a. Ord a => TopSortState a -> [a] -> TopSortState a
ensureNodes TopSortState a
topSortState0 [a]
nodes
doWork :: TopSortState a -> [a]
doWork TopSortState a
topSortState0 =
case TopSortState a -> Either [a] (TopSortState a)
forall a. Ord a => TopSortState a -> Either [a] (TopSortState a)
oneStep TopSortState a
topSortState0 of
Left [a]
result -> [a]
result
Right TopSortState a
topSortState1 -> TopSortState a -> [a]
doWork TopSortState a
topSortState1
in
TopSortState a -> [a]
forall a. Ord a => TopSortState a -> [a]
doWork TopSortState a
topSortState1
ensureNodes :: Ord a => TopSortState a -> [a] -> TopSortState a
ensureNodes :: TopSortState a -> [a] -> TopSortState a
ensureNodes = (TopSortState a -> a -> TopSortState a)
-> TopSortState a -> [a] -> TopSortState a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TopSortState a -> a -> TopSortState a
forall a. Ord a => TopSortState a -> a -> TopSortState a
ensureNode
ensureNode :: Ord a => TopSortState a -> a -> TopSortState a
ensureNode :: TopSortState a -> a -> TopSortState a
ensureNode
(state :: TopSortState a
state @ (
TopSortState {soFar :: forall a. Ord a => TopSortState a -> [a]
soFar = [a]
soFar,maximal :: forall a. Ord a => TopSortState a -> [a]
maximal = [a]
maximal,remaining :: forall a. Ord a => TopSortState a -> Map a (Int, [a])
remaining = Map a (Int, [a])
remaining}))
a
node =
case a -> Map a (Int, [a]) -> Maybe (Int, [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
node Map a (Int, [a])
remaining of
Maybe (Int, [a])
Nothing ->
TopSortState a
state {soFar :: [a]
soFar = a
node a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
soFar}
Just (Int, [a])
_ -> TopSortState a
state
initialise :: Ord a => [(a,a)] -> TopSortState a
initialise :: [(a, a)] -> TopSortState a
initialise [(a, a)]
list =
let
soFar :: [a]
soFar = []
map :: Map a (Int, [a])
map = ((a, a) -> Map a (Int, [a]) -> Map a (Int, [a]))
-> Map a (Int, [a]) -> [(a, a)] -> Map a (Int, [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\ (a
from,a
to) Map a (Int, [a])
map ->
let
(Int
nFromSuccs,[a]
fromPredecessors) =
(Int, [a]) -> a -> Map a (Int, [a]) -> (Int, [a])
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Int
0,[]) a
from Map a (Int, [a])
map
map2 :: Map a (Int, [a])
map2 = a -> (Int, [a]) -> Map a (Int, [a]) -> Map a (Int, [a])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
from (Int
nFromSuccsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,[a]
fromPredecessors) Map a (Int, [a])
map
(Int
nToSuccs,[a]
toPredecessors) =
(Int, [a]) -> a -> Map a (Int, [a]) -> (Int, [a])
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Int
0,[]) a
to Map a (Int, [a])
map2
map3 :: Map a (Int, [a])
map3 = a -> (Int, [a]) -> Map a (Int, [a]) -> Map a (Int, [a])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
to (Int
nToSuccs,a
froma -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
toPredecessors) Map a (Int, [a])
map2
in
Map a (Int, [a])
map3
)
Map a (Int, [a])
forall k a. Map k a
Map.empty
[(a, a)]
list
mapEls :: [(a, (Int, [a]))]
mapEls = Map a (Int, [a]) -> [(a, (Int, [a]))]
forall k a. Map k a -> [(k, a)]
Map.toList Map a (Int, [a])
map
maximal :: [a]
maximal = [ a
key | (a
key,(Int
nSuccs,[a]
_)) <- [(a, (Int, [a]))]
mapEls, Int
nSuccs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 ]
in
TopSortState :: forall a. [a] -> [a] -> Map a (Int, [a]) -> TopSortState a
TopSortState { soFar :: [a]
soFar = [a]
forall a. [a]
soFar, remaining :: Map a (Int, [a])
remaining = Map a (Int, [a])
map, maximal :: [a]
maximal = [a]
maximal }
oneStep :: Ord a => TopSortState a -> Either [a] (TopSortState a)
oneStep :: TopSortState a -> Either [a] (TopSortState a)
oneStep(TopSortState { soFar :: forall a. Ord a => TopSortState a -> [a]
soFar = [a]
soFar, remaining :: forall a. Ord a => TopSortState a -> Map a (Int, [a])
remaining = Map a (Int, [a])
map, maximal :: forall a. Ord a => TopSortState a -> [a]
maximal = [a]
maximal }) =
case [a]
maximal of
[] ->
if Map a (Int, [a]) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Int, [a])
map
then [a] -> Either [a] (TopSortState a)
forall a b. a -> Either a b
Left [a]
soFar
else [Char] -> Either [a] (TopSortState a)
forall a. HasCallStack => [Char] -> a
error [Char]
"TopSort - cycle in data"
a
next:[a]
newMaximal ->
let
Just (Int
0,[a]
nextPredecessors) = a -> Map a (Int, [a]) -> Maybe (Int, [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
next Map a (Int, [a])
map
newSoFar :: [a]
newSoFar = a
nexta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
soFar
([a]
newMaximal2,Map a (Int, [a])
newMap) =
(a -> ([a], Map a (Int, [a])) -> ([a], Map a (Int, [a])))
-> ([a], Map a (Int, [a])) -> [a] -> ([a], Map a (Int, [a]))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\ a
pred ([a]
maximal,Map a (Int, [a])
map) ->
let
Just (Int
nPredSuccs,[a]
predPredecessors) = a -> Map a (Int, [a]) -> Maybe (Int, [a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
pred Map a (Int, [a])
map
newNPredSuccs :: Int
newNPredSuccs = Int
nPredSuccsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
newMap :: Map a (Int, [a])
newMap = a -> (Int, [a]) -> Map a (Int, [a]) -> Map a (Int, [a])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
pred
(Int
newNPredSuccs,[a]
predPredecessors) Map a (Int, [a])
map
newMaximal :: [a]
newMaximal = if Int
newNPredSuccs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then
(a
preda -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
maximal)
else
[a]
maximal
in
([a]
newMaximal,Map a (Int, [a])
newMap)
)
([a]
newMaximal,Map a (Int, [a])
map)
[a]
nextPredecessors
newMap2 :: Map a (Int, [a])
newMap2 = a -> Map a (Int, [a]) -> Map a (Int, [a])
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
next Map a (Int, [a])
newMap
in
TopSortState a -> Either [a] (TopSortState a)
forall a b. b -> Either a b
Right(TopSortState :: forall a. [a] -> [a] -> Map a (Int, [a]) -> TopSortState a
TopSortState {
soFar :: [a]
soFar = [a]
newSoFar,maximal :: [a]
maximal = [a]
newMaximal2,remaining :: Map a (Int, [a])
remaining = Map a (Int, [a])
newMap2
})