Graphalyze (empty) → 0.1
raw patch · 11 files changed
+1524/−0 lines, 11 filesdep +basedep +bktreesdep +containerssetup-changed
Dependencies added: base, bktrees, containers, fgl, graphviz, random
Files
- Data/Graph/Analysis.hs +98/−0
- Data/Graph/Analysis/Algorithms.hs +35/−0
- Data/Graph/Analysis/Algorithms/Clustering.hs +365/−0
- Data/Graph/Analysis/Algorithms/Common.hs +288/−0
- Data/Graph/Analysis/Algorithms/Directed.hs +160/−0
- Data/Graph/Analysis/Types.hs +86/−0
- Data/Graph/Analysis/Utils.hs +394/−0
- Data/Graph/Analysis/Visualisation.hs +38/−0
- Graphalyze.cabal +34/−0
- LICENSE +23/−0
- Setup.lhs +3/−0
+ Data/Graph/Analysis.hs view
@@ -0,0 +1,98 @@+{- |+ Module : Data.Graph.Analysis+ Description : A Graph-Theoretic Analysis Library.+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ This is the root module of the /Graphalyze/ library, which aims to+ provide a way of analysing the relationships inherent in discrete+ data as a graph.++ This was written as part of my mathematics honours thesis,+ /Graph-Theoretic Analysis of the Relationships in Discrete Data/.+ -}+module Data.Graph.Analysis+ ( -- * Re-exporting other modules+ module Data.Graph.Analysis.Types,+ module Data.Graph.Analysis.Utils,+ module Data.Graph.Analysis.Algorithms,+ module Data.Graph.Inductive.Graph,+ -- * Importing data+ ImportParams(..),+ defaultParams,+ importData+ ) where++import Data.Graph.Analysis.Utils+import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Algorithms++import Data.Graph.Inductive.Graph+import Data.List+import Data.Maybe+import qualified Data.Map as M++-- -----------------------------------------------------------------------------++{- |+ This represents the information that's being passed in that we want+ to analyse. If the graph is undirected, it is better to list each+ edge once rather than both directions.+ -}+data ImportParams a = Params { -- | The discrete points.+ dataPoints :: [a],+ -- | The relationships between the points.+ relationships :: [(a,a)],+ -- | The expected roots of the graph.+ -- If @'directed' = 'False'@, then this is ignored.+ roots :: [a],+ -- | 'False' if relationships are symmetric+ -- (i.e. an undirected graph).+ directed :: Bool+ }++-- | Default values for 'ImportParams', with no roots and a directed graph.+defaultParams :: ImportParams a+defaultParams = Params { dataPoints = [],+ relationships = [],+ roots = [],+ directed = True+ }++{- |+ Import data into a format suitable for analysis. This function is+ /edge-safe/: if any datums are listed in the edges of+ 'ImportParams' that aren't listed in the data points, then those+ edges are ignored. Thus, no sanitation of the 'relationships' in+ @ImportParams@ is necessary.+ -}+importData :: (Ord a) => ImportParams a -> GraphData a+importData params = GraphData { graph = dGraph, wantedRoots = rootNodes }+ where+ -- Adding Node values to each of the data points.+ lNodes = zip [1..] (dataPoints params)+ -- Creating a lookup map from the label to the @Node@ value.+ nodeMap = M.fromList $ map (uncurry (flip (,))) lNodes+ -- Find the Node value for the given data point.+ findNode n = M.lookup n nodeMap+ -- Validate a edge after looking its values up.+ validEdge (v1,v2) = case (findNode v1, findNode v2) of+ (Just x, Just y) -> Just $ addLabel (x,y)+ _ -> Nothing+ -- Add an empty edge label.+ addLabel (x,y) = (x,y,())+ -- The valid edges in the graph.+ graphEdges = catMaybes $ map validEdge (relationships params)+ -- Validate an edge+ validNode l = case (findNode l) of+ (Just n) -> Just (n,l)+ _ -> Nothing+ -- Construct the root nodes+ rootNodes = if (directed params)+ then catMaybes $ map validNode (roots params)+ else []+ -- Make the graph undirected if necessary.+ setDirection = if (directed params) then id else undir+ -- Construct the graph.+ dGraph = setDirection $ mkGraph lNodes graphEdges
+ Data/Graph/Analysis/Algorithms.hs view
@@ -0,0 +1,35 @@+{- |+ Module : Data.Graph.Analysis.Algorithms+ Description : Graph analysis algorithms+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ This module exports all the algorithms found in the+ @Data.Graph.Analysis.Algorithms.*@ modules.+ -}+module Data.Graph.Analysis.Algorithms+ ( -- * Graph Algorithms+ -- $algorithms+ module Data.Graph.Analysis.Algorithms.Common,+ module Data.Graph.Analysis.Algorithms.Directed,+ module Data.Graph.Analysis.Algorithms.Clustering,+ applyAlg+ ) where++import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Algorithms.Common+import Data.Graph.Analysis.Algorithms.Directed+import Data.Graph.Analysis.Algorithms.Clustering++{- $algorithms+ For algorithms that return a group of nodes, there are typically+ two different forms: the standard form (e.g. 'cliquesIn') will+ return a list of @LNode@s, whilst the primed version+ (e.g. `cliquesIn'') will return a list of @Node@s.+ -}++-- | Apply an algorithm to the data to be analysed.+applyAlg :: (AGr a -> b) -> GraphData a -> b+applyAlg f = f . graph+
+ Data/Graph/Analysis/Algorithms/Clustering.hs view
@@ -0,0 +1,365 @@+{-# LANGUAGE MultiParamTypeClasses #-}++{- |+ Module : Data.Graph.Analysis.Algorithms.Clustering+ Description : Clustering and grouping algorithms.+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ Clustering and grouping algorithms that are graph-invariant and require+ no user intervention.+ -}+module Data.Graph.Analysis.Algorithms.Clustering+ ( -- * Clustering Algorithms+ -- ** Non-deterministic algorithms+ -- $chinesewhispers+ Whispering,+ chineseWhispers,+ -- ** Spatial Algorithms+ -- $relneighbours+ relativeNeighbourhood,+ -- * Graph Collapsing+ -- $collapsing+ CNodes(..),+ collapseGraph+ ) where++import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Utils+import Data.Graph.Analysis.Algorithms.Common+import Data.Graph.Analysis.Algorithms.Directed(rootsOf')++import Data.Graph.Inductive.Graph++import Data.List+import Data.Maybe+import Data.Function+import qualified Data.Set as Set+import qualified Data.Set.BKTree as BK+import Data.Set.BKTree(BKTree, Metric(..))+import Control.Arrow+import System.Random++-- -----------------------------------------------------------------------------++{- $chinesewhispers+ The Chinese Whispering Algorithm.+ This is an adaptation of the algorithm described in:++ Biemann, C. (2006): Chinese Whispers - an Efficient Graph Clustering+ Algorithm and its Application to Natural Language Processing Problems.+ Proceedings of the HLT-NAACL-06 Workshops on Textgraphs-06, New York, USA+ <http://wortschatz.uni-leipzig.de/~cbiemann/pub/2006/BiemannTextGraph06.pdf>++ The adaptations to this algorithm are as follows:++ * Ignore any edge weightings that may exist, as we can't depend on them+ (also, we want the algorithm to be dependent solely upon the+ /structure/ of the graph, not what it contains).++ * Increase the weighting of those nodes present in interesting structures,+ such as loops and root nodes. This is to try and ensure that these nodes+ end up in the same cluster.+++ Simplistically, the way it works is this:++ 1. Every node is assigned into its own unique cluster.++ 2. For each iteration, sort the nodes into each order. For each node,+ it joins the most popular cluster in its neighbourhood+ (where popularity is defined by the sum of the weightings).++ 3. Repeat step 2. until a fixed point is reached.++ Note that this algorithm is non-deterministic, and that for some graphs+ no fixed point may be reached (and the algorithm may oscillate between+ a few different graph clusterings).+-}++-- | An instance of 'ClusterLabel' used for the Chinese Whispers algorithm.+data Whispering a = W { name :: a -- ^ The original label.+ , whisp :: Int -- ^ The current cluster this node is in.+ , coeff :: Double -- ^ The node's weighting.+ } deriving (Show,Eq)++instance (Show a) => ClusterLabel (Whispering a) Int where+ cluster = whisp+ nodelabel = show . name++-- | The actual Chinese Whispers algorithm.+chineseWhispers :: (RandomGen g, Eq a, Eq b, DynGraph gr) => g -> gr a b+ -> gr (Whispering a) b+chineseWhispers g gr = fst $ fixPointBy eq whispering (gr',g)+ where+ eq = equal `on` fst+ ns = nodes gr+ whispering (gr'',g') = foldl' whisperNode (gr'',g'') ns'+ where+ -- Shuffle the nodes to ensure the order of choosing a new+ -- cluster is random.+ (ns',g'') = shuffle g' ns+ gr' = addWhispers gr++-- | Choose a new cluster for the given 'Node'. Note that this updates+-- the graph each time a new cluster value is chosen.+whisperNode :: (RandomGen g, DynGraph gr) => (gr (Whispering a) b,g)+ -> Node -> (gr (Whispering a) b,g)+whisperNode (gr,g) n = (c' & gr',g')+ where+ (Just c,gr') = match n gr+ (g',c') = whisper gr g c++-- | Choose a new cluster for the given @Context@.+whisper :: (RandomGen g, Graph gr) => gr (Whispering a) b -> g+ -> Context (Whispering a) b -> (g,Context (Whispering a) b)+whisper gr g (p,n,al,s) = (g',(p,n,al {whisp = w'},s))+ where+ (w',g') = case (neighbors gr n) of+ [] -> (whisp al,g)+ -- Add this current node to the list of neighbours to add+ -- extra weighting, as it seems to give better results.+ ns -> chooseWhisper g (addLabels gr (n:ns))++-- | Choose which cluster to pick by taking the one with maximum sum of+-- weightings. If more than one has the same maximum, choose one+-- randomly.+chooseWhisper :: (RandomGen g) => g -> [LNode (Whispering a)]+ -> (Int,g)+chooseWhisper g lns = pick maxWspWgts+ where+ -- This isn't the most efficient method of choosing a random list element,+ -- but the graph is assumed to be relatively sparse and thus ns should+ -- be relatively short.+ pick ns = first (ns!!) $ randomR (0,length ns - 1) g+ whispWgts = map (second sumWgts) . groupElems whisp $ map label lns+ maxWspWgts = map fst . snd . head $ groupElems (negate . snd) whispWgts+ sumWgts = sum . map coeff++-- | Convert the graph into a form suitable for the Chinese Whispers algorithm.+addWhispers :: (DynGraph gr) => gr a b -> gr (Whispering a) b+addWhispers g = gmap augment g+ where+ augment (p,n,l,s) = (p,n,W { name = l+ , whisp = n+ , coeff = coefFor n+ },s)+ -- Note that cliques are also cycles...+ -- cliques = Set.fromList . concat $ cliquesIn' g+ cycles = Set.fromList . concat $ cyclesIn' g+ roots = Set.fromList $ rootsOf' g+ -- Give more emphasis to interesting parts of the graph.+ coefFor n+ | Set.member n roots = 3+ | Set.member n cycles = 2+ | otherwise = 1+++{-++Originally used for the clustering coefficient, didn't seem to give good+results.+http://en.wikipedia.org/wiki/Clustering_coefficient++clusteringCoef :: (Graph gr) => gr a b -> Node -> Double+clusteringCoef g n = if (liftM2 (||) isNaN isInfinite $ coef)+ then 0+ else coef+ where+ d = fromIntegral $ deg g n+ coef = (fromIntegral nes) / (k*(k - 1))+ ns = (neighbors g n)+ k = fromIntegral $ length ns+ nes = length $ concatMap (union ns . neighbors g) ns+-}++-- -----------------------------------------------------------------------------++{- $relneighbours+ This implements the algorithm called CLUSTER, from the paper:++ Bandyopadhyay, S. (2003): An automatic shape independent clustering+ technique. Pattern Recognition, vol. 37, pp. 33-45.++ Simplistically, it defines clusters as groups of nodes that are+ spatially located closer to each other than to nodes in+ other clusters. It utilises the concept of a /Relative+ Neighbour Graph/ [RNG] to determine the spatial structure of a set+ of two-dimensional data points.++ The adaptations to this algorithm are as follows:++ * Due to the limitations of the BKTree data structure, we utilise a+ /fuzzy/ distance function defined as the ceiling of the standard+ Euclidian distance.++ * We utilise 'toPosGraph' to get the spatial locations. As such,+ these locations may not be optimal, especially for smaller+ graphs.++ * The actual algorithm is applied to each connected component of+ the graph. The actual paper is unclear what to do in this+ scenario, but Graphviz may locate nodes from separate+ components together, despite them not being related.+++ The algorithm is renamed 'relativeNeighbourhood'. Experimentally, it+ seems to work better with larger graphs (i.e. more nodes), since+ then Graphviz makes the apparent clusters more obvious.+-}++-- | The renamed CLUSTER algorithm. Attempts to cluster a graph by using+-- the spatial locations used by Graphviz.+relativeNeighbourhood :: (DynGraph gr, Eq a, Ord b) => gr a b+ -> gr (GenCluster a) b+relativeNeighbourhood g = setCluster cMap g+ where+ cMap = createLookup . concatMap rn $ componentsOf g+ rn g' = nbrCluster rng+ where+ rng :: Gr () Int+ rng = makeRNG $ getPositions g'++-- | We take the ceiling of the Euclidian distance function to use as our+-- metric function.+instance (Eq a) => Metric (PosLabel a) where+ distance = (ceiling . ) . euclidian+-- Note that this throws an orphan instance warning.++-- | The Euclidian distance function.+euclidian :: PosLabel a -> PosLabel a -> Double+euclidian n1 n2 = sqrt . fI $ (posBy xPos) + (posBy yPos)+ where+ posBy p = sq $ (p n1) - (p n2)++-- | Converts the positional labels into an RNG.+makeRNG :: (Eq a, Graph gr) => [PosLabel a] -> gr () Int+makeRNG ls = mkGraph ns es+ where+ ns = map (\l -> (pnode l,())) ls+ tree = BK.fromList ls+ tls = tails ls+ es = [ (pnode l1,pnode l2,distance l1 l2)+ | (l1:ls') <- tls+ , l2 <- ls'+ , areRelative tree l1 l2 ]++-- | Determines if the two given nodes should be connected in the RNG.+-- Nodes are connected if there is no node that is closer to both of them.+areRelative :: (Metric a) => BKTree a -> a -> a -> Bool+areRelative t l1 l2 = null lune+ where+ d = distance l1 l2+ -- Find all nodes distance <= d away from the given node.+ -- Note that n is distance 0 <= d away from n, so we need to+ -- remove it from the list of results.+ rgnFor l = delete l $ BK.elemsDistance d l t+ -- The nodes that are between the two given nodes.+ lune = intersect (rgnFor l1) (rgnFor l2)++-- | Performs the actual clustering algorithm on the RNG.+nbrCluster :: (DynGraph gr) => gr a Int -> [[Node]]+nbrCluster g+ | numNodes == 1 = [ns] -- Can't split up a single node.+ | eMax < 2*eMin = [ns] -- The inter-cluster relative neighbours+ -- are too close too each other.+ | null thrs = [ns] -- No threshold value available.+ | single cg' = [ns] -- No edges meet the threshold deletion+ -- criteria.+ | nCgs > sNum = [ns] -- Over-fragmentation of the graph.+ | otherwise = concatMap nbrCluster cg'+ where+ ns = nodes g+ numNodes = noNodes g+ sNum = floor (sqrt $ fI numNodes :: Double)+ les = labEdges g+ (es,eMin,eMax) = sortMinMax $ map eLabel les+ es' = zip es (tail es)+ sub = uncurry subtract+ -- First order differences.+ -- We don't care about the list, just what the min and max diffs are.+ (_,dfMin,dfMax) = sortMinMax $ map sub es'+ -- We are going to do >= tests on t, but using Int values, so+ -- take the ceiling.+ t = ceiling $ (((fI dfMin) + (fI dfMax))/2 :: Double)+ -- Edges that meet the threshold criteria.+ thrs = filter (\ejs@(ej,_) -> (ej >= 2*eMin) && (sub ejs >= t)) es'+ -- Take the first edges that meets the threshold criteria.+ thresh = fst $ head thrs+ -- Edges that meet the threshold deletion criteria.+ rEs = map edge $ filter ((>= thresh) . eLabel) les+ g' = delEdges rEs g+ -- Each of these will also be an RNG+ cg' = componentsOf g'+ nCgs = length cg'++-- -----------------------------------------------------------------------------++{- $collapsing+ Collapse the /interesting/ parts of a graph down to try and show a+ compressed overview of the whole graph. Note that this doesn't+ work too well on undirected graphs, since every pair of nodes forms+ a K_2 subgraph.++ It may be possible to extend this to a clustering algorithm by+ collapsing low density regions into high density regions.+ -}++-- | A collapsed node contains a list of nodes that it represents.+data CNodes a = CN [LNode a]++-- | This definition of 'show' is written so as to make the shapes of the+-- nodes in Graphviz roughly circular, rather than one long ellipse.+instance (Show a) => Show (CNodes a) where+ -- Print the labels in a roughly square shape.+ show (CN lns) = blockPrint $ map label lns++collapseGraph :: (DynGraph gr, Eq b) => gr a b -> gr (CNodes a) b+collapseGraph g = foldl' (flip collapseAllBy) cg interestingParts+ where+ cg = makeCollapsible g+ interestingParts = [cliquesIn', cyclesIn', chainsIn']++-- | Allow the graph to be collapsed.+makeCollapsible :: (DynGraph gr) => gr a b -> gr (CNodes a) b+makeCollapsible = nlmap (CN . return)++-- | Collapse the two given nodes into one node.+collapse :: (DynGraph gr) => gr (CNodes a) b -> Node -> Node+ -> gr (CNodes a) b+collapse g n1 n2 = if (n1 == n2)+ then g+ else c' & g''+ where+ (Just c1, g') = match n1 g+ (Just c2, g'') = match n2 g'+ -- The new edges.+ nbrBy f = map (\(a,b) -> (b,a))+ -- not sure if this should be included: . nub+ . filter (\(n,_) -> notElem n [n1,n2])+ $ (f c1 ++ f c2)+ p = nbrBy lpre'+ s = nbrBy lsuc'+ (CN l1) = lab' c1+ (CN l2) = lab' c2+ c' = (p,n1,CN (l1++l2),s)++-- | Collapse the list of nodes down to one node.+collapseAll :: (DynGraph gr) => gr (CNodes a) b -> [Node]+ -> gr (CNodes a) b+collapseAll g [] = g+collapseAll g [_] = g+collapseAll g (n:ns) = foldl' collapser g ns+ where+ collapser g' = collapse g' n++-- | Collapse all results of the given function.+collapseAllBy :: (DynGraph gr) => (gr (CNodes a) b -> [[Node]])+ -> gr (CNodes a) b -> gr (CNodes a) b+collapseAllBy f g = case (filter (not . single) $ f g) of+ [] -> g+ -- We re-evaluate the function in case+ -- the original results used nodes that+ -- have been collapsed down.+ (ns:_) -> collapseAllBy f (collapseAll g ns)
+ Data/Graph/Analysis/Algorithms/Common.hs view
@@ -0,0 +1,288 @@+{- |+ Module : Data.Graph.Analysis.Algorithms.Common+ Description : Algorithms for all graph types.+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ Defines algorithms that work on both undirected and+ directed graphs.+ -}+module Data.Graph.Analysis.Algorithms.Common+ ( -- * Graph decomposition+ -- $connected+ componentsOf,+ pathTree,+ -- * Clique Detection+ -- $cliques+ cliquesIn,+ cliquesIn',+ findRegular,+ isRegular,+ -- * Cycle Detection+ -- $cycles+ cyclesIn,+ cyclesIn',+ uniqueCycles,+ uniqueCycles',+ -- * Chain detection+ -- $chains+ chainsIn,+ chainsIn'+ ) where++import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Utils++import Data.Graph.Inductive.Graph+-- For linking purposes. This will throw a warning.+import Data.Graph.Inductive.Query.DFS(components)+import Data.List+import Data.Maybe+import Control.Arrow++-- -----------------------------------------------------------------------------++{- $connected+ Finding connected components.++ Whilst the FGL library does indeed have a function 'components'+ that returns the connected components of a graph, it returns each+ component as a list of 'Node's. This implementation instead+ returns each component as a /graph/, which is much more useful.++ Connected components are found by choosing a random node, then+ recursively extracting all neighbours of that node until no more+ nodes can be removed.++ Note that for directed graphs, these are known as the /weakly/+ connected components.+-}++-- | Find all connected components of a graph.+componentsOf :: (DynGraph g) => g a b -> [g a b]+componentsOf = unfoldr splitComponent++-- | Find the next component and split it off from the graph.+splitComponent :: (DynGraph g) => g a b -> Maybe (g a b, g a b)+splitComponent g+ | isEmpty g = Nothing+ | otherwise = Just . -- Get the type right+ first buildGr . -- Create the subgraph+ extractNode . -- Extract components of subgraph+ first Just . -- Getting the types right+ matchAny $ g -- Choose an arbitrary node to begin with++-- | Extract the given node and all nodes it is transitively+-- connected to from the graph.+extractNode :: (DynGraph g) => Decomp g a b -> ([Context a b], g a b)+extractNode (Nothing,gr) = ([],gr)+extractNode (Just ctxt, gr)+ | isEmpty gr = ([ctxt], empty)+ | otherwise = first (ctxt:) $ foldl' nodeExtractor ([],gr) nbrs+ where+ nbrs = neighbors' ctxt++-- | Helper function for 'extractNode' above.+nodeExtractor :: (DynGraph g) => ([Context a b], g a b) -> Node+ -> ([Context a b], g a b)+nodeExtractor cg@(cs,g) n+ | gelem n g = first (++ cs) . extractNode $ match n g+ | otherwise = cg++-- -----------------------------------------------------------------------------++-- | Find all possible paths from this given node, avoiding loops,+-- cycles, etc.+pathTree :: (DynGraph g) => Decomp g a b -> [NGroup]+pathTree (Nothing,_) = []+pathTree (Just ct,g)+ | isEmpty g = []+ | null sucs = [[n]]+ | otherwise = (:) [n] . map (n:) . concatMap (subPathTree g') $ sucs+ where+ n = node' ct+ sucs = suc' ct+ -- Avoid infinite loops by not letting it continue any further+ ct' = makeLeaf ct+ g' = ct' & g+ subPathTree gr n' = pathTree $ match n' gr++-- | Remove all outgoing edges+makeLeaf :: Context a b -> Context a b+makeLeaf (p,n,a,_) = (p', n, a, [])+ where+ -- Ensure there isn't an edge (n,n)+ p' = filter (\(_,n') -> n' /= n) p++-- -----------------------------------------------------------------------------+{- $cliques+ Clique detection routines. Find cliques by taking out a node, and+ seeing which other nodes are all common neighbours (by both 'pre'+ and 'suc').+ -}++-- | Finds all cliques (i.e. maximal complete subgraphs) in the given graph.+cliquesIn :: (Graph g) => g a b -> [[LNode a]]+cliquesIn gr = map (addLabels gr) (cliquesIn' gr)++-- | Finds all cliques in the graph, without including labels.+cliquesIn' :: (Graph g) => g a b -> [NGroup]+cliquesIn' gr = filter (isClique gr) (findRegular gr)++-- | Determine if the given list of nodes is indeed a clique,+-- and not a smaller subgraph of a clique.+isClique :: (Graph g) => g a b -> NGroup -> Bool+isClique _ [] = False+isClique gr ns = null .+ foldl1' intersect .+ map ((\\ ns) . corecursive gr) $ ns++-- | Find all regular subgraphs of the given graph.+findRegular :: (Graph g) => g a b -> [[Node]]+findRegular = concat . unfoldr findRegularOf++-- | Extract the next regular subgraph of a graph.+findRegularOf :: (Graph g) => g a b -> Maybe ([[Node]], g a b)+findRegularOf g+ | isEmpty g = Nothing+ | otherwise = Just .+ first (regularOf g . node') .+ matchAny $ g++-- | Returns all regular subgraphs that include the given node.+regularOf :: (Graph g) => g a b -> Node -> [[Node]]+regularOf gr n = map (n:) (alsoRegular gr crs)+ where+ crs = corecursive gr n++-- | Recursively find all regular subgraphs only containing nodes+-- in the given list.+alsoRegular :: (Graph g) => g a b -> [Node] -> [[Node]]+alsoRegular _ [] = []+alsoRegular _ [n] = [[n]]+alsoRegular g (n:ns) = [n] : rs ++ (alsoRegular g ns)+ where+ rs = map (n:) (alsoRegular g $ intersect crn ns)+ crn = corecursive g n++-- | Return all nodes that are co-recursive with the given node+-- (i.e. for n, find all n' such that n->n' and n'->n).+corecursive :: (Graph g) => g a b -> Node -> [Node]+corecursive gr n = filter (elem n . suc gr) (delete n $ suc gr n)++-- | Determines if the list of nodes represents a regular subgraph.+isRegular :: (Graph g) => g a b -> NGroup -> Bool+isRegular g ns = all allCorecursive split+ where+ -- Node + Rest of list+ split = zip ns tns'+ tns' = tail $ tails ns+ allCorecursive (n,rs) = null $ rs \\ (corecursive g n)++-- -----------------------------------------------------------------------------+{- $cycles+ Cycle detection. Find cycles by finding all paths from a given+ node, and seeing if it reaches itself again.+ -}++-- | Find all cycles in the given graph.+cyclesIn :: (DynGraph g) => g a b -> [LNGroup a]+cyclesIn g = map (addLabels g) (cyclesIn' g)++-- | Find all cycles in the given graph, returning just the nodes.+cyclesIn' :: (DynGraph g) => g a b -> [NGroup]+cyclesIn' = filter (not . single) -- Exclude trivial cycles, i.e. loops+ . concat . unfoldr findCycles++-- | Find all cycles in the given graph, excluding those that are also cliques.+uniqueCycles :: (DynGraph g) => g a b -> [LNGroup a]+uniqueCycles g = map (addLabels g) (uniqueCycles' g)++-- | Find all cycles in the given graph, excluding those that are also cliques.+uniqueCycles' :: (DynGraph g) => g a b -> [NGroup]+uniqueCycles' g = filter (not . isRegular g) (cyclesIn' g)++-- | Find all cycles containing a chosen node.+findCycles :: (DynGraph g) => g a b -> Maybe ([NGroup], g a b)+findCycles g+ | isEmpty g = Nothing+ | otherwise = Just . getCycles . matchAny $ g+ where+ getCycles (ctx,g') = (cyclesFor (ctx, g'), g')++-- | Find all cycles for the given node.+cyclesFor :: (DynGraph g) => GDecomp g a b -> [NGroup]+cyclesFor = map init .+ filter isCycle .+ pathTree .+ first Just+ where+ isCycle p = (not $ single p) && ((head p) == (last p))++-- -----------------------------------------------------------------------------++{- $chains+ A chain is a path in a graph where for each interior node, there is+ exactly one predecessor and one successor node, i.e. that part of+ the graph forms a \"straight line\". Furthermore, the initial node+ should have only one successor, and the final node should have only+ one predecessor. Chains are found by recursively finding the next+ successor in the chain, until either a leaf node is reached or no+ more nodes match the criteria.+-}++-- | Find all chains in the given graph.+chainsIn :: (DynGraph g, Eq b) => g a b -> [LNGroup a]+chainsIn g = map (addLabels g)+ $ chainsIn' g++-- | Find all chains in the given graph.+chainsIn' :: (DynGraph g, Eq b) => g a b -> [NGroup]+chainsIn' g = filter (not . single) -- Remove trivial chains+ . map (getChain g')+ $ filterNodes' isChainStart g'+ where+ -- Try to make this work on two-element cycles, undirected+ -- graphs, etc.+ g' = oneWay g++-- | Find the chain starting with the given 'Node'.+getChain :: (Graph g) => g a b -> Node -> NGroup+getChain g n = n : (unfoldr (chainLink g) (chainNext g n))++-- | Find the next link in the chain.+chainLink :: (Graph g) => g a b -> Maybe Node+ -> Maybe (Node, Maybe Node)+chainLink _ Nothing = Nothing+chainLink g (Just n)+ | isEmpty g = Nothing+ | not $ hasPrev g n = Nothing+ | otherwise = Just (n, chainNext g n)++-- | Determines if the given node is the start of a chain.+isChainStart :: (Graph g) => g a b -> Node -> Bool+isChainStart g n = (hasNext g n)+ && case (pre g n \\ [n]) of+ [n'] -> not $ isChainStart g n'+ _ -> True++-- | Determine if the given node matches the chain criteria in the given+-- direction, and if so what the next node in that direction is.+chainFind :: (Graph g) => (g a b -> Node -> NGroup)+ -> g a b -> Node -> Maybe Node+chainFind f g n = case ((nub $ f g n) \\ [n]) of+ [n'] -> Just n'+ _ -> Nothing++-- | Find the next node in the chain.+chainNext :: (Graph g) => g a b -> Node -> Maybe Node+chainNext = chainFind suc++-- | Determines if this node matches the successor criteria for chains.+hasNext :: (Graph g) => g a b -> Node -> Bool+hasNext g = isJust . chainNext g++-- | Determines if this node matches the predecessor criteria for chains.+hasPrev :: (Graph g) => g a b -> Node -> Bool+hasPrev g = isJust . chainFind pre g
+ Data/Graph/Analysis/Algorithms/Directed.hs view
@@ -0,0 +1,160 @@+{- |+ Module : Data.Graph.Analysis.Algorithms.Directed+ Description : Algorithms for directed graphs.+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ Defines algorithms that work on both directed graphs.+ -}+module Data.Graph.Analysis.Algorithms.Directed+ ( -- * Ending nodes+ -- $ends+ endNode, endNode',+ endBy, endBy',+ -- ** Root nodes+ rootsOf, rootsOf',+ isRoot, isRoot',+ -- ** Leaf nodes+ leavesOf, leavesOf',+ isLeaf, isLeaf',+ -- ** Singleton nodes+ singletonsOf, singletonsOf',+ isSingleton, isSingleton',+ -- * Subgraphs+ coreOf,+ ) where++import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Utils+import Data.Graph.Analysis.Algorithms.Common++import Data.Graph.Inductive.Graph++-- -----------------------------------------------------------------------------+{- $ends+ Find starting/ending nodes.++ We define an ending node as one where, given a function:++ @+ f :: (Graph g) => g a b -> Node -> [Node]+ @++ the only allowed result is that node itself (to allow for loops).+ -}++-- | Determine if this 'LNode' is an ending node.+endNode :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> LNode a -> Bool+endNode f g ln = endNode' f g (node ln)++-- | Determine if this 'Node' is an ending node.+endNode' :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> Node+ -> Bool+endNode' f g n = case (f g n) of+ [] -> True+ -- Allow loops+ [n'] -> n' == n+ _ -> False++-- | Find all 'LNode's that meet the ending criteria.+endBy :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> LNGroup a+endBy f = filterNodes (endNode f)++-- | Find all 'Node's that match the ending criteria.+endBy' :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> NGroup+endBy' f = filterNodes' (endNode' f)++-- -----------------------------------------------------------------------------++{-+ Root detection.+ -}++-- | Find all roots of the graph.+rootsOf :: (Graph g) => g a b -> LNGroup a+rootsOf = endBy pre++-- | Find all roots of the graph.+rootsOf' :: (Graph g) => g a b -> NGroup+rootsOf' = endBy' pre++-- | Returns @True@ if this 'LNode' is a root.+isRoot :: (Graph g) => g a b -> LNode a -> Bool+isRoot = endNode pre++-- | Returns @True@ if this 'Node' is a root.+isRoot' :: (Graph g) => g a b -> Node -> Bool+isRoot' = endNode' pre++{-+classifyRoots :: (Eq a) => GraphData a -> (Maybe (LNode a), LNGroup a)+classifyRoots gr = first listToMaybe $ partition isWanted roots+ where+ roots = findRoots gr+ theRoot = wantedRoot gr+ isWanted = maybe (const False) (==) theRoot++wantedRootExists :: (Eq a) => GraphData a -> Bool+wantedRootExists = isJust . fst . classifyRoots+-}+++-- -----------------------------------------------------------------------------++{-+ Leaf detection.+ -}++-- | Find all leaves of the graph.+leavesOf :: (Graph g) => g a b -> LNGroup a+leavesOf = endBy pre++-- | Find all leaves of the graph.+leavesOf' :: (Graph g) => g a b -> NGroup+leavesOf' = endBy' pre++-- | Returns @True@ if this 'LNode' is a leaf.+isLeaf :: (Graph g) => g a b -> LNode a -> Bool+isLeaf = endNode pre++-- | Returns @True@ if this 'Node' is a leaf.+isLeaf' :: (Graph g) => g a b -> Node -> Bool+isLeaf' = endNode' pre++-- -----------------------------------------------------------------------------++{-+ Singleton detection.+ -}++-- | Find all singletons of the graph.+singletonsOf :: (Graph g) => g a b -> LNGroup a+singletonsOf = endBy pre++-- | Find all singletons of the graph.+singletonsOf' :: (Graph g) => g a b -> NGroup+singletonsOf' = endBy' pre++-- | Returns @True@ if this 'LNode' is a singleton.+isSingleton :: (Graph g) => g a b -> LNode a -> Bool+isSingleton = endNode pre++-- | Returns @True@ if this 'Node' is a singleton.+isSingleton' :: (Graph g) => g a b -> Node -> Bool+isSingleton' = endNode' pre++-- -----------------------------------------------------------------------------++{- |+ The /core/ of the graph is the part of the graph containing all the+ cycles, etc. Depending on the context, it could be interpreted as+ the part of the graph where all the "work" is done.+ -}+coreOf :: (DynGraph g, Eq a, Eq b) => g a b -> [g a b]+coreOf = componentsOf . fixPointGraphs stripEnds+ where+ stripEnds gr' = delNodes roots . delNodes leaves $ gr'+ where+ roots = rootsOf' gr'+ leaves = leavesOf' gr'
+ Data/Graph/Analysis/Types.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses+ , FunctionalDependencies+ #-}++{- |+ Module : Data.Graph.Analysis.Types+ Description : Graphalyze Types and Classes+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ This module defines the various types and classes utilised+ by the Graphalyze library.+ -}+module Data.Graph.Analysis.Types+ ( -- * Graph specialization+ GraphData(..),+ Gr,+ AGr,+ NGroup,+ LNGroup,+ -- * Graph Label classes+ ClusterLabel(..),+ GenCluster(..),+ PosLabel(..)+ ) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Tree++-- -----------------------------------------------------------------------------++{- |+ By default, the Graphalyze library works on graphs with no edge labels.+ As such, these types provide useful aliases for the default FGL types.+ Most of the algorithms, however, work on arbitrary graph types.+ -}++-- | Represents information about the graph being analysed.+data GraphData a = GraphData { -- | We use a graph type with no edge labels.+ graph :: AGr a,+ -- | The expected roots in the graph.+ wantedRoots :: LNGroup a+ }+ deriving (Show)++-- | We use a basic tree-based graph by default.+type AGr a = Gr a ()++-- | A grouping of 'Node's.+type NGroup = [Node]++-- | A grouping of 'LNode's.+type LNGroup a = [LNode a]++-- -----------------------------------------------------------------------------++-- | These types and classes represent useful label types.++-- | The class of outputs of a clustering algorithm.+-- This class is mainly used for visualization purposes,+-- with the 'Ord' instance required for grouping.+-- Instances of this class are intended for use as+-- the label type of graphs.+class (Ord c) => ClusterLabel a c | a -> c where+ -- | The cluster the node label belongs in.+ cluster :: a -> c+ -- | The printed form of the actual label.+ nodelabel :: a -> String++-- | A generic cluster-label type.+data GenCluster a = GC Int a++instance (Show a) => ClusterLabel (GenCluster a) Int where+ cluster (GC c _) = c+ nodelabel (GC _ l) = show l++-- | Label type for storing node positions. Note that this isn't an instance of+-- 'ClusterLabel' since there's no clear indication on which cluster a node+-- belongs to at this stage.+data PosLabel a = PLabel { xPos :: Int+ , yPos :: Int+ , pnode :: Node+ , plabel :: a+ }+ deriving (Eq, Show)
+ Data/Graph/Analysis/Utils.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE OverlappingInstances+ , UndecidableInstances+ , TypeSynonymInstances+ , FlexibleInstances+ #-}++{- |+ Module : Data.Graph.Analysis.Utils+ Description : Utility functions+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ This module defines various utility functions used throughout.+ -}+module Data.Graph.Analysis.Utils+ ( -- * Graph functions+ -- ** Data extraction+ node,+ label,+ edge,+ eLabel,+ addLabels,+ filterNodes,+ filterNodes',+ -- ** Graph manipulation+ pathValues,+ undir,+ oneWay,+ nlmap,+ -- ** Graph layout+ -- | These next two are re-exported from "Data.GraphViz"+ AttributeNode,+ AttributeEdge,+ dotizeGraph,+ toPosGraph,+ getPositions,+ -- ** Cluster functions+ createLookup,+ setCluster,+ assignCluster,+ -- * List functions+ single,+ longerThan,+ longest,+ groupElems,+ sortMinMax,+ blockPrint,+ shuffle,+ -- * Statistics functions+ mean,+ statistics,+ statistics',+ -- * Other functions+ fixPoint,+ fixPointGraphs,+ fixPointBy,+ sq,+ fI+ ) where++import Data.Graph.Analysis.Types++import Data.Graph.Inductive.Graph+import Data.GraphViz++import Data.List+import Data.Maybe+import Data.Function+import qualified Data.Set as Set+import qualified Data.IntMap as IMap+import Data.IntMap(IntMap)+import Control.Monad+import Control.Arrow+import System.Random+import System.IO.Unsafe(unsafePerformIO)++-- -----------------------------------------------------------------------------++-- | Extracting data from graphs.++-- | The node number of an 'LNode'.+node :: LNode a -> Node+node = fst++-- | The label of an 'LNode'+label :: LNode a -> a+label = snd++-- | Extract the 'Edge' from the 'LEdge'.+edge :: LEdge b -> Edge+edge (n1,n2,_) = (n1,n2)++-- | The label of an 'LEdge'+eLabel :: LEdge b -> b+eLabel (_,_,b) = b++-- | Obtain the labels for a list of 'Node's.+-- It is assumed that each 'Node' is indeed present in the given graph.+addLabels :: (Graph g) => g a b -> [Node] -> [LNode a]+addLabels gr = map (ap (,) (fromJust . lab gr))++-- | Find all the labelled nodes in the graph that match the given predicate.+filterNodes :: (Graph g) => (g a b -> LNode a -> Bool) -> g a b -> [LNode a]+filterNodes p g = filter (p g) (labNodes g)++-- | Find all the nodes in the graph that match the given predicate.+filterNodes' :: (Graph g) => (g a b -> Node -> Bool) -> g a b -> [Node]+filterNodes' p g = filter (p g) (nodes g)++-- -----------------------------------------------------------------------------++-- | Manipulating graphs.++-- | Extract the actual 'LNode's from an 'LPath'.+pathValues :: LPath a -> [LNode a]+pathValues (LP lns) = lns++{- |+ Make the graph undirected, i.e. for every edge from A to B, there+ exists an edge from B to A. The provided function+ 'Data.Graph.Inductive.Basic.undir' duplicates loops as well, which+ isn't wanted. It is assumed that no edges are already duplicates+ [i.e. if there exists an edge (n1,n2), then there doesn't exist+ (n2,n1)]. This function also preserves edge labels: if two edges+ exist between two nodes with different edge labels, then both edges+ will be duplicated.+-}+undir :: (Eq b, DynGraph gr) => gr a b -> gr a b+undir = gmap dupEdges+ where+ dupEdges (p,n,l,s) = (ps',n,l,ps)+ where+ ps = nub $ p ++ s+ ps' = snd $ partition isLoop ps+ isLoop (_,n') = n == n'++-- | This is a pseudo-inverse of 'undir': any edges that are both successor+-- and predecessor become successor edges only.+oneWay :: (DynGraph g, Eq b) => g a b -> g a b+oneWay = gmap rmPre+ where+ rmPre (p,n,l,s) = (p \\ s,n,l,s)++-- | Map over the labels on the nodes, using the node values as well.+nlmap :: (DynGraph gr) => (LNode a -> c) -> gr a b -> gr c b+nlmap f = gmap f'+ where+ f' (p,n,l,s) = (p,n,f (n,l),s)++-- -----------------------------------------------------------------------------++{- |+ Spatial positioning of graphs. Use the 'graphToGraph' function in+ "Data.GraphViz" to determine potential graph layouts.+-}++-- | Pass the plain graph through 'graphToGraph'. This is an IO action,+-- however since the state doesn't change it's safe to use 'unsafePerformIO'+-- to convert this to a normal function.+dotizeGraph :: (DynGraph gr, Ord b) => gr a b+ -> gr (AttributeNode a) (AttributeEdge b)+dotizeGraph g = unsafePerformIO+ $ graphToGraph g gAttrs noAttrs noAttrs+ where+ gAttrs = []+ noAttrs = const []++-- | Convert the graph into one with positions stored in the node labels.+toPosGraph :: (DynGraph gr, Ord b) => gr a b -> gr (PosLabel a) b+toPosGraph = nlmap getPos . emap rmAttrs . dotizeGraph+ where+ rmAttrs = snd+ isPoint attr = case attr of+ (Pos _) -> True+ _ -> False+ getPos (n,(as,l)) = PLabel { xPos = x+ , yPos = y+ , pnode = n+ , plabel = l+ }+ where+ -- Assume that positions can't be doubles.+ (Pos (PointList ((Point x y):_))) = fromJust $ find isPoint as++-- | Returns the positions of the nodes in the graph, as found using Graphviz.+getPositions :: (DynGraph gr, Ord b) => gr a b -> [PosLabel a]+getPositions = map label . labNodes . toPosGraph++-- -----------------------------------------------------------------------------++-- | Cluster utility functions.++-- | Create a cluster-lookup 'IntMap'.+createLookup :: [[Node]] -> IntMap Int+createLookup = IMap.fromList . concatMap addCluster . zip [1..]+ where+ addCluster (k,ns) = map (flip (,) k) ns++-- | Used when the clusters are assigned in a lookup 'IntMap' instance.+setCluster :: (DynGraph gr) => IntMap Int -> gr a b -> gr (GenCluster a) b+setCluster m = nlmap assClust+ where+ assClust (n,l) = GC (m IMap.! n) l++-- | A function to convert an 'LNode' to the required 'NodeCluster'+-- for use with the 'Graphviz' library.+assignCluster :: (ClusterLabel a c) => LNode a -> NodeCluster c a+assignCluster nl@(_,a) = C (cluster a) (N nl)++-- -----------------------------------------------------------------------------++-- | List utility functions.++-- | Return true if and only if the list contains a single element.+single :: [a] -> Bool+single [_] = True+single _ = False++-- | If we need to only tell if the list contains more than @n@ elements,+-- there's no need to find its length.+longerThan :: Int -> [a] -> Bool+longerThan n = not . null . drop n++-- | Returns the longest list in a list of lists.+longest :: [[a]] -> [a]+longest = snd . maximumBy (compare `on` fst)+ . map addLength+ where+ addLength xs = (length xs,xs)++-- | Group elements by the given grouping function.+groupElems :: (Ord b) => (a -> b) -> [a] -> [(b,[a])]+groupElems f = map createGroup+ . groupBy ((==) `on` fst)+ . sortBy (compare `on` fst)+ . map addOrd+ where+ addOrd a = (f a, a)+ createGroup bas@((b,_):_) = (b, map snd bas)+ -- This shouldn't ever happen, but let's suppress the -Wall warning.+ createGroup [] = error "Grouping resulted in an empty list!"++-- | Returns the unique elements of the list in ascending order,+-- as well as the minimum and maximum elements.+sortMinMax :: (Ord a) => [a] -> ([a],a,a)+sortMinMax as = (as',aMin,aMax)+ where+ aSet = Set.fromList as+ as' = Set.toAscList aSet+ aMin = Set.findMin aSet+ aMax = Set.findMax aSet++-- | Attempt to convert a list of elements into a square format+-- in as much of a square shape as possible.+blockPrint :: (Show a) => [a] -> String+blockPrint as = init -- Remove the final '\n' on the end.+ . unlines $ map unwords lns+ where+ showl a = let sa = show a in (sa, length sa)+ las = map showl as+ -- Scale this, to take into account the height:width ratio.+ sidelen :: Double -- Suppress defaulting messages+ sidelen = (1.75*) . sqrt . fromIntegral . sum $ map snd las+ slen = round sidelen+ serr = round $ sidelen/10+ lns = unfoldr (takeLen slen serr) las++-- | Using the given line length and allowed error, take the elements of+-- the next line.+takeLen :: Int -> Int -> [(String,Int)] -> Maybe ([String],[(String,Int)])+takeLen _ _ [] = Nothing+takeLen len err ((a,l):als) = Just lr+ where+ lmax = len + err+ lr = if l > len+ then ([a],als) -- Overflow line of single item+ else (a:as,als')+ -- We subtract one here to take into account the space.+ (as,als') = takeLine (lmax - l - 1) als++-- | Recursively build the rest of the line with given maximum length.+takeLine :: Int -> [(String,Int)] -> ([String],[(String,Int)])+takeLine len als+ | null als = ([],als)+ | len <= 0 = ([],als) -- This should be covered by the next guard,+ -- but just in case...+ | l > len = ([],als)+ | otherwise = (a:as,als'')+ where+ ((a,l):als') = als+ len' = len - l - 1 -- Subtract 1 to account for the space+ (as,als'') = takeLine len' als'++{- |+ Shuffle a list of elements.+ This isn't the most efficient version, but should serve for small lists.+ Adapted from:+ <http://www.cse.unsw.edu.au/~tsewell/shuffle.html>+ The adaptation mainly involved altering the code so that the new+ random seed is also returned.+ -}+shuffle :: (RandomGen g) => g -> [a] -> ([a],g)+shuffle g [] = ([],g)+shuffle g [x] = ([x],g)+shuffle g xs = randomMerge g'' ((shYs,yn),(shZs,zn))+ where+ ((ys, yn), (zs, zn)) = splitAndCount xs (([], 0), ([], 0))+ (shYs,g') = shuffle g ys+ (shZs,g'') = shuffle g' zs++splitAndCount :: [a] -> (([a], Int), ([a], Int)) -> (([a], Int), ([a], Int))+splitAndCount [] result = result+splitAndCount (x : xs) ((ys, yn), (zs, zn)) =+ splitAndCount xs ((x : zs, zn + 1), (ys, yn))++{-+ Taken from the original site:++ The idea is to merge two shuffled lists which come with given sizes.+ If the lists X and Y have sizes n and m, we should pick the first element+ of X with probability n / n + m and the first element of Y with probability+ m / n + m. As X and Y are shuffled, picking the first element is random+ among their original elements, and thus this constitutes a random choice+ of first element from the original set.+ -}+randomMerge :: (RandomGen g) => g -> (([a], Int), ([a], Int)) -> ([a],g)+randomMerge g (([],_),(ys,_)) = (ys,g)+randomMerge g ((xs,_),([],_)) = (xs,g)+randomMerge g ((x:xs,xn),(y:ys,yn)) = if n <= xn+ then first (x:) xg+ else first (y:) yg+ where+ xg = randomMerge g' ((xs, xn - 1), (y : ys, yn))+ yg = randomMerge g' ((x : xs, xn), (ys, yn - 1))+ (n, g') = randomR (1, xn + yn) g++-- -----------------------------------------------------------------------------++-- | Statistics functions.++-- | An efficient mean function by Don Stewart, available from:+-- <http://cgi.cse.unsw.edu.au/~dons/blog/2008/05/16#fast>+mean :: [Double] -> Double+mean = go 0 0+ where+ go :: Double -> Int -> [Double] -> Double+ go s l [] = s / fromIntegral l+ go s l (x:xs) = go (s+x) (l+1) xs++-- | Calculate the mean and standard deviation of a list of elements.+statistics :: [Double]+ -> (Double,Double) -- ^ (Mean, Standard Deviation)+statistics as = (av,stdDev)+ where+ av = mean as+ stdDev = sqrt . mean $ map (sq . subtract av) as++-- | Calculate the mean and standard deviation of a list of 'Int' values.+statistics' :: [Int]+ -> (Int,Int) -- ^ (Mean, Standard Deviation)+statistics' as = (av', stdDev')+ where+ (av,stdDev) = statistics $ map fromIntegral as+ av' = round av+ stdDev' = round stdDev++-- -----------------------------------------------------------------------------++-- | Other utility functions.++-- | Find the fixed point of a function with the given initial value.+fixPoint :: (Eq a) => (a -> a) -> a -> a+fixPoint f = fixPointBy (==) f++-- | Find the fixed point of a function with the given initial value,+-- using the given equality function.+fixPointBy :: (a -> a -> Bool) -> (a -> a) -> a -> a+fixPointBy eq f x = if (eq x x')+ then x'+ else fixPointBy eq f x'+ where+ x' = f x+-- | Find the fixed point of a graph transformation function.+fixPointGraphs :: (Eq a, Eq b, Graph g) => (g a b -> g a b) -> g a b -> g a b+fixPointGraphs f = fixPointBy equal f++-- | Squaring a number.+sq :: (Num a) => a -> a+sq x = x * x++-- | Shorthand for 'fromIntegral'+fI :: (Num a) => Int -> a+fI = fromIntegral
+ Data/Graph/Analysis/Visualisation.hs view
@@ -0,0 +1,38 @@+{- |+ Module : Data.Graph.Analysis.Visualisation+ Description : Graphviz wrapper functions+ Copyright : (c) Ivan Lazar Miljenovic 2008+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ A wrapper module around the Haskell "Data.GraphViz" library to+ turn Graphs into basic graphs for processing by the Graphviz+ application.+ -}+module Data.Graph.Analysis.Visualisation where++import Data.Graph.Analysis.Types+import Data.Graph.Analysis.Utils+import Data.Graph.Inductive.Graph+import Data.GraphViz++-- | Turns the graph into 'DotGraph' format with the given title.+-- Nodes are labelled, edges aren't.+graphviz :: (Graph g, Show a, Ord b) => String -> g a b -> DotGraph+graphviz t g = graphToDot g attrs nattrs eattrs+ where+ attrs = [Label t]+ nattrs (_,a) = [Label (show a)]+ eattrs _ = []++-- | Turns the graph into 'DotGraph' format with the given title.+-- Cluster the nodes based upon their 'ClusterLabel' clusters.+-- Nodes and clusters are labelled, edges aren't.+graphvizClusters :: (Graph g, Show c, ClusterLabel a c, Ord b) =>+ String -> g a b -> DotGraph+graphvizClusters t g = clusterGraphToDot g atts assignCluster catts natts eatts+ where+ atts = [Label t]+ catts c = [Label (show c)]+ natts (_,a) = [Label (nodelabel a)]+ eatts _ = []
+ Graphalyze.cabal view
@@ -0,0 +1,34 @@+Name: Graphalyze+Version: 0.1+Synopsis: Graph-Theoretic Analysis library.+Description: A library to use graph theory to analyse the relationships+ inherent in discrete data.+Category: Algorithms+License: OtherLicense+License-File: LICENSE+Copyright: (c) Ivan Lazar Miljenovic+Author: Ivan Lazar Miljenovic+Maintainer: Ivan.Miljenovic@gmail.com+Cabal-Version: >= 1.2+Build-Type: Simple+Tested-With: GHC==6.8.3++flag small_base+ description: Choose the new smaller, split-up base package.++Library {+ if flag(small_base)+ Build-Depends: base >= 3, containers, random, fgl, graphviz >= 2008.9.20, bktrees+ else+ Build-Depends: base < 3, fgl, graphviz >= 2008.9.20, bktrees+ Exposed-Modules: Data.Graph.Analysis+ Data.Graph.Analysis.Types+ Data.Graph.Analysis.Utils+ Data.Graph.Analysis.Visualisation+ Data.Graph.Analysis.Algorithms+ Data.Graph.Analysis.Algorithms.Common+ Data.Graph.Analysis.Algorithms.Directed+ Data.Graph.Analysis.Algorithms.Clustering+ Ghc-Options: -Wall+ Ghc-Prof-Options: -auto-all+ }
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2008, Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain