{-# LANGUAGE ConstrainedClassMethods #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.ToGraph -- Copyright : (c) Andrey Mokhov 2016-2018 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental -- -- __Alga__ is a library for algebraic construction and manipulation of graphs -- in Haskell. See for the -- motivation behind the library, the underlying theory, and implementation details. -- -- This module defines the type class 'ToGraph' for capturing data types that -- can be converted to algebraic graphs. To make an instance of this class you -- need to define just a single method ('toGraph' or 'foldg'), which gives you -- access to many other useful methods for free. This type class is similar to -- the standard "Data.Foldable" defined for lists. -- ----------------------------------------------------------------------------- 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.Internal as AM import qualified Algebra.Graph.AdjacencyIntMap 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 -- | The 'ToGraph' type class captures data types that can be converted to -- algebraic graphs. class ToGraph t where {-# MINIMAL toGraph | foldg #-} type ToVertex t -- | Convert a value to the corresponding algebraic graph, see "Algebra.Graph". -- -- @ -- toGraph == 'foldg' 'G.Empty' 'G.Vertex' 'G.Overlay' 'G.Connect' -- @ toGraph :: t -> G.Graph (ToVertex t) toGraph = foldg G.Empty G.Vertex G.Overlay G.Connect -- | The method 'foldg' is used for generalised graph folding. It collapses -- a given value by applying the provided graph construction primitives. The -- order of arguments is: empty, vertex, overlay and connect, and it is -- assumed that the arguments satisfy the axioms of the graph algebra. -- -- @ -- foldg == Algebra.Graph.'G.foldg' . 'toGraph' -- @ 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 -- | Check if a graph is empty. -- -- @ -- isEmpty == 'foldg' True (const False) (&&) (&&) -- @ isEmpty :: t -> Bool isEmpty = foldg True (const False) (&&) (&&) -- | The /size/ of a graph, i.e. the number of leaves of the expression -- including 'empty' leaves. -- -- @ -- size == 'foldg' 1 (const 1) (+) (+) -- @ size :: t -> Int size = foldg 1 (const 1) (+) (+) -- | Check if a graph contains a given vertex. -- -- @ -- hasVertex x == 'foldg' False (==x) (||) (||) -- @ hasVertex :: Eq (ToVertex t) => ToVertex t -> t -> Bool hasVertex x = foldg False (==x) (||) (||) -- | Check if a graph contains a given edge. -- -- @ -- hasEdge x y == Algebra.Graph.'G.hasEdge' x y . 'toGraph' -- @ hasEdge :: Eq (ToVertex t) => ToVertex t -> ToVertex t -> t -> Bool hasEdge x y = G.hasEdge x y . toGraph -- | The number of vertices in a graph. -- -- @ -- vertexCount == Set.'Set.size' . 'vertexSet' -- @ vertexCount :: Ord (ToVertex t) => t -> Int vertexCount = Set.size . vertexSet -- | The number of edges in a graph. -- -- @ -- edgeCount == Set.'Set.size' . 'edgeSet' -- @ edgeCount :: Ord (ToVertex t) => t -> Int edgeCount = AM.edgeCount . toAdjacencyMap -- | The sorted list of vertices of a given graph. -- -- @ -- vertexList == Set.'Set.toAscList' . 'vertexSet' -- @ vertexList :: Ord (ToVertex t) => t -> [ToVertex t] vertexList = Set.toAscList . vertexSet -- | The sorted list of edges of a graph. -- -- @ -- edgeList == Set.'Set.toAscList' . 'edgeSet' -- @ edgeList :: Ord (ToVertex t) => t -> [(ToVertex t, ToVertex t)] edgeList = AM.edgeList . toAdjacencyMap -- | The set of vertices of a graph. -- -- @ -- vertexSet == 'foldg' Set.'Set.empty' Set.'Set.singleton' Set.'Set.union' Set.'Set.union' -- @ vertexSet :: Ord (ToVertex t) => t -> Set (ToVertex t) vertexSet = foldg Set.empty Set.singleton Set.union Set.union -- | The set of vertices of a graph. Like 'vertexSet' but specialised for -- graphs with vertices of type 'Int'. -- -- @ -- vertexIntSet == 'foldg' IntSet.'IntSet.empty' IntSet.'IntSet.singleton' IntSet.'IntSet.union' IntSet.'IntSet.union' -- @ vertexIntSet :: ToVertex t ~ Int => t -> IntSet vertexIntSet = foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union -- | The set of edges of a graph. -- -- @ -- edgeSet == Algebra.Graph.AdjacencyMap.'AM.edgeSet' . 'toAdjacencyMap' -- @ edgeSet :: Ord (ToVertex t) => t -> Set (ToVertex t, ToVertex t) edgeSet = AM.edgeSet . toAdjacencyMap -- | The /preset/ of a vertex is the set of its /direct predecessors/. -- -- @ -- preSet x == Algebra.Graph.AdjacencyMap.'AM.preSet' x . 'toAdjacencyMap' -- @ preSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t) preSet x = AM.postSet x . toAdjacencyMapTranspose -- | The /preset/ (here @preIntSet@) of a vertex is the set of its -- /direct predecessors/. Like 'preSet' but specialised for graphs with -- vertices of type 'Int'. -- -- @ -- preIntSet x == Algebra.Graph.AdjacencyIntMap.'AIM.preIntSet' x . 'toAdjacencyIntMap' -- @ preIntSet :: ToVertex t ~ Int => Int -> t -> IntSet preIntSet x = AIM.postIntSet x . toAdjacencyIntMapTranspose -- | The /postset/ of a vertex is the set of its /direct successors/. -- -- @ -- postSet x == Algebra.Graph.AdjacencyMap.'AM.postSet' x . 'toAdjacencyMap' -- @ postSet :: Ord (ToVertex t) => ToVertex t -> t -> Set (ToVertex t) postSet x = AM.postSet x . toAdjacencyMap -- | The /postset/ (here @postIntSet@) of a vertex is the set of its -- /direct successors/. Like 'postSet' but specialised for graphs with -- vertices of type 'Int'. -- -- @ -- postIntSet x == Algebra.Graph.AdjacencyIntMap.'AIM.postIntSet' x . 'toAdjacencyIntMap' -- @ postIntSet :: ToVertex t ~ Int => Int -> t -> IntSet postIntSet x = AIM.postIntSet x . toAdjacencyIntMap -- | The sorted /adjacency list/ of a graph. -- -- @ -- adjacencyList == Algebra.Graph.AdjacencyMap.'AM.adjacencyList' . 'toAdjacencyMap' -- @ adjacencyList :: Ord (ToVertex t) => t -> [(ToVertex t, [ToVertex t])] adjacencyList = AM.adjacencyList . toAdjacencyMap -- | The /adjacency map/ of a graph: each vertex is associated with a set -- of its /direct successors/. -- -- @ -- adjacencyMap == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMap' -- @ adjacencyMap :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t)) adjacencyMap = AM.adjacencyMap . toAdjacencyMap -- | The /adjacency map/ of a graph: each vertex is associated with a set -- of its /direct successors/. Like 'adjacencyMap' but specialised for -- graphs with vertices of type 'Int'. -- -- @ -- adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMap' -- @ adjacencyIntMap :: ToVertex t ~ Int => t -> IntMap IntSet adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap -- | The transposed /adjacency map/ of a graph: each vertex is associated -- with a set of its /direct predecessors/. -- -- @ -- adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMapTranspose' -- @ adjacencyMapTranspose :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t)) adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose -- | The transposed /adjacency map/ of a graph: each vertex is associated -- with a set of its /direct predecessors/. Like 'adjacencyMapTranspose' but -- specialised for graphs with vertices of type 'Int'. -- -- @ -- adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMapTranspose' -- @ adjacencyIntMapTranspose :: ToVertex t ~ Int => t -> IntMap IntSet adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose -- | Compute the /depth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. -- -- @ -- dfsForest == Algebra.Graph.AdjacencyMap.'AM.dfsForest' . toAdjacencyMap -- @ dfsForest :: Ord (ToVertex t) => t -> Forest (ToVertex t) dfsForest = AM.dfsForest . toAdjacencyMap -- | Compute the /depth-first search/ forest of a graph, searching from each -- of the given vertices in order. Note that the resulting forest does not -- necessarily span the whole graph, as some vertices may be unreachable. -- -- @ -- dfsForestFrom vs == Algebra.Graph.AdjacencyMap.'AM.dfsForestFrom' vs . toAdjacencyMap -- @ dfsForestFrom :: Ord (ToVertex t) => [ToVertex t] -> t -> Forest (ToVertex t) dfsForestFrom vs = AM.dfsForestFrom vs . toAdjacencyMap -- | Compute the list of vertices visited by the /depth-first search/ in a -- graph, when searching from each of the given vertices in order. -- -- @ -- dfs vs == Algebra.Graph.AdjacencyMap.'AM.dfs' vs . toAdjacencyMap -- @ dfs :: Ord (ToVertex t) => [ToVertex t] -> t -> [ToVertex t] dfs vs = AM.dfs vs . toAdjacencyMap -- | Compute the list of vertices that are /reachable/ from a given source -- vertex in a graph. The vertices in the resulting list appear in the -- /depth-first order/. -- -- @ -- reachable x == Algebra.Graph.AdjacencyMap.'AM.reachable' x . toAdjacencyMap -- @ reachable :: Ord (ToVertex t) => ToVertex t -> t -> [ToVertex t] reachable x = AM.reachable x . toAdjacencyMap -- | Compute the /topological sort/ of a graph or return @Nothing@ if the -- graph is cyclic. -- -- @ -- topSort == Algebra.Graph.AdjacencyMap.'AM.topSort' . toAdjacencyMap -- @ topSort :: Ord (ToVertex t) => t -> Maybe [ToVertex t] topSort = AM.topSort . toAdjacencyMap -- | Check if a given graph is /acyclic/. -- -- @ -- isAcyclic == Algebra.Graph.AdjacencyMap.'AM.isAcyclic' . toAdjacencyMap -- @ isAcyclic :: Ord (ToVertex t) => t -> Bool isAcyclic = AM.isAcyclic . toAdjacencyMap -- | Convert a value to the corresponding 'AM.AdjacencyMap'. -- -- @ -- toAdjacencyMap == 'foldg' 'AM.empty' 'AM.vertex' 'AM.overlay' 'AM.connect' -- @ toAdjacencyMap :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t) toAdjacencyMap = foldg AM.empty AM.vertex AM.overlay AM.connect -- | Convert a value to the corresponding 'AM.AdjacencyMap' and transpose the -- result. -- -- @ -- toAdjacencyMapTranspose == 'foldg' 'AM.empty' 'AM.vertex' 'AM.overlay' (flip 'AM.connect') -- @ toAdjacencyMapTranspose :: Ord (ToVertex t) => t -> AM.AdjacencyMap (ToVertex t) toAdjacencyMapTranspose = foldg AM.empty AM.vertex AM.overlay (flip AM.connect) -- | Convert a value to the corresponding 'AIM.AdjacencyIntMap'. -- -- @ -- toAdjacencyIntMap == 'foldg' 'AIM.empty' 'AIM.vertex' 'AIM.overlay' 'AIM.connect' -- @ toAdjacencyIntMap :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap toAdjacencyIntMap = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect -- | Convert a value to the corresponding 'AIM.AdjacencyIntMap' and transpose -- the result. -- -- @ -- toAdjacencyIntMapTranspose == 'foldg' 'AIM.empty' 'AIM.vertex' 'AIM.overlay' (flip 'AIM.connect') -- @ toAdjacencyIntMapTranspose :: ToVertex t ~ Int => t -> AIM.AdjacencyIntMap toAdjacencyIntMapTranspose = foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) -- | Check if a given forest is a valid /depth-first search/ forest of a -- graph. -- -- @ -- isDfsForestOf f == Algebra.Graph.AdjacencyMap.'AM.isDfsForestOf' f . toAdjacencyMap -- @ isDfsForestOf :: Ord (ToVertex t) => Forest (ToVertex t) -> t -> Bool isDfsForestOf f = AM.isDfsForestOf f . toAdjacencyMap -- | Check if a given list of vertices is a valid /topological sort/ of a -- graph. -- -- @ -- isTopSortOf vs == Algebra.Graph.AdjacencyMap.'AM.isTopSortOf' vs . 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 = AM.vertexIntSet 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 -- TODO: Get rid of "Relation.Internal" and move this instance to "Relation". 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 = R.vertexIntSet 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