module Data.Graph.Analysis
( version,
module Data.Graph.Analysis.Types,
module Data.Graph.Analysis.Utils,
module Data.Graph.Analysis.Algorithms,
module Data.Graph.Analysis.Visualisation,
module Data.Graph.Analysis.Reporting,
module Data.Graph.Inductive.Graph,
ImportParams(..),
importData,
lengthAnalysis,
classifyRoots,
inaccessibleNodes,
interiorChains,
collapseAndUpdate,
collapseAndUpdate',
levelGraphFromRoot
) where
import Data.Graph.Analysis.Internal
import Data.Graph.Analysis.Utils
import Data.Graph.Analysis.Types
import Data.Graph.Analysis.Algorithms
import Data.Graph.Analysis.Visualisation
import Data.Graph.Analysis.Reporting
import Data.Graph.Inductive.Graph
import Data.List(find)
import Data.Maybe(mapMaybe)
import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S
import Data.Set(Set)
import Control.Arrow(first)
import Data.Version(showVersion)
import qualified Paths_Graphalyze as Paths(version)
version :: String
version = showVersion Paths.version
data ImportParams n e = ImpParams {
dataPoints :: [n]
, relationships :: [Rel n e]
, roots :: [n]
, directed :: Bool
}
importData :: (Ord n, Ord e) => ImportParams n e -> GraphData n e
importData params = GraphData { graph = dGraph
, wantedRootNodes = rootNodes
, directedData = isDir
, unusedRelationships = unRs
}
where
isDir = directed params
lNodes = zip [1..] (dataPoints params)
(unRs, graphEdges) = relsToEs isDir lNodes (relationships params)
nodeMap = mkNodeMap lNodes
validNode l = M.lookup l nodeMap
rootNodes = if isDir
then mapMaybe validNode (roots params)
else []
dGraph = mkGraph lNodes graphEdges
lengthAnalysis :: [[a]] -> (Int,Int,[(Int,[a])])
lengthAnalysis as = (av,stdDev,as'')
where
as' = addLengths as
ls = map fst as'
(av,stdDev) = statistics' ls
as'' = filter (\(l,_) -> l > (av+stdDev)) as'
classifyRoots :: GraphData n e -> (Set Node, Set Node, Set Node)
classifyRoots gd = (areWanted, notRoots, notWanted)
where
wntd = S.fromList $ wantedRootNodes gd
rts = S.fromList $ applyAlg rootsOf' gd
areWanted = S.intersection wntd rts
notRoots = S.difference wntd rts
notWanted = S.difference rts wntd
inaccessibleNodes :: GraphData n e -> Set Node
inaccessibleNodes gd = allNs `S.difference` reachableNs
where
allNs = S.fromList $ applyAlg nodes gd
rs = S.fromList $ wantedRootNodes gd
reachableNs = applyAlg accessibleFrom' gd rs
interiorChains :: (Eq n, Eq e) => GraphData n e -> [LNGroup n]
interiorChains gd = filter (not . interiorRoot) chains
where
chains = applyAlg chainsIn gd
rts = wantedRoots gd
interiorRoot = any (`elem` rts) . tail
collapseAndUpdate :: (Ord n) => [AGr n e -> [(NGroup, n)]]
-> GraphData n e -> GraphData n e
collapseAndUpdate fs = fst . collapseAndUpdate' fs
collapseAndUpdate' :: (Ord n) => [AGr n e -> [(NGroup, n)]]
-> GraphData n e -> (GraphData n e, Map n n)
collapseAndUpdate' fs gd = (gd', repLookup)
where
gr = graph gd
(gr', reps) = collapseAndReplace' fs gr
lns' = mkNodeMap $ labNodes gr'
reps' = map (first S.fromList) reps
rs = S.fromList $ wantedRootNodes gd
replace r = maybe r ((M.!) lns' . snd)
$ find (S.member r . fst) reps'
gd' = gd { graph = gr'
, wantedRootNodes = S.toList $ S.map replace rs
, unusedRelationships = []
}
nlLookup = M.fromList $ labNodes gr
getLs = mapMaybe (flip M.lookup nlLookup)
repLookup = M.fromList . spreadOut $ map (first getLs) reps
levelGraphFromRoot :: (Ord n) => GraphData n e
-> GraphData (GenCluster n) e
levelGraphFromRoot gd = updateGraph (levelGraphFrom (wantedRootNodes gd)) gd