{-# LANGUAGE ConstrainedClassMethods #-}
module Algebra.Graph.ToGraph (ToGraph (..)) where
import Prelude ()
import Prelude.Compat
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.Set (Set)
import Data.Tree
import qualified Algebra.Graph as G
import qualified Algebra.Graph.AdjacencyMap as AM
import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM
import qualified Algebra.Graph.AdjacencyMap.Internal as AM
import qualified Algebra.Graph.Labelled as LG
import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM
import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM
import qualified Algebra.Graph.NonEmpty.AdjacencyMap.Internal as NAM
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import qualified Algebra.Graph.AdjacencyIntMap.Algorithm as AIM
import qualified Algebra.Graph.AdjacencyIntMap.Internal as AIM
import qualified Algebra.Graph.Relation as R
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Set as Set
class ToGraph t where
{-# MINIMAL toGraph | foldg #-}
type ToVertex t
toGraph :: t -> G.Graph (ToVertex t)
toGraph = foldg G.Empty G.Vertex G.Overlay G.Connect
foldg :: r -> (ToVertex t -> r) -> (r -> r -> r) -> (r -> r -> r) -> t -> r
foldg e v o c = G.foldg e v o c . toGraph
isEmpty :: t -> Bool
isEmpty = foldg True (const False) (&&) (&&)
size :: t -> Int
size = foldg 1 (const 1) (+) (+)
hasVertex :: Eq (ToVertex t) => ToVertex t -> t -> Bool
hasVertex x = foldg False (==x) (||) (||)
hasEdge :: Eq (ToVertex t) => ToVertex t -> ToVertex t -> t -> Bool
hasEdge x y = G.hasEdge x y . toGraph
vertexCount :: Ord (ToVertex t) => t -> Int
vertexCount = Set.size . vertexSet
edgeCount :: Ord (ToVertex t) => t -> Int
edgeCount = AM.edgeCount . toAdjacencyMap
vertexList :: Ord (ToVertex t) => t -> [ToVertex t]
vertexList = Set.toAscList . vertexSet
edgeList :: Ord (ToVertex t) => t -> [(ToVertex t, ToVertex t)]
edgeList = AM.edgeList . toAdjacencyMap
vertexSet :: Ord (ToVertex t) => t -> Set (ToVertex t)
vertexSet = foldg Set.empty Set.singleton Set.union Set.union
vertexIntSet :: ToVertex t ~ Int => t -> IntSet
vertexIntSet = foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union
edgeSet :: Ord (ToVertex t) => t -> Set (ToVertex t, ToVertex t)
edgeSet = AM.edgeSet . toAdjacencyMap
preSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t)
preSet x = AM.postSet x . toAdjacencyMapTranspose
preIntSet :: ToVertex t ~ Int => Int -> t -> IntSet
preIntSet x = AIM.postIntSet x . toAdjacencyIntMapTranspose
postSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t)
postSet x = AM.postSet x . toAdjacencyMap
postIntSet :: ToVertex t ~ Int => Int -> t -> IntSet
postIntSet x = AIM.postIntSet x . toAdjacencyIntMap
adjacencyList :: Ord (ToVertex t) => t -> [(ToVertex t, [ToVertex t])]
adjacencyList = AM.adjacencyList . toAdjacencyMap
adjacencyMap :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t))
adjacencyMap = AM.adjacencyMap . toAdjacencyMap
adjacencyIntMap :: ToVertex t ~ Int => t -> IntMap IntSet
adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap
adjacencyMapTranspose :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t))
adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose
adjacencyIntMapTranspose :: ToVertex t ~ Int => t -> IntMap IntSet
adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose
dfsForest :: Ord (ToVertex t) => t -> Forest (ToVertex t)
dfsForest = AM.dfsForest . toAdjacencyMap
dfsForestFrom :: Ord (ToVertex t) => [ToVertex t] -> t -> Forest (ToVertex t)
dfsForestFrom vs = AM.dfsForestFrom vs . toAdjacencyMap
dfs :: Ord (ToVertex t) => [ToVertex t] -> t -> [ToVertex t]
dfs vs = AM.dfs vs . toAdjacencyMap
reachable :: Ord (ToVertex t) => ToVertex t -> t -> [ToVertex t]
reachable x = AM.reachable x . toAdjacencyMap
topSort :: Ord (ToVertex t) => t -> Maybe [ToVertex t]
topSort = AM.topSort . toAdjacencyMap
isAcyclic :: Ord (ToVertex t) => t -> Bool
isAcyclic = AM.isAcyclic . toAdjacencyMap
toAdjacencyMap :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t)
toAdjacencyMap = foldg AM.empty AM.vertex AM.overlay AM.connect
toAdjacencyMapTranspose :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t)
toAdjacencyMapTranspose = foldg AM.empty AM.vertex AM.overlay (flip AM.connect)
toAdjacencyIntMap :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap
toAdjacencyIntMap = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect
toAdjacencyIntMapTranspose :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap
toAdjacencyIntMapTranspose = foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect)
isDfsForestOf :: Ord (ToVertex t) => Forest (ToVertex t) -> t -> Bool
isDfsForestOf f = AM.isDfsForestOf f . toAdjacencyMap
isTopSortOf :: Ord (ToVertex t) => [ToVertex t] -> t -> Bool
isTopSortOf vs = AM.isTopSortOf vs . toAdjacencyMap
instance Ord a => ToGraph (G.Graph a) where
type ToVertex (G.Graph a) = a
toGraph = id
foldg = G.foldg
hasEdge = G.hasEdge
instance Ord a => ToGraph (AM.AdjacencyMap a) where
type ToVertex (AM.AdjacencyMap a) = a
toGraph = G.stars
. map (fmap Set.toList)
. Map.toList
. AM.adjacencyMap
isEmpty = AM.isEmpty
hasVertex = AM.hasVertex
hasEdge = AM.hasEdge
vertexCount = AM.vertexCount
edgeCount = AM.edgeCount
vertexList = AM.vertexList
vertexSet = AM.vertexSet
vertexIntSet = IntSet.fromAscList . AM.vertexList
edgeList = AM.edgeList
edgeSet = AM.edgeSet
adjacencyList = AM.adjacencyList
preSet = AM.preSet
postSet = AM.postSet
adjacencyMap = AM.adjacencyMap
adjacencyIntMap = IntMap.fromAscList
. map (fmap $ IntSet.fromAscList . Set.toAscList)
. Map.toAscList
. AM.adjacencyMap
dfsForest = AM.dfsForest
dfsForestFrom = AM.dfsForestFrom
dfs = AM.dfs
reachable = AM.reachable
topSort = AM.topSort
isAcyclic = AM.isAcyclic
toAdjacencyMap = id
toAdjacencyIntMap = AIM.AM . adjacencyIntMap
toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap
toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap
isDfsForestOf = AM.isDfsForestOf
isTopSortOf = AM.isTopSortOf
instance ToGraph AIM.AdjacencyIntMap where
type ToVertex AIM.AdjacencyIntMap = Int
toGraph = G.stars
. map (fmap IntSet.toList)
. IntMap.toList
. AIM.adjacencyIntMap
isEmpty = AIM.isEmpty
hasVertex = AIM.hasVertex
hasEdge = AIM.hasEdge
vertexCount = AIM.vertexCount
edgeCount = AIM.edgeCount
vertexList = AIM.vertexList
vertexSet = Set.fromAscList . IntSet.toAscList . AIM.vertexIntSet
vertexIntSet = AIM.vertexIntSet
edgeList = AIM.edgeList
edgeSet = AIM.edgeSet
adjacencyList = AIM.adjacencyList
preIntSet = AIM.preIntSet
postIntSet = AIM.postIntSet
adjacencyMap = Map.fromAscList
. map (fmap $ Set.fromAscList . IntSet.toAscList)
. IntMap.toAscList
. AIM.adjacencyIntMap
dfsForest = AIM.dfsForest
dfsForestFrom = AIM.dfsForestFrom
dfs = AIM.dfs
reachable = AIM.reachable
topSort = AIM.topSort
isAcyclic = AIM.isAcyclic
adjacencyIntMap = AIM.adjacencyIntMap
toAdjacencyMap = AM.AM . adjacencyMap
toAdjacencyIntMap = id
toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap
toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap
isDfsForestOf = AIM.isDfsForestOf
isTopSortOf = AIM.isTopSortOf
instance (Eq e, Monoid e, Ord a) => ToGraph (LG.Graph e a) where
type ToVertex (LG.Graph e a) = a
foldg e v o c = LG.foldg e v (\e -> if e == mempty then o else c)
vertexList = LG.vertexList
vertexSet = LG.vertexSet
toAdjacencyMap = LAM.skeleton
. LG.foldg LAM.empty LAM.vertex LAM.connect
toAdjacencyMapTranspose = LAM.skeleton
. LG.foldg LAM.empty LAM.vertex (fmap flip LAM.connect)
toAdjacencyIntMap = toAdjacencyIntMap . toAdjacencyMap
toAdjacencyIntMapTranspose = toAdjacencyIntMapTranspose . toAdjacencyMapTranspose
instance (Eq e, Monoid e, Ord a) => ToGraph (LAM.AdjacencyMap e a) where
type ToVertex (LAM.AdjacencyMap e a) = a
toGraph = toGraph . LAM.skeleton
foldg e v o c = foldg e v o c . LAM.skeleton
isEmpty = LAM.isEmpty
hasVertex = LAM.hasVertex
hasEdge = LAM.hasEdge
vertexCount = LAM.vertexCount
edgeCount = LAM.edgeCount
vertexList = LAM.vertexList
vertexSet = LAM.vertexSet
vertexIntSet = IntSet.fromAscList . LAM.vertexList
edgeList = edgeList . LAM.skeleton
edgeSet = edgeSet . LAM.skeleton
adjacencyList = adjacencyList . LAM.skeleton
preSet = LAM.preSet
postSet = LAM.postSet
toAdjacencyMap = LAM.skeleton
toAdjacencyIntMap = toAdjacencyIntMap . LAM.skeleton
toAdjacencyMapTranspose = toAdjacencyMapTranspose . LAM.skeleton
toAdjacencyIntMapTranspose = toAdjacencyIntMapTranspose . LAM.skeleton
instance Ord a => ToGraph (NAM.AdjacencyMap a) where
type ToVertex (NAM.AdjacencyMap a) = a
toGraph = toGraph . NAM.am
isEmpty _ = False
hasVertex = NAM.hasVertex
hasEdge = NAM.hasEdge
vertexCount = NAM.vertexCount
edgeCount = NAM.edgeCount
vertexList = vertexList . NAM.am
vertexSet = NAM.vertexSet
vertexIntSet = vertexIntSet . NAM.am
edgeList = NAM.edgeList
edgeSet = NAM.edgeSet
adjacencyList = adjacencyList . NAM.am
preSet = NAM.preSet
postSet = NAM.postSet
adjacencyMap = adjacencyMap . NAM.am
adjacencyIntMap = adjacencyIntMap . NAM.am
dfsForest = dfsForest . NAM.am
dfsForestFrom xs = dfsForestFrom xs . NAM.am
dfs xs = dfs xs . NAM.am
reachable x = reachable x . NAM.am
topSort = topSort . NAM.am
isAcyclic = isAcyclic . NAM.am
toAdjacencyMap = NAM.am
toAdjacencyIntMap = toAdjacencyIntMap . NAM.am
toAdjacencyMapTranspose = NAM.am . NAM.transpose
toAdjacencyIntMapTranspose = toAdjacencyIntMap . NAM.transpose
isDfsForestOf f = isDfsForestOf f . NAM.am
isTopSortOf x = isTopSortOf x . NAM.am
instance Ord a => ToGraph (R.Relation a) where
type ToVertex (R.Relation a) = a
toGraph r = G.vertices (Set.toList $ R.domain r) `G.overlay`
G.edges (Set.toList $ R.relation r)
isEmpty = R.isEmpty
hasVertex = R.hasVertex
hasEdge = R.hasEdge
vertexCount = R.vertexCount
edgeCount = R.edgeCount
vertexList = R.vertexList
vertexSet = R.vertexSet
vertexIntSet = IntSet.fromAscList . R.vertexList
edgeList = R.edgeList
edgeSet = R.edgeSet
adjacencyList = R.adjacencyList
adjacencyMap = Map.fromAscList
. map (fmap Set.fromAscList)
. R.adjacencyList
adjacencyIntMap = IntMap.fromAscList
. map (fmap IntSet.fromAscList)
. R.adjacencyList
toAdjacencyMap = AM.AM . adjacencyMap
toAdjacencyIntMap = AIM.AM . adjacencyIntMap
toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap
toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap