{-# LANGUAGE ConstrainedClassMethods #-}
module Algebra.Graph.ToGraph (
ToGraph (..),
adjacencyMap, adjacencyIntMap, adjacencyMapTranspose, adjacencyIntMapTranspose
) where
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.Labelled as LG
import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM
import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import qualified Algebra.Graph.AdjacencyIntMap.Algorithm as AIM
import qualified Algebra.Graph.Relation as R
import qualified Algebra.Graph.Relation.Symmetric as SR
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) (&&) (&&)
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
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 -> Either (AM.Cycle (ToVertex t)) [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
dfsForest = AM.dfsForest
dfsForestFrom = AM.dfsForestFrom
dfs = AM.dfs
reachable = AM.reachable
topSort = AM.topSort
isAcyclic = AM.isAcyclic
toAdjacencyMap = id
toAdjacencyIntMap = AIM.fromAdjacencyMap
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
dfsForest = AIM.dfsForest
dfsForestFrom = AIM.dfsForestFrom
dfs = AIM.dfs
reachable = AIM.reachable
topSort = AIM.topSort
isAcyclic = AIM.isAcyclic
toAdjacencyMap = AM.stars . AIM.adjacencyList
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 . toAdjacencyMap
isEmpty _ = False
hasVertex = NAM.hasVertex
hasEdge = NAM.hasEdge
vertexCount = NAM.vertexCount
edgeCount = NAM.edgeCount
vertexList = vertexList . toAdjacencyMap
vertexSet = NAM.vertexSet
vertexIntSet = vertexIntSet . toAdjacencyMap
edgeList = NAM.edgeList
edgeSet = NAM.edgeSet
adjacencyList = adjacencyList . toAdjacencyMap
preSet = NAM.preSet
postSet = NAM.postSet
dfsForest = dfsForest . toAdjacencyMap
dfsForestFrom xs = dfsForestFrom xs . toAdjacencyMap
dfs xs = dfs xs . toAdjacencyMap
reachable x = reachable x . toAdjacencyMap
topSort = topSort . toAdjacencyMap
isAcyclic = isAcyclic . toAdjacencyMap
toAdjacencyMap = NAM.fromNonEmpty
toAdjacencyIntMap = toAdjacencyIntMap . toAdjacencyMap
toAdjacencyMapTranspose = toAdjacencyMap . NAM.transpose
toAdjacencyIntMapTranspose = toAdjacencyIntMap . NAM.transpose
isDfsForestOf f = isDfsForestOf f . toAdjacencyMap
isTopSortOf x = isTopSortOf x . toAdjacencyMap
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
toAdjacencyMap = AM.stars . R.adjacencyList
toAdjacencyIntMap = AIM.stars . R.adjacencyList
toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap
toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap
instance Ord a => ToGraph (SR.Relation a) where
type ToVertex (SR.Relation a) = a
toGraph = toGraph . SR.fromSymmetric
isEmpty = SR.isEmpty
hasVertex = SR.hasVertex
hasEdge = SR.hasEdge
vertexCount = SR.vertexCount
edgeCount = SR.edgeCount
vertexList = SR.vertexList
vertexSet = SR.vertexSet
vertexIntSet = IntSet.fromAscList . SR.vertexList
edgeList = SR.edgeList
edgeSet = SR.edgeSet
adjacencyList = SR.adjacencyList
toAdjacencyMap = toAdjacencyMap . SR.fromSymmetric
toAdjacencyIntMap = toAdjacencyIntMap . SR.fromSymmetric
toAdjacencyMapTranspose = toAdjacencyMap
toAdjacencyIntMapTranspose = toAdjacencyIntMap
adjacencyMap :: ToGraph t => Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t))
adjacencyMap = AM.adjacencyMap . toAdjacencyMap
adjacencyIntMap :: (ToGraph t, ToVertex t ~ Int) => t -> IntMap IntSet
adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap
adjacencyMapTranspose :: (ToGraph t, Ord (ToVertex t)) => t -> Map (ToVertex t) (Set (ToVertex t))
adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose
adjacencyIntMapTranspose :: (ToGraph t, ToVertex t ~ Int) => t -> IntMap IntSet
adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose