module Data.Graph.Analysis.Types
(
GraphData(..),
AGr,
Rel,
NGroup,
LNGroup,
wantedRoots,
addRoots,
addRootsBy,
applyAlg,
applyDirAlg,
mergeUnused,
removeUnused,
updateGraph,
updateGraph',
mapAllNodes,
mapNodeType,
ClusterLabel(..),
ClusterType(..),
GraphID(..),
GenCluster(..),
PosLabel(..)
) where
import Data.Graph.Analysis.Internal
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree
import Data.GraphViz.Types(GraphID(..))
import qualified Data.Set as S
import Data.Set(Set)
data GraphData n e = GraphData {
graph :: AGr n e,
wantedRootNodes :: NGroup,
directedData :: Bool,
unusedRelationships :: [Rel n e]
}
wantedRoots :: GraphData n e -> LNGroup n
wantedRoots gd = addLabels g rs'
where
g = graph gd
gns = S.fromList $ nodes g
rs = S.fromList $ wantedRootNodes gd
rs' = S.toList $ gns `S.intersection` rs
addRoots :: GraphData n e -> NGroup -> GraphData n e
addRoots gd ns = gd { wantedRootNodes = S.toList rs' }
where
ns' = S.fromList ns
rs = S.fromList $ wantedRootNodes gd
rs' = rs `S.union` ns'
addRootsBy :: (LNode n -> Bool) -> GraphData n e -> GraphData n e
addRootsBy p gd = addRoots gd rs'
where
p' _ = p
rs' = map node $ applyAlg (filterNodes p') gd
applyAlg :: (AGr n e -> a) -> GraphData n e -> a
applyAlg f = f . graph
applyDirAlg :: (Bool -> AGr n e -> a) -> GraphData n e -> a
applyDirAlg f g = f (directedData g) (graph g)
mapAllNodes :: (Ord a, Ord e, Ord b) => (a -> b)
-> GraphData a e -> GraphData b e
mapAllNodes f gd = gd { graph = nmap f $ graph gd
, unusedRelationships = map (applyNodes f)
$ unusedRelationships gd
}
mapNodeType :: (Ord a, Ord b, Ord e) => (a -> b) -> (a -> b)
-> GraphData a e -> GraphData b e
mapNodeType fk fu gd = gd { graph = nmap fk $ graph gd
, unusedRelationships = map (applyNodes f)
$ unusedRelationships gd
}
where
knownNs = knownNodes gd
f n = if S.member n knownNs
then fk n
else fu n
mergeUnused :: (Ord n, Ord e) => GraphData n e -> GraphData n e
mergeUnused gd = gd { graph = insEdges es' gr'
, unusedRelationships = []
}
where
gr = graph gd
unRs = unusedRelationships gd
mkS f = S.fromList $ map f unRs
unNs = S.toList
. flip S.difference (knownNodes gd)
$ S.union (mkS fromNode) (mkS toNode)
ns' = newNodes (length unNs) gr
gr' = flip insNodes gr $ zip ns' unNs
es' = snd $ relsToEs (directedData gd)
(labNodes gr)
unRs
knownNodes :: (Ord n) => GraphData n e -> Set n
knownNodes = S.fromList . map snd . labNodes . graph
removeUnused :: GraphData n e -> GraphData n e
removeUnused g = g { unusedRelationships = [] }
updateGraph :: (AGr a b -> AGr c d)
-> GraphData a b -> GraphData c d
updateGraph f g = g { graph = applyAlg f g
, unusedRelationships = []
}
updateGraph' :: (Bool -> AGr a b -> AGr c d)
-> GraphData a b -> GraphData c d
updateGraph' f g = g { graph = applyDirAlg f g
, unusedRelationships = []
}
type AGr n e = Gr n e
type NGroup = [Node]
type LNGroup a = [LNode a]
class (ClusterType (Cluster cl)) => ClusterLabel cl where
type Cluster cl
type NodeLabel cl
cluster :: cl -> Cluster cl
nodeLabel :: cl -> NodeLabel cl
class (Ord c) => ClusterType c where
clustID :: c -> Maybe GraphID
clustID = const Nothing
instance ClusterType Int where
clustID = Just . Int
instance ClusterType String where
clustID = Just . Str
data GenCluster a = GC { clust :: Int
, nLbl :: a
}
deriving (Eq,Show)
instance ClusterLabel (GenCluster a) where
type Cluster (GenCluster a) = Int
type NodeLabel (GenCluster a) = a
cluster = clust
nodeLabel = nLbl
data PosLabel a = PLabel { xPos :: Int
, yPos :: Int
, pnode :: Node
, plabel :: a
}
deriving (Eq, Show)