{-# OPTIONS_HADDOCK hide #-}
module Data.GraphViz.Algorithms.Clustering
( NodeCluster(..)
, clustersToNodes
) where
import Data.GraphViz.Types.Canonical
import Data.GraphViz.Attributes.Complete(Attributes)
import Data.Either(partitionEithers)
import Data.List(groupBy, sortBy)
data NodeCluster c a = N a
| C c (NodeCluster c a)
deriving (Int -> NodeCluster c a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a. (Show a, Show c) => Int -> NodeCluster c a -> ShowS
forall c a. (Show a, Show c) => [NodeCluster c a] -> ShowS
forall c a. (Show a, Show c) => NodeCluster c a -> String
showList :: [NodeCluster c a] -> ShowS
$cshowList :: forall c a. (Show a, Show c) => [NodeCluster c a] -> ShowS
show :: NodeCluster c a -> String
$cshow :: forall c a. (Show a, Show c) => NodeCluster c a -> String
showsPrec :: Int -> NodeCluster c a -> ShowS
$cshowsPrec :: forall c a. (Show a, Show c) => Int -> NodeCluster c a -> ShowS
Show)
clustersToNodes :: (Ord c) => ((n,a) -> NodeCluster c (n,l))
-> (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
-> ((n,l) -> Attributes) -> [(n,a)]
-> ([DotSubGraph n], [DotNode n])
clustersToNodes :: forall c n a l.
Ord c =>
((n, a) -> NodeCluster c (n, l))
-> (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> [(n, a)]
-> ([DotSubGraph n], [DotNode n])
clustersToNodes (n, a) -> NodeCluster c (n, l)
clusterBy c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, l) -> Attributes
fmtNode
= forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, l) -> Attributes
fmtNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall c a. NodeCluster c a -> ClusterTree c a
clustToTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, a) -> NodeCluster c (n, l)
clusterBy)
data ClusterTree c a = NT a
| CT c [ClusterTree c a]
deriving (Int -> ClusterTree c a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a. (Show a, Show c) => Int -> ClusterTree c a -> ShowS
forall c a. (Show a, Show c) => [ClusterTree c a] -> ShowS
forall c a. (Show a, Show c) => ClusterTree c a -> String
showList :: [ClusterTree c a] -> ShowS
$cshowList :: forall c a. (Show a, Show c) => [ClusterTree c a] -> ShowS
show :: ClusterTree c a -> String
$cshow :: forall c a. (Show a, Show c) => ClusterTree c a -> String
showsPrec :: Int -> ClusterTree c a -> ShowS
$cshowsPrec :: forall c a. (Show a, Show c) => Int -> ClusterTree c a -> ShowS
Show)
clustToTree :: NodeCluster c a -> ClusterTree c a
clustToTree :: forall c a. NodeCluster c a -> ClusterTree c a
clustToTree (N a
ln) = forall c a. a -> ClusterTree c a
NT a
ln
clustToTree (C c
c NodeCluster c a
nc) = forall c a. c -> [ClusterTree c a] -> ClusterTree c a
CT c
c [forall c a. NodeCluster c a -> ClusterTree c a
clustToTree NodeCluster c a
nc]
sameClust :: (Eq c) => ClusterTree c a -> ClusterTree c a -> Bool
sameClust :: forall c a. Eq c => ClusterTree c a -> ClusterTree c a -> Bool
sameClust (NT a
_) (NT a
_) = Bool
True
sameClust (CT c
c1 [ClusterTree c a]
_) (CT c
c2 [ClusterTree c a]
_) = c
c1 forall a. Eq a => a -> a -> Bool
== c
c2
sameClust ClusterTree c a
_ ClusterTree c a
_ = Bool
False
clustOrder :: (Ord c) => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder :: forall c a. Ord c => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder (NT a
_) (NT a
_) = Ordering
EQ
clustOrder (NT a
_) (CT c
_ [ClusterTree c a]
_) = Ordering
LT
clustOrder (CT c
_ [ClusterTree c a]
_) (NT a
_) = Ordering
GT
clustOrder (CT c
c1 [ClusterTree c a]
_) (CT c
c2 [ClusterTree c a]
_) = forall a. Ord a => a -> a -> Ordering
compare c
c1 c
c2
getNodes :: ClusterTree c a -> [ClusterTree c a]
getNodes :: forall c a. ClusterTree c a -> [ClusterTree c a]
getNodes n :: ClusterTree c a
n@(NT a
_) = [ClusterTree c a
n]
getNodes (CT c
_ [ClusterTree c a]
ns) = [ClusterTree c a]
ns
collapseNClusts :: (Ord c) => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts :: forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
grpCls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall c a. Eq c => ClusterTree c a -> ClusterTree c a -> Bool
sameClust
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall c a. Ord c => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder
where
grpCls :: [ClusterTree c a] -> [ClusterTree c a]
grpCls [] = []
grpCls ns :: [ClusterTree c a]
ns@(NT a
_ : [ClusterTree c a]
_) = [ClusterTree c a]
ns
grpCls cs :: [ClusterTree c a]
cs@(CT c
c [ClusterTree c a]
_ : [ClusterTree c a]
_) = [forall c a. c -> [ClusterTree c a] -> ClusterTree c a
CT c
c (forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall c a. ClusterTree c a -> [ClusterTree c a]
getNodes [ClusterTree c a]
cs)]
treesToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
-> ((n,a) -> Attributes) -> [ClusterTree c (n,a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot :: forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode
= forall a b. [Either a b] -> ([a], [b])
partitionEithers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> ClusterTree c (n, a)
-> Either (DotSubGraph n) (DotNode n)
treeToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode)
treeToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
-> ((n,a) -> Attributes) -> ClusterTree c (n,a)
-> Either (DotSubGraph n) (DotNode n)
treeToDot :: forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> ClusterTree c (n, a)
-> Either (DotSubGraph n) (DotNode n)
treeToDot c -> Bool
_ c -> GraphID
_ c -> [GlobalAttributes]
_ (n, a) -> Attributes
fmtNode (NT (n, a)
ln)
= forall a b. b -> Either a b
Right DotNode { nodeID :: n
nodeID = forall a b. (a, b) -> a
fst (n, a)
ln
, nodeAttributes :: Attributes
nodeAttributes = (n, a) -> Attributes
fmtNode (n, a)
ln
}
treeToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode (CT c
c [ClusterTree c (n, a)]
nts)
= forall a b. a -> Either a b
Left DotSG { isCluster :: Bool
isCluster = c -> Bool
isC c
c
, subGraphID :: Maybe GraphID
subGraphID = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ c -> GraphID
cID c
c
, subGraphStmts :: DotStatements n
subGraphStmts = DotStatements n
stmts
}
where
stmts :: DotStatements n
stmts = DotStmts { attrStmts :: [GlobalAttributes]
attrStmts = c -> [GlobalAttributes]
fmtCluster c
c
, subGraphs :: [DotSubGraph n]
subGraphs = [DotSubGraph n]
cs
, nodeStmts :: [DotNode n]
nodeStmts = [DotNode n]
ns
, edgeStmts :: [DotEdge n]
edgeStmts = []
}
([DotSubGraph n]
cs, [DotNode n]
ns) = forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode [ClusterTree c (n, a)]
nts