module HGraph.Directed.AdjacencyMap
       ( Digraph
       , emptyDigraph
       , module HGraph.Directed
       )
where

import HGraph.Directed
import qualified Data.Map as M
import qualified Data.Set as S

type DirectedNeighborhood a = (S.Set a, S.Set a)
data Digraph a where
  Digraph :: Ord a => M.Map a (DirectedNeighborhood a) -> Digraph a

emptyDigraph :: Ord a => Digraph a
emptyDigraph :: Digraph a
emptyDigraph = Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph Map a (DirectedNeighborhood a)
forall k a. Map k a
M.empty

instance DirectedGraph Digraph where
  empty :: Digraph a -> Digraph a
empty (Digraph Map a (DirectedNeighborhood a)
d) = Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph Map a (DirectedNeighborhood a)
forall k a. Map k a
M.empty
  numVertices :: Digraph a -> b
numVertices (Digraph Map a (DirectedNeighborhood a)
d) = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Map a (DirectedNeighborhood a) -> Int
forall k a. Map k a -> Int
M.size Map a (DirectedNeighborhood a)
d
  vertices :: Digraph a -> [a]
vertices (Digraph Map a (DirectedNeighborhood a)
d) = Map a (DirectedNeighborhood a) -> [a]
forall k a. Map k a -> [k]
M.keys Map a (DirectedNeighborhood a)
d
  arcs :: Digraph a -> [(a, a)]
arcs (Digraph Map a (DirectedNeighborhood a)
d) = ((a, DirectedNeighborhood a) -> [(a, a)])
-> [(a, DirectedNeighborhood a)] -> [(a, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
v, (Set a
_,Set a
o)) -> [(a
v,a
u) | a
u <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
o]) ([(a, DirectedNeighborhood a)] -> [(a, a)])
-> [(a, DirectedNeighborhood a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Map a (DirectedNeighborhood a) -> [(a, DirectedNeighborhood a)]
forall k a. Map k a -> [(k, a)]
M.assocs Map a (DirectedNeighborhood a)
d
  isVertex :: Digraph a -> a -> Bool
isVertex (Digraph Map a (DirectedNeighborhood a)
d) a
v = a
v a -> Map a (DirectedNeighborhood a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map a (DirectedNeighborhood a)
d
  linearizeVertices :: Digraph a -> (Digraph Int, [(Int, a)])
linearizeVertices g :: Digraph a
g@(Digraph Map a (DirectedNeighborhood a)
adj) = (Digraph Int
g', [(Int, a)]
assocs)
    where
      assocs :: [(Int, a)]
assocs = [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Map a (DirectedNeighborhood a) -> [a]
forall k a. Map k a -> [k]
M.keys Map a (DirectedNeighborhood a)
adj)
      ltoi :: Map a Int
ltoi = [(a, Int)] -> Map a Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Int)] -> Map a Int) -> [(a, Int)] -> Map a Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map a (DirectedNeighborhood a) -> [a]
forall k a. Map k a -> [k]
M.keys Map a (DirectedNeighborhood a)
adj) [Int
0..]
      g' :: Digraph Int
g' = ((Int, Int) -> Digraph Int -> Digraph Int)
-> Digraph Int -> [(Int, Int)] -> Digraph Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> Digraph Int -> Digraph Int
forall (t :: * -> *) a. Mutable t => (a, a) -> t a -> t a
addArc ((Int -> Digraph Int -> Digraph Int)
-> Digraph Int -> [Int] -> Digraph Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Digraph Int -> Digraph Int
forall (t :: * -> *) a. Mutable t => a -> t a -> t a
addVertex Digraph Int
forall a. Ord a => Digraph a
emptyDigraph (((Int, a) -> Int) -> [(Int, a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> Int
forall a b. (a, b) -> a
fst [(Int, a)]
assocs)) ([(Int, Int)] -> Digraph Int) -> [(Int, Int)] -> Digraph Int
forall a b. (a -> b) -> a -> b
$
            [ (Map a Int
ltoi Map a Int -> a -> Int
forall k a. Ord k => Map k a -> k -> a
M.! a
u, Map a Int
ltoi Map a Int -> a -> Int
forall k a. Ord k => Map k a -> k -> a
M.! a
v) | (a
u,a
v) <- Digraph a -> [(a, a)]
forall (t :: * -> *) a. DirectedGraph t => t a -> [(a, a)]
arcs Digraph a
g ]

instance Adjacency Digraph where
  outneighbors :: Digraph a -> a -> [a]
outneighbors (Digraph Map a (DirectedNeighborhood a)
d) a
v = Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ DirectedNeighborhood a -> Set a
forall a b. (a, b) -> b
snd (DirectedNeighborhood a -> Set a)
-> DirectedNeighborhood a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a (DirectedNeighborhood a)
d Map a (DirectedNeighborhood a) -> a -> DirectedNeighborhood a
forall k a. Ord k => Map k a -> k -> a
M.! a
v
  inneighbors :: Digraph a -> a -> [a]
inneighbors  (Digraph Map a (DirectedNeighborhood a)
d) a
v = Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ DirectedNeighborhood a -> Set a
forall a b. (a, b) -> a
fst (DirectedNeighborhood a -> Set a)
-> DirectedNeighborhood a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a (DirectedNeighborhood a)
d Map a (DirectedNeighborhood a) -> a -> DirectedNeighborhood a
forall k a. Ord k => Map k a -> k -> a
M.! a
v
  arcExists :: Digraph a -> (a, a) -> Bool
arcExists (Digraph Map a (DirectedNeighborhood a)
d) (a
v,a
u) = a
u a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` (DirectedNeighborhood a -> Set a
forall a b. (a, b) -> b
snd (DirectedNeighborhood a -> Set a)
-> DirectedNeighborhood a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a (DirectedNeighborhood a)
d Map a (DirectedNeighborhood a) -> a -> DirectedNeighborhood a
forall k a. Ord k => Map k a -> k -> a
M.! a
v)

instance Mutable Digraph where
  addVertex :: a -> Digraph a -> Digraph a
addVertex a
v (Digraph Map a (DirectedNeighborhood a)
d) =
    Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph ((DirectedNeighborhood a
 -> DirectedNeighborhood a -> DirectedNeighborhood a)
-> a
-> DirectedNeighborhood a
-> Map a (DirectedNeighborhood a)
-> Map a (DirectedNeighborhood a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\DirectedNeighborhood a
_ DirectedNeighborhood a
o -> DirectedNeighborhood a
o) a
v (Set a
forall a. Set a
S.empty, Set a
forall a. Set a
S.empty) Map a (DirectedNeighborhood a)
d)
  removeVertex :: a -> Digraph a -> Digraph a
removeVertex a
v g :: Digraph a
g@(Digraph Map a (DirectedNeighborhood a)
d) = 
      let Digraph Map a (DirectedNeighborhood a)
d' = ((a, a) -> Digraph a -> Digraph a)
-> Digraph a -> [(a, a)] -> Digraph a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, a) -> Digraph a -> Digraph a
forall (t :: * -> *) a. Mutable t => (a, a) -> t a -> t a
removeArc Digraph a
g
                     (  ((a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
u -> (a
v,a
u)) ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Digraph a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors Digraph a
g a
v)
                     [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ ((a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
u -> (a
u,a
v)) ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Digraph a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors  Digraph a
g a
v))
      in Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph (Map a (DirectedNeighborhood a) -> Digraph a)
-> Map a (DirectedNeighborhood a) -> Digraph a
forall a b. (a -> b) -> a -> b
$ a
-> Map a (DirectedNeighborhood a) -> Map a (DirectedNeighborhood a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
v Map a (DirectedNeighborhood a)
d'
            
  addArc :: (a, a) -> Digraph a -> Digraph a
addArc (a
v,a
u) (Digraph Map a (DirectedNeighborhood a)
d) =
    Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph ( (DirectedNeighborhood a -> DirectedNeighborhood a)
-> a
-> Map a (DirectedNeighborhood a)
-> Map a (DirectedNeighborhood a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\(Set a
i,Set a
o) -> (Set a
i, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
u Set a
o)) a
v
            (Map a (DirectedNeighborhood a) -> Map a (DirectedNeighborhood a))
-> Map a (DirectedNeighborhood a) -> Map a (DirectedNeighborhood a)
forall a b. (a -> b) -> a -> b
$ (DirectedNeighborhood a -> DirectedNeighborhood a)
-> a
-> Map a (DirectedNeighborhood a)
-> Map a (DirectedNeighborhood a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\(Set a
i,Set a
o) -> (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
v Set a
i, Set a
o)) a
u Map a (DirectedNeighborhood a)
d)
  removeArc :: (a, a) -> Digraph a -> Digraph a
removeArc (a
v,a
u) (Digraph Map a (DirectedNeighborhood a)
d)  =
    Map a (DirectedNeighborhood a) -> Digraph a
forall a. Ord a => Map a (DirectedNeighborhood a) -> Digraph a
Digraph ( (DirectedNeighborhood a -> DirectedNeighborhood a)
-> a
-> Map a (DirectedNeighborhood a)
-> Map a (DirectedNeighborhood a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\(Set a
i,Set a
o) -> (Set a
i, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
u Set a
o)) a
v
            (Map a (DirectedNeighborhood a) -> Map a (DirectedNeighborhood a))
-> Map a (DirectedNeighborhood a) -> Map a (DirectedNeighborhood a)
forall a b. (a -> b) -> a -> b
$ (DirectedNeighborhood a -> DirectedNeighborhood a)
-> a
-> Map a (DirectedNeighborhood a)
-> Map a (DirectedNeighborhood a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\(Set a
i,Set a
o) -> (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
v Set a
i, Set a
o)) a
u Map a (DirectedNeighborhood a)
d)