Graphalyze 0.5 → 0.7.0.0
raw patch · 12 files changed
+803/−648 lines, 12 filesdep +extensible-exceptionsdep ~basedep ~bktreesdep ~fgl
Dependencies added: extensible-exceptions
Dependency ranges changed: base, bktrees, fgl, graphviz
Files
- Data/Graph/Analysis.hs +47/−69
- Data/Graph/Analysis/Algorithms.hs +5/−2
- Data/Graph/Analysis/Algorithms/Clustering.hs +76/−53
- Data/Graph/Analysis/Algorithms/Common.hs +11/−10
- Data/Graph/Analysis/Algorithms/Directed.hs +80/−8
- Data/Graph/Analysis/Internal.hs +89/−0
- Data/Graph/Analysis/Reporting.hs +51/−36
- Data/Graph/Analysis/Reporting/Pandoc.hs +30/−28
- Data/Graph/Analysis/Types.hs +174/−36
- Data/Graph/Analysis/Utils.hs +64/−151
- Data/Graph/Analysis/Visualisation.hs +152/−241
- Graphalyze.cabal +24/−14
Data/Graph/Analysis.hs view
@@ -1,7 +1,7 @@ {- | Module : Data.Graph.Analysis Description : A Graph-Theoretic Analysis Library.- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -9,7 +9,8 @@ provide a way of analysing the relationships inherent in discrete data as a graph. - This was written as part of my mathematics honours thesis,+ The original version of this library was written as part of my+ mathematics honours thesis, /Graph-Theoretic Analysis of the Relationships in Discrete Data/. -} module Data.Graph.Analysis@@ -23,17 +24,15 @@ module Data.Graph.Inductive.Graph, -- * Importing data ImportParams(..),- defaultParams, importData,- manipulateNodes, -- * Result analysis -- $analfuncts lengthAnalysis, classifyRoots,- interiorChains,- applyAlg+ interiorChains ) where +import Data.Graph.Analysis.Internal import Data.Graph.Analysis.Utils import Data.Graph.Analysis.Types import Data.Graph.Analysis.Algorithms@@ -41,86 +40,68 @@ import Data.Graph.Analysis.Reporting import Data.Graph.Inductive.Graph-import Data.List-import Data.Maybe++import Data.Maybe(mapMaybe) import qualified Data.Map as M-import Control.Arrow(second)+import qualified Data.Set as S +import Data.Version(showVersion)+import qualified Paths_Graphalyze as Paths(version)+ -- ----------------------------------------------------------------------------- -- | The library version. version :: String-version = "0.5"+version = showVersion Paths.version {- | 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- }+data ImportParams n e = Params { -- | The discrete points.+ dataPoints :: [n],+ -- | The relationships between the points.+ relationships :: [Rel n e],+ -- | The expected roots of the graph.+ -- If @'directed' = 'False'@, then this is ignored.+ roots :: [n],+ -- | 'False' if relationships are symmetric+ -- (i.e. an undirected graph).+ directed :: Bool+ } {- | 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.+ @ImportParams@ is necessary. The unused relations are stored in+ 'unusedRelationships'. Note that it is assumed that all datums in+ 'roots' are also contained within 'dataPoints'. -}-importData :: (Ord a) => ImportParams a -> GraphData a-importData params = GraphData { graph = dGraph, wantedRoots = rootNodes }+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 -- Adding Node values to each of the data points. lNodes = zip [1..] (dataPoints params)+ -- The valid edges in the graph along with the unused relationships.+ (unRs, graphEdges) = relsToEs isDir lNodes (relationships 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)+ nodeMap = mkNodeMap lNodes -- Validate a node- validNode l = case (findNode l) of- (Just n) -> Just (n,l)- _ -> Nothing+ validNode l = M.lookup l nodeMap -- Construct the root nodes- rootNodes = if (directed params)- then catMaybes $ map validNode (roots params)+ rootNodes = if isDir+ then mapMaybe 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---- | Apply a function to the nodes after processing.--- This might be useful in circumstances where you want to--- reduce the data type used to a simpler one, etc.-manipulateNodes :: (a -> b) -> GraphData a -> GraphData b-manipulateNodes f gd = gd { graph = nmap f (graph gd)- , wantedRoots = map (second f) (wantedRoots gd)- }+ dGraph = mkGraph lNodes graphEdges -- ----------------------------------------------------------------------------- @@ -152,24 +133,21 @@ * Unexpected roots (i.e. those roots that aren't present in 'wantedRoots'). -}-classifyRoots :: (Eq a) => GraphData a -> ([LNode a], [LNode a], [LNode a])+classifyRoots :: (Ord n) => GraphData n e -> ([LNode n], [LNode n], [LNode n]) classifyRoots gd = (areWanted, notRoots, notWanted) where- wntd = wantedRoots gd- rts = applyAlg rootsOf gd- areWanted = intersect wntd rts- notRoots = wntd \\ rts- notWanted = rts \\ wntd+ wntd = S.fromList $ wantedRoots gd+ rts = S.fromList $ applyAlg rootsOf gd+ areWanted = S.toList $ S.intersection wntd rts+ notRoots = S.toList $ S.difference wntd rts+ notWanted = S.toList $ S.difference rts wntd -- | Only return those chains (see 'chainsIn') where the non-initial -- nodes are /not/ expected roots.-interiorChains :: (Eq a) => GraphData a -> [LNGroup a]+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 --- | Apply an algorithm to the data to be analysed.-applyAlg :: (AGr a -> b) -> GraphData a -> b-applyAlg f = f . graph
Data/Graph/Analysis/Algorithms.hs view
@@ -1,7 +1,7 @@ {- | Module : Data.Graph.Analysis.Algorithms Description : Graph analysis algorithms- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -16,6 +16,9 @@ module Data.Graph.Analysis.Algorithms.Clustering ) where +-- For haddock purposes.+import Data.Graph.Inductive.Graph(Node)+ import Data.Graph.Analysis.Algorithms.Common import Data.Graph.Analysis.Algorithms.Directed import Data.Graph.Analysis.Algorithms.Clustering@@ -24,5 +27,5 @@ 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.+ (e.g. `cliquesIn'') will return a list of 'Node's. -}
Data/Graph/Analysis/Algorithms/Clustering.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses #-}- {- | Module : Data.Graph.Analysis.Algorithms.Clustering Description : Clustering and grouping algorithms.- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -20,26 +18,26 @@ relativeNeighbourhood, -- * Graph Collapsing -- $collapsing- CNodes(..),+ CNodes, collapseGraph,+ collapseGraphBy,+ collapseGraphBy', trivialCollapse,- cNodes ) where +import Data.Graph.Analysis.Internal import Data.Graph.Analysis.Types import Data.Graph.Analysis.Utils-import Data.Graph.Analysis.Visualisation(showNodes) import Data.Graph.Analysis.Algorithms.Common import Data.Graph.Inductive.Graph -import Data.List-import Data.Maybe-import Data.Function+import Data.List(foldl', tails, delete, intersect)+import Data.Function(on) import qualified Data.Set.BKTree as BK import Data.Set.BKTree(BKTree, Metric(..))-import Control.Arrow-import System.Random+import Control.Arrow(first, second)+import System.Random(RandomGen, randomR) -- ----------------------------------------------------------------------------- @@ -187,15 +185,15 @@ -- | 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+relativeNeighbourhood :: (DynGraph gr, Eq a, Ord b) => Bool -> gr a b+ -> gr (GenCluster a) b+relativeNeighbourhood dir g = setCluster cMap g where cMap = createLookup $ rn g rn g' = nbrCluster rng where- rng :: Gr () Int- rng = makeRNG $ getPositions g'+ rng :: AGr () Int+ rng = makeRNG $ getPositions dir g' -- | We take the ceiling of the Euclidian distance function to use as our -- metric function.@@ -205,9 +203,9 @@ -- | The Euclidian distance function. euclidian :: PosLabel a -> PosLabel a -> Double-euclidian n1 n2 = sqrt . fI $ (posBy xPos) + (posBy yPos)+euclidian n1 n2 = sqrt . fI $ posBy xPos + posBy yPos where- posBy p = sq $ (p n1) - (p n2)+ posBy p = sq $ p n1 - p n2 -- | Converts the positional labels into an RNG. makeRNG :: (Eq a, Graph gr) => [PosLabel a] -> gr () Int@@ -258,7 +256,7 @@ (_,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)+ 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.@@ -273,81 +271,106 @@ -- ----------------------------------------------------------------------------- {- $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.+ Collapse the parts of a graph down to try and show a compressed+ overview of the whole graph. 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]+type CNodes a = [a] --- | The 'LNode's stored in a 'CNodes'.-cNodes :: CNodes a -> [LNode a]-cNodes (CN lns) = lns+-- | Collapse the cliques, cycles and chains in the graph down. Note+-- that this doesn't work too well on undirected graphs, since every+-- pair of nodes forms a K_2 subgraph.+collapseGraph :: (DynGraph gr, Eq b) => gr a b -> gr (CNodes a) b+collapseGraph = collapseGraphBy interestingParts+ where+ interestingParts = [cliquesIn', cyclesIn', chainsIn'] --- | 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) = showNodes lns+-- | Use the given functions to determine which nodes to collapse.+collapseGraphBy :: (DynGraph gr) => [gr (CNodes a) b -> [NGroup]]+ -> gr a b -> gr (CNodes a) b+collapseGraphBy fs = collapseGr fs'+ where+ fs' = map (map (flip (,) Nothing) .) fs -collapseGraph :: (DynGraph gr, Eq b) => gr a b -> gr (CNodes a) b-collapseGraph g = foldl' (flip collapseAllBy) cg interestingParts+-- | Use the given functions to determine which nodes to collapse,+-- with a new label to represent the collapsed nodes.+collapseGraphBy' :: (DynGraph gr) => [gr a b -> [(NGroup, a)]]+ -> gr a b -> gr a b+collapseGraphBy' fs = unCollapse . collapseGr fs' where- cg = makeCollapsible g- interestingParts = [cliquesIn', cyclesIn', chainsIn']+ -- convert gr a b -> [(NGroup a)] to+ -- gr (CNodes a) b -> [(NGroup, Maybe a)]+ fs' = map ((.nmap head) . (map (second Just) .)) fs +-- | Collapse the graph.+collapseGr :: (DynGraph gr) => [gr (CNodes a) b -> [(NGroup, Maybe a)]]+ -> gr a b -> gr (CNodes a) b+collapseGr fs g = foldl' collapseAllBy (makeCollapsible g) fs+ -- | Return @'True'@ if the collapsed graph is either a singleton node -- or else isomorphic to the original graph (i.e. not collapsed at all). trivialCollapse :: (Graph gr) => gr (CNodes a) b -> Bool trivialCollapse cg = allCollapsed || notCollapsed where- allCollapsed = (single lns) || (null lns)- notCollapsed = all (single . cNodes) lns+ allCollapsed = single lns || null lns+ notCollapsed = all single lns lns = labels cg -- | Allow the graph to be collapsed. makeCollapsible :: (DynGraph gr) => gr a b -> gr (CNodes a) b-makeCollapsible = nlmap (CN . return)+makeCollapsible = nmap return +unCollapse :: (DynGraph gr) => gr (CNodes a) b -> gr a b+unCollapse = nmap head+ -- | 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)+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))+ nbrBy f = map swap . 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)+ l1 = lab' c1+ l2 = lab' c2+ c' = (p,n1,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+collapseAll :: (DynGraph gr) => gr (CNodes a) b+ -> (NGroup, Maybe a)+ -> gr (CNodes a) b+collapseAll g ([],_) = g -- These two cases+collapseAll g ([_],_) = g -- shouldn't occur.+collapseAll g ((n:ns),ma) = adj $ foldl' collapser g ns where+ adj = maybe id (adjustLabel n) ma collapser g' = collapse g' n +adjustLabel :: (DynGraph gr) => Node -> a+ -> gr (CNodes a) b -> gr (CNodes a) b+adjustLabel n a g = c & g'+ where+ (Just (p,_,_,s), g') = match n g+ c = (p,n,[a],s)+ -- | 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+collapseAllBy :: (DynGraph gr) => gr (CNodes a) b+ -> (gr (CNodes a) b -> [(NGroup, Maybe a)])+ -> gr (CNodes a) b+collapseAllBy g f = case (filter (not . single . fst) $ 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)+ (nsr:_) -> collapseAllBy (collapseAll g nsr) f
Data/Graph/Analysis/Algorithms/Common.hs view
@@ -1,7 +1,7 @@ {- | Module : Data.Graph.Analysis.Algorithms.Common Description : Algorithms for all graph types.- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -35,11 +35,12 @@ 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+import Data.List(unfoldr, foldl', foldl1', intersect, (\\), delete, tails, nub)+import Data.Maybe(isJust)+import Control.Arrow(first) -- ----------------------------------------------------------------------------- @@ -163,7 +164,7 @@ alsoRegular :: (Graph g) => g a b -> [Node] -> [[Node]] alsoRegular _ [] = [] alsoRegular _ [n] = [[n]]-alsoRegular g (n:ns) = [n] : rs ++ (alsoRegular g ns)+alsoRegular g (n:ns) = [n] : rs ++ alsoRegular g ns where rs = map (n:) (alsoRegular g $ intersect crn ns) crn = twoCycle g n@@ -180,7 +181,7 @@ -- Node + Rest of list split = zip ns tns' tns' = tail $ tails ns- allTwoCycle (n,rs) = null $ rs \\ (twoCycle g n)+ allTwoCycle (n,rs) = null $ rs \\ twoCycle g n -- ----------------------------------------------------------------------------- {- $cycles@@ -219,7 +220,7 @@ pathTree . first Just where- isCycle p = (not $ single p) && ((head p) == (last p))+ isCycle p = not (single p) && (head p == last p) -- ----------------------------------------------------------------------------- @@ -250,7 +251,7 @@ -- | 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))+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@@ -263,7 +264,7 @@ -- | 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)+isChainStart g n = hasNext g n && case (pre g n \\ [n]) of [n'] -> not $ isChainStart g n' _ -> True@@ -272,7 +273,7 @@ -- 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+chainFind f g n = case (nub (f g n) \\ [n]) of [n'] -> Just n' _ -> Nothing
Data/Graph/Analysis/Algorithms/Directed.hs view
@@ -1,11 +1,11 @@ {- | Module : Data.Graph.Analysis.Algorithms.Directed Description : Algorithms for directed graphs.- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com - Defines algorithms that work on both directed graphs.+ Defines algorithms that work on directed graphs. -} module Data.Graph.Analysis.Algorithms.Directed ( -- * Ending nodes@@ -23,13 +23,24 @@ isSingleton, isSingleton', -- * Subgraphs coreOf,+ -- * Clustering+ levelGraph,+ -- * Other+ leafMinPaths ) where import Data.Graph.Analysis.Types import Data.Graph.Analysis.Utils import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Query.BFS(esp) +import Data.List(minimumBy, unfoldr)+import Data.Function(on)+import qualified Data.Map as M+import qualified Data.Set as S+import Data.Set(Set)+ -- ----------------------------------------------------------------------------- {- $ends Find starting/ending nodes.@@ -44,8 +55,9 @@ -} -- | 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)+endNode :: (Graph g) => (g a b -> Node -> NGroup)+ -> g a b -> LNode a -> Bool+endNode f g = endNode' f g . node -- | Determine if this 'Node' is an ending node. endNode' :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> Node@@ -57,12 +69,12 @@ _ -> 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)+endBy :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> LNGroup a+endBy = filterNodes . endNode -- | 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)+endBy' :: (Graph g) => (g a b -> Node -> NGroup) -> g a b -> NGroup+endBy' = filterNodes' . endNode' -- ----------------------------------------------------------------------------- @@ -144,3 +156,63 @@ where roots = rootsOf' gr' leaves = leavesOf' gr'++-- -----------------------------------------------------------------------------++{- |+ Cluster the nodes in the graph based upon how far away they are+ from a root node. Root nodes are in the cluster labelled "0",+ nodes in level "n" are at least /n/ edges away from a root node.+-}+levelGraph :: (Ord a) => (DynGraph g) => g a b -> g (GenCluster a) b+levelGraph g = gmap addLbl g+ where+ lvls = zip [0..] . map S.toList $ graphLevels g+ lvMap = M.fromList+ $ concatMap (\(l,ns) -> map (flip (,) l) ns) lvls+ mkLbl n l = GC { clust = lvMap M.! n+ , nLbl = l+ }++ addLbl (p,n,l,s) = (p, n, mkLbl n l, s)++type NSet = Set Node++-- | Obtain the levels in the graph.+graphLevels :: (DynGraph g) => g a b -> [NSet]+graphLevels g = unfoldr getNextLevel+ (S.fromList $ rootsOf' g, g)++getNextLevel :: (DynGraph g) => (NSet, g a b)+ -> Maybe (NSet, (NSet, g a b))+getNextLevel (ns,g)+ | S.null ns = Nothing+ | otherwise = Just (ns, (ns', g'))+ where+ g' = delNodes (S.toList ns) g+ ns' = flip S.difference ns+ . S.unions . S.toList+ $ S.map getSuc ns+ getSuc = S.fromList . suc g++-- -----------------------------------------------------------------------------++{- |+ The shortest paths to each of the leaves in the graph (excluding+ singletons). This can be used to obtain an indication of the+ overall height/depth of the graph.+ -}+leafMinPaths :: (Graph g) => g a b -> [LNGroup a]+leafMinPaths g = map (lfMinPth g rs) ls+ where+ rs = rootsOf' g+ ls = leavesOf' g++-- | Given the list of roots in this graph, find the shortest path to+-- this leaf node.+lfMinPth :: (Graph g) => g a b -> [Node] -> Node -> LNGroup a+lfMinPth g rs l = addLabels g+ . snd+ . minimumBy (compare `on` fst)+ . addLengths+ $ map (\ r -> esp r l g) rs
+ Data/Graph/Analysis/Internal.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_HADDOCK hide #-}++{- |+ Module : Data.Graph.Analysis.Internal+ Description : Internal definitions+ Copyright : (c) Ivan Lazar Miljenovic 2009+ License : 2-Clause BSD+ Maintainer : Ivan.Miljenovic@gmail.com++ This module defines various internal definitions utilised by other+ modules of the Graphalyze library.+ -}+module Data.Graph.Analysis.Internal where++import Data.Graph.Inductive.Graph++import Data.Either(partitionEithers)+import qualified Data.Map as M+import Data.Map(Map)+import Data.Maybe(fromJust)+import Control.Arrow((***))+import Control.Monad(ap)++-- -----------------------------------------------------------------------------++-- | Squaring a number.+sq :: (Num a) => a -> a+sq x = x * x++-- | Shorthand for 'fromIntegral'+fI :: (Num a) => Int -> a+fI = fromIntegral++-- | Flip a pair.+swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)++-- | Apply the same function to both elements of a pair.+applyBoth :: (a -> b) -> (a,a) -> (b,b)+applyBoth f = f *** f++mkNodeMap :: (Ord a) => [LNode a] -> Map a Node+mkNodeMap = M.fromList . map swap++-- -----------------------------------------------------------------------------++-- | A relationship between two nodes with a label.+type Rel n e = (n, n, e)++applyNodes :: (a -> b) -> Rel a e -> Rel b e+applyNodes f (n1, n2, e) = (f n1, f n2, e)++fromNode :: Rel n e -> n+fromNode (n1, _, _) = n1++toNode :: Rel n e -> n+toNode (_, n2, _) = n2++relLabel :: Rel n e -> e+relLabel (_, _, e) = e+++relsToEs :: (Ord a) => Bool -> [LNode a] -> [Rel a e]+ -> ([Rel a e], [LEdge e])+relsToEs isDir lns rs = (unRs, graphEdges)+ where+ -- Creating a lookup map from the label to the @Node@ value.+ nodeMap = mkNodeMap lns+ findNode v = M.lookup v nodeMap+ -- Validate a edge after looking its values up.+ validEdge e = case applyNodes findNode e of+ (Just x, Just y, l) -> Right (x,y,l)+ _ -> Left e+ -- The valid edges in the graph.+ (unRs, gEdges) = partitionEithers $ map validEdge rs+ dupSwap' = if isDir+ then id+ else concatMap dupSwap+ dupSwap e@(x,y,l) | x == y = [e]+ | otherwise = [e, (y,x,l)]+ graphEdges = dupSwap' gEdges++-- This is needed by Types, so it's defined here and then exported by+-- Utils to avoid cyclic problems.++-- | 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))
Data/Graph/Analysis/Reporting.hs view
@@ -1,7 +1,7 @@ {- | Module : Data.Graph.Analysis.Reporting Description : Graphalyze Types and Classes- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -15,6 +15,7 @@ Location(..), DocElement(..), DocInline(..),+ GraphSize(..), DocGraph, -- * Helper functions -- $utilities@@ -25,16 +26,15 @@ unDotPath ) where +import Data.Graph.Inductive(Node) import Data.GraphViz-import Data.GraphViz.Attributes-import Data.Graph.Analysis.Visualisation -import Data.Maybe-import Data.Time-import Control.Exception-import System.Directory-import System.FilePath-import System.Locale+import Data.Maybe(isJust, fromJust)+import Data.Time(getZonedTime, zonedTimeToLocalTime, formatTime)+import Control.Exception.Extensible(SomeException(..), tryJust)+import System.Directory(createDirectoryIfMissing)+import System.FilePath((</>), (<.>))+import System.Locale(defaultTimeLocale) -- ----------------------------------------------------------------------------- @@ -74,10 +74,10 @@ docExtension :: dg -> String -- | Representation of a location, either on the internet or locally.-data Location = URL String | File FilePath+data Location = Web String | File FilePath instance Show Location where- show (URL url) = url+ show (Web url) = url show (File fp) = fp -- | Elements of a document.@@ -97,10 +97,10 @@ | DocLink DocInline Location | DocImage DocInline Location --- | Let the 'DocumentGenerator' instance apply extra settings, such as size.-type AttrsToGraph = [Attribute] -> DotGraph--type DocGraph = (FilePath,DocInline,AttrsToGraph)+-- | Specify the 'DotGraph' to turn into an image, its filename (sans+-- extension) and its caption. The 'DotGraph' should not have a+-- 'Size' set.+type DocGraph = (FilePath, DocInline, DotGraph Node) -- ----------------------------------------------------------------------------- @@ -123,7 +123,8 @@ -- if successful (or if the directory already exists), @False@ -- if an error occurred. tryCreateDirectory :: FilePath -> IO Bool-tryCreateDirectory fp = do r <- try $ mkDir fp+tryCreateDirectory fp = do r <- tryJust (\(SomeException _) -> return ())+ $ mkDir fp return (isRight r) where mkDir = createDirectoryIfMissing True@@ -135,48 +136,62 @@ -- If the second set of attributes is not 'Nothing', then the first -- image links to the second. The whole result is wrapped in a -- 'Paragraph'.-createGraph :: FilePath -> FilePath -> [Attribute] -> Maybe [Attribute]+createGraph :: FilePath -> FilePath -> GraphSize -> Maybe GraphSize -> DocGraph -> IO (Maybe DocElement)-createGraph fp gfp as mas (fn,inl,ag)- = do eImg <- gI as DocImage fn inl Nothing- if (isJust eImg)- then case mas of+createGraph fp gfp s ms (fn,inl,ag)+ = do eImg <- gI s Png "png" DocImage fn inl Nothing+ if isJust eImg+ then case ms of Nothing -> rt eImg- (Just as') -> do rt =<< gI as' DocLink fn' (toImg eImg) eImg+ (Just s') -> rt =<< gI s' Svg "svg" DocLink fn' (toImg eImg) eImg else return Nothing where fn' = fn ++ "-large" i2e i = Just (i,Paragraph [i]) rt = return . fmap snd+ -- This is safe because of the isJust above. toImg = fst . fromJust- gI a ln nm lb fl = do mImg <- graphImage fp gfp a ln (nm,lb,ag)- case mImg of- Nothing -> return fl- (Just img) -> return $ i2e img+ gI a o e ln nm lb fl = do mImg <- graphImage fp gfp a o e ln (nm,lb,ag)+ case mImg of+ Nothing -> return fl+ (Just img) -> return $ i2e img -- | Create the inline image/link from the given DocGraph.-graphImage :: FilePath -> FilePath -> [Attribute]+graphImage :: FilePath -> FilePath -> GraphSize+ -> GraphvizOutput -> FilePath -> (DocInline -> Location -> DocInline) -> DocGraph -> IO (Maybe DocInline)-graphImage fp gfp as link (fn,inl,ag)- = do created <- runGraphviz dg output filename'+graphImage fp gfp s output ext link (fn,inl,dg)+ = do created <- runGraphviz dg' output filename' if created then return (Just img) else return Nothing where- dg = ag as+ dg' = setSize s dg fn' = unDotPath fn- ext = "png"- output = Png filename = gfp </> fn' <.> ext filename' = fp </> filename loc = File filename img = link inl loc --- | Create the "Data.GraphViz" 'Size' 'Attribute' using the given width--- and a 6:4 width:height ratio.-createSize :: Double -> Attribute-createSize w = Size w (w*4/6)+-- | Specify the size the 'DotGraph' should be at.+data GraphSize = GivenSize Point -- ^ Specify the size to use.+ | DefaultSize -- ^ Let GraphViz choose an appropriate size.++-- | Add a 'GlobalAttribute' to the 'DotGraph' specifying the given size.+setSize :: GraphSize -> DotGraph a -> DotGraph a+setSize DefaultSize g = g+setSize (GivenSize p) g = g { graphStatements = stmts' }+ where+ stmts = graphStatements g+ stmts' = stmts { attrStmts = a : (attrStmts stmts) }+ a = GraphAttrs [s]+ s = Size p++-- | Using a 6:4 ratio, create the given 'Point' representing+-- width,height from the width.+createSize :: Double -> GraphSize+createSize w = GivenSize $ PointD w (w*4/6) -- | Replace all @.@ with @-@ in the given 'FilePath', since some output -- formats (e.g. LaTeX) don't like extraneous @.@'s in the filename.
Data/Graph/Analysis/Reporting/Pandoc.hs view
@@ -1,7 +1,7 @@ {- | Module : Data.Graph.Analysis.Reporting.Pandoc Description : Graphalyze Types and Classes- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -27,16 +27,15 @@ -- TODO : the ability to create multiple files. import Data.Graph.Analysis.Reporting-import Data.GraphViz.Attributes(Attribute) -import Data.List-import Data.Maybe import Text.Pandoc-import Control.Monad-import Control.Exception-import System.Directory-import System.FilePath +import Data.List(intersperse)+import Data.Maybe(isNothing, fromJust)+import Control.Exception.Extensible(SomeException, try)+import System.Directory(removeDirectoryRecursive)+import System.FilePath((</>), (<.>))+ -- ----------------------------------------------------------------------------- {- $writers@@ -47,7 +46,7 @@ pandocHtml = pd { writer = writeHtmlString , extension = "html" , header = "" -- Header will be included- , extGraphSize = Just $ defaultWidth * 10+ , extGraphSize = Just DefaultSize } pandocLaTeX :: PandocDocument@@ -55,7 +54,7 @@ , extension = "tex" , header = defaultLaTeXHeader -- 4.5" should be less than \textwidth in LaTeX.- , graphSize = 4.5+ , graphSize = createSize 4.5 } pandocRtf :: PandocDocument@@ -84,10 +83,10 @@ extension :: FilePath, -- | The Pandoc header to use header :: String,- -- | Maximum width of graphs to be produced.- graphSize :: Double,- -- | Optional maximum width of external linked graph.- extGraphSize :: Maybe Double+ -- | Size of graphs to be produced.+ graphSize :: GraphSize,+ -- | Optional size of external linked graphs.+ extGraphSize :: Maybe GraphSize } -- | Some default sizes. Note that all other fields of 'PandocDocument'@@ -96,13 +95,16 @@ pd = PD { writer = undefined, extension = undefined, header = undefined,- graphSize = defaultWidth,+ graphSize = defaultSize, extGraphSize = Nothing } defaultWidth :: Double defaultWidth = 10 +defaultSize :: GraphSize+defaultSize = createSize defaultWidth+ instance DocumentGenerator PandocDocument where createDocument = createPandoc docExtension = extension@@ -118,8 +120,8 @@ data PandocProcess = PP { secLevel :: Int , filedir :: FilePath , graphdir :: FilePath- , grSize :: [Attribute]- , eGSize :: Maybe [Attribute]+ , grSize :: GraphSize+ , eGSize :: Maybe GraphSize } -- | Start with a level 1 heading.@@ -136,7 +138,7 @@ createPandoc p d = do created <- tryCreateDirectory dir -- If the first one fails, so will this one. tryCreateDirectory $ dir </> gdir- if (not created)+ if not created then failDoc else do elems <- multiElems pp (content d) case elems of@@ -156,15 +158,15 @@ meta = makeMeta (title d) auth dt -- Html output doesn't show date and auth anywhere by default. htmlAuthDt = htmlInfo auth dt- createSize' = return . createSize pp = defaultProcess { filedir = dir , graphdir = gdir- , grSize = createSize' (graphSize p)- , eGSize = fmap createSize' (extGraphSize p)+ , grSize = graphSize p+ , eGSize = extGraphSize p } opts = writerOptions { writerHeader = (header p) }- convert = (writer p) opts- file = dir </> (fileFront d) <.> (extension p)+ convert = writer p opts+ file = dir </> fileFront d <.> extension p+ tryWrite :: String -> IO (Either SomeException ()) tryWrite = try . writeFile file success = return (Just file) failDoc = removeDirectoryRecursive dir >> return Nothing@@ -176,8 +178,8 @@ -} -- | The meta information-makeMeta :: DocInline -> String -> String -> Meta-makeMeta t a d = Meta (inlines t) [a] d+makeMeta :: DocInline -> String -> String -> Meta+makeMeta t a = Meta (inlines t) [a] -- | Html output doesn't show the author and date; use this to print it. htmlInfo :: String -> String -> Block@@ -189,7 +191,7 @@ -- | Link conversion loc2target :: Location -> Target-loc2target (URL url) = (url,"")+loc2target (Web url) = (url,"") loc2target (File file) = (file,"") -- | Conversion of simple inline elements.@@ -247,13 +249,13 @@ -- | Concatenate the result of multiple calls to 'elements'. multiElems :: PandocProcess -> [DocElement] -> IO (Maybe [Block]) multiElems p elems = do elems' <- mapM (elements p) elems- if (any isNothing elems')+ if any isNothing elems' then return Nothing else return (Just $ concatMap fromJust elems') -- | As for 'multiElems', but don't @concat@ the resulting 'Block's. multiElems' :: PandocProcess -> [DocElement] -> IO (Maybe [[Block]]) multiElems' p elems = do elems' <- mapM (elements p) elems- if (any isNothing elems')+ if any isNothing elems' then return Nothing else return (Just $ map fromJust elems')
Data/Graph/Analysis/Types.hs view
@@ -1,11 +1,12 @@-{-# LANGUAGE MultiParamTypeClasses- , FunctionalDependencies+{-# LANGUAGE TypeFamilies+ , FlexibleContexts+ , TypeSynonymInstances #-} {- | Module : Data.Graph.Analysis.Types Description : Graphalyze Types and Classes- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -13,40 +14,158 @@ by the Graphalyze library. -} module Data.Graph.Analysis.Types- ( -- * Graph specialization+ ( -- * Graph specialization. GraphData(..),- Gr, AGr,+ Rel, NGroup, LNGroup,- -- * Graph Label classes+ -- * Functions on @GraphData@.+ wantedRoots,+ applyAlg,+ applyDirAlg,+ mergeUnused,+ removeUnused,+ updateGraph,+ updateGraph',+ mapAllNodes,+ mapNodeType,+ -- * Clustering graphs based on their node labels. ClusterLabel(..),+ ClusterType(..),+ GraphID(..),+ -- * Graph label types. GenCluster(..), PosLabel(..) ) where +import Data.Graph.Analysis.Internal+ import Data.Graph.Inductive.Graph-import Data.Graph.Inductive.Tree+import Data.Graph.Inductive.PatriciaTree --- -----------------------------------------------------------------------------+import Data.GraphViz.Types(GraphID(..)) -{- |- 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.- -}+import qualified Data.Set as S+import Data.Set(Set) +-- -----------------------------------------------------------------------------+ -- | 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)+data GraphData n e = GraphData { -- | We use a graph type with no edge labels.+ graph :: AGr n e,+ -- | The expected root nodes in the graph.+ wantedRootNodes :: NGroup,+ -- | Is the data this graph represents+ -- directed in nature?+ directedData :: Bool,+ -- | Unused relationships (i.e. not in+ -- the actual graph). These are the+ -- edges containing nodes not in the+ -- graph.+ unusedRelationships :: [Rel n e]+ } --- | We use a basic tree-based graph by default.-type AGr a = Gr a ()+-- | The expected roots in the data to be analysed.+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 +-- | Apply an algorithm to the data to be analysed.+applyAlg :: (AGr n e -> a) -> GraphData n e -> a+applyAlg f = f . graph++-- | Apply an algorithm that requires knowledge about whether the+-- graph is directed ('True') or undirected ('False') to the data to+-- be analysed.+applyDirAlg :: (Bool -> AGr n e -> a) -> GraphData n e -> a+applyDirAlg f g = f (directedData g) (graph g)++-- | Apply a function to all the data points.+-- This might be useful in circumstances where you want to reduce+-- the data type used to a simpler one, etc. The function is also+-- applied to the datums in 'unusedRelationships'.+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+ }++-- | Apply the first function to nodes in the graph, and the second+-- function to those unknown datums in 'unusedRelationships'.+-- As a sample reason for this function, it can be used to apply a+-- two-part constructor (e.g. 'Left' and 'Right' from 'Either') to+-- the nodes such that the wanted and unwanted datums can be+-- differentiated before calling 'mergeUnused'.+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++-- | Merge the 'unusedRelationships' into the graph by adding the+-- appropriate nodes.+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+ -- Should no longer contain any unused rels.+ es' = snd $ relsToEs (directedData gd)+ (labNodes gr)+ unRs++knownNodes :: (Ord n) => GraphData n e -> Set n+knownNodes = S.fromList . map snd . labNodes . graph++-- | Used to set @'unusedRelationships' = []@. This is of use when+-- they are unneeded or because there is no sensible mapping+-- function to use when applying a mapping function to the nodes in+-- the graph.+removeUnused :: GraphData n e -> GraphData n e+removeUnused g = g { unusedRelationships = [] }++-- | Replace the current graph by applying a function to it. To+-- ensure type safety, 'removeUnused' is applied.+updateGraph :: (AGr a b -> AGr c d)+ -> GraphData a b -> GraphData c d+updateGraph f g = g { graph = applyAlg f g+ , unusedRelationships = []+ }++-- | Replace the current graph by applying a function to it, where the+-- function depends on whether the graph is directed ('True') or+-- undirected ('False'). To ensure type safety, 'removeUnused' is+-- applied.+updateGraph' :: (Bool -> AGr a b -> AGr c d)+ -> GraphData a b -> GraphData c d+updateGraph' f g = g { graph = applyDirAlg f g+ , unusedRelationships = []+ }+++-- | An alias for the type of graph being used by default.+type AGr n e = Gr n e+ -- | A grouping of 'Node's. type NGroup = [Node] @@ -57,30 +176,49 @@ -- | 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 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 (ClusterType (Cluster cl)) => ClusterLabel cl where+ type Cluster cl+ type NodeLabel cl+ -- | The cluster the node label belongs in.- cluster :: a -> c- -- | The printed form of the actual label.- nodelabel :: a -> String+ cluster :: cl -> Cluster cl + -- | The actual label.+ nodeLabel :: cl -> NodeLabel cl++-- | A class used to define which types are valid for clusters.+class (Ord c) => ClusterType c where+ -- | Create a label for visualisation purposes with the GraphViz+ -- library. Default is @'const' 'Nothing'@.+ clusterID :: c -> Maybe GraphID+ clusterID = const Nothing++instance ClusterType Int where+ clusterID = Just . Int++instance ClusterType String where+ clusterID = Just . Str+ -- | A generic cluster-label type. data GenCluster a = GC { clust :: Int , nLbl :: a } deriving (Eq,Show) -instance (Show a) => ClusterLabel (GenCluster a) Int where- cluster (GC c _) = c- nodelabel (GC _ l) = show l+instance ClusterLabel (GenCluster a) where+ type Cluster (GenCluster a) = Int+ type NodeLabel (GenCluster a) = a --- | 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.+ cluster = clust+ nodeLabel = nLbl++-- | 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
Data/Graph/Analysis/Utils.hs view
@@ -1,13 +1,7 @@-{-# LANGUAGE OverlappingInstances- , UndecidableInstances- , TypeSynonymInstances- , FlexibleInstances- #-}- {- | Module : Data.Graph.Analysis.Utils Description : Utility functions- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com @@ -22,7 +16,7 @@ labels, edge, eLabel,- addLabels,+ addLabels, -- Re-exported from Internal filterNodes, filterNodes', pathValues,@@ -30,20 +24,19 @@ undir, oneWay, mkSimple,+ compact,+ compact',+ compactSame, nlmap,+ delLNodes, -- ** Graph layout -- $spatial- -- These next two are re-exported from "Data.GraphViz"- AttributeNode,- AttributeEdge,- dotizeGraph, toPosGraph, getPositions, -- ** Cluster functions -- $cluster createLookup, setCluster,- assignCluster, reCluster, reClusterBy, clusterCount,@@ -56,12 +49,6 @@ lengthSort, groupElems, sortMinMax,- blockPrint,- blockPrint',- blockPrintList,- blockPrintList',- blockPrintWith,- blockPrintWith', shuffle, -- * Statistics functions mean,@@ -70,26 +57,26 @@ -- * Other functions fixPoint, fixPointGraphs,- fixPointBy,- sq,- fI+ fixPointBy ) where +import Data.Graph.Analysis.Internal import Data.Graph.Analysis.Types import Data.Graph.Inductive.Graph-import Data.GraphViz+import Data.GraphViz( dotizeGraph+ , Attribute(..)+ , Pos(..)+ , Point(..)) -import Data.List-import Data.Maybe-import Data.Function+import Data.List(nub, nubBy, (\\), find, sort, sortBy, group, groupBy)+import Data.Maybe(fromJust)+import Data.Function(on) 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)+import Control.Arrow(first, second)+import System.Random(RandomGen, randomR) -- ----------------------------------------------------------------------------- @@ -115,11 +102,6 @@ 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)@@ -175,41 +157,54 @@ p' = simpleEdges n p s' = simpleEdges n s +-- | Adjoin duplicate edges by grouping the labels together.+compact :: (DynGraph gr) => gr a b -> gr a [b]+compact = gmap cmpct+ where+ cEs = map (swap . second (map fst))+ . groupElems snd+ cmpct (p,n,l,s) = (cEs p, n, l, cEs s)++-- | Compact the graph by counting how many multiple edges there are+-- (considering only the two nodes and not the labels).+compact' :: (DynGraph gr) => gr a b -> gr a Int+compact' = emap length . compact++-- | Compact the graph by adjoining identical duplicate edges.+compactSame :: (Ord b) => (DynGraph gr) => gr a b -> gr a (Int,b)+compactSame = gmap cmpct+ where+ cEs = map toAdj . group . sort+ toAdj as = let (l,n) = head as in ((length as,l),n)+ cmpct (p,n,l,s) = (cEs p, n, l, cEs 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) +-- | Delete these labelled nodes from the graph.+delLNodes :: (DynGraph gr) => LNGroup a -> gr a b -> gr a b+delLNodes = delNodes . map fst+ -- ----------------------------------------------------------------------------- {- $spatial- Spatial positioning of graphs. Use the 'graphToGraph' function in+ Spatial positioning of graphs. Use the 'dotizeGraph' function in "Data.GraphViz" to determine potential graph layouts.-- Note that for convenience sake, 'AttributeNode' and 'AttributeEdge'- from "Data.GraphViz" have been re-exported. -} --- | 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+-- | Convert the graph into one with positions stored in the node+-- labels. The 'Bool' parameter denotes if the graph is directed or+-- not.+toPosGraph :: (DynGraph gr, Ord b) => Bool -> gr a b -> gr (PosLabel a) b+toPosGraph dir = nlmap getPos . emap rmAttrs . dotizeGraph dir where rmAttrs = snd isPoint attr = case attr of- (Pos _) -> True- _ -> False+ Pos{} -> True+ _ -> False getPos (n,(as,l)) = PLabel { xPos = x , yPos = y , pnode = n@@ -217,11 +212,15 @@ } where -- Assume that positions can't be doubles.- (Pos (PointList ((Point x y):_))) = fromJust $ find isPoint as+ -- Also assuming that we're not dealing with a+ -- spline-type point.+ (Pos (PointPos (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+-- | Returns the positions of the nodes in the graph, as found using+-- Graphviz. The 'Bool' parameter denotes if the graph is directed+-- or not.+getPositions :: (DynGraph gr, Ord b) => Bool -> gr a b -> [PosLabel a]+getPositions dir = map label . labNodes . toPosGraph dir -- ----------------------------------------------------------------------------- @@ -239,11 +238,6 @@ 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)- -- | Change the cluster values in the graph by having the largest cluster -- have the smallest cluster label. reCluster :: (DynGraph g) => g (GenCluster a) b -> g (GenCluster a) b@@ -258,7 +252,7 @@ -> g (GenCluster a) b reClusterBy m = nmap newClust where- newClust c = c { clust = m IMap.! (clust c) }+ newClust c = c { clust = m IMap.! clust c } -- | Create an 'IntMap' of the size of each cluster. clusterCount :: (Graph g) => g (GenCluster a) b -> IntMap Int@@ -314,80 +308,7 @@ aMin = Set.findMin aSet aMax = Set.findMax aSet --- | Attempt to convert the @String@ form of a list into--- as much of a square shape as possible, using a single--- space as a separation string.-blockPrint :: (Show a) => [a] -> String-blockPrint = blockPrintWith " " --- | Attempt to convert a list of @String@s into a single @String@--- that is roughly a square shape, with a single space as a row--- separator.-blockPrint' :: [String] -> String-blockPrint' = blockPrintWith' " "---- | Attempt to convert the @String@ form of a list into--- as much of a square shape as possible, separating values--- with commas.-blockPrintList :: (Show a) => [a] -> String-blockPrintList = blockPrintWith ", "---- | Attempt to combine a list of @String@s into as much of a--- square shape as possible, separating values with commas.-blockPrintList' :: [String] -> String-blockPrintList' = blockPrintWith' ", "---- | Attempt to convert the @String@ form of a list into--- as much of a square shape as possible, using the given--- separation string between elements in the same row.-blockPrintWith :: (Show a) => String -> [a] -> String-blockPrintWith str = blockPrintWith' str . map show---- | Attempt to convert the combined form of a list of @String@s--- into as much of a square shape as possible, using the given--- separation string between elements in the same row.-blockPrintWith' :: String -> [String] -> String-blockPrintWith' sep as = init -- Remove the final '\n' on the end.- . unlines $ map unwords' lns- where- lsep = length sep- las = addLengths as- -- Scale this, to take into account the height:width ratio.- sidelen :: Double -- Suppress defaulting messages- sidelen = (1.75*) . sqrt . fromIntegral . sum $ map fst las- slen = round sidelen- serr = round $ sidelen/10- lns = unfoldr (takeLen slen serr lsep) las- unwords' = concat . intersperse sep---- | Using the given line length and allowed error, take the elements of--- the next line.-takeLen :: Int -> Int -> Int -> [(Int,String)]- -> Maybe ([String],[(Int,String)])-takeLen _ _ _ [] = Nothing-takeLen len err lsep ((l,a):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 lsep here to take into account the spacer.- (as,als') = takeLine (lmax - l - lsep) lsep als---- | Recursively build the rest of the line with given maximum length.-takeLine :: Int -> Int -> [(Int,String)] -> ([String],[(Int,String)])-takeLine len lsep 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- ((l,a):als') = als- -- We subtract lsep here to take into account the spacer.- len' = len - l - lsep- (as,als'') = takeLine len' lsep als'- {- | Shuffle a list of elements. This isn't the most efficient version, but should serve for small lists.@@ -466,25 +387,17 @@ -- 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+fixPoint :: (Eq a) => (a -> a) -> a -> a+fixPoint = fixPointBy (==) -- | 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')+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+fixPointGraphs :: (Eq a, Eq b, Graph g) => (g a b -> g a b) -> g a b -> g a b+fixPointGraphs = fixPointBy equal
Data/Graph/Analysis/Visualisation.hs view
@@ -1,293 +1,204 @@ {- | Module : Data.Graph.Analysis.Visualisation Description : Graphviz wrapper functions- Copyright : (c) Ivan Lazar Miljenovic 2008+ Copyright : (c) Ivan Lazar Miljenovic 2009 License : 2-Clause BSD Maintainer : Ivan.Miljenovic@gmail.com Functions to assist in visualising graphs and components of graphs.- This module uses code licensed under the 3-Clause BSD license from- the /mohws/ project:- <http://code.haskell.org/mohws/src/Util.hs> -} module Data.Graph.Analysis.Visualisation- ( -- * Graph visualisation+ ( -- * Graph visualisation. -- $graphviz- -- ** Producing 'DotGraph's graphviz, graphvizClusters,- -- ** Creating images- GraphvizOutput(..),- GraphvizCommand(..),- runGraphviz,- runGraphvizCommand,- -- * Showing node groupings+ graphvizClusters',+ assignCluster,+ noAttributes,+ -- * Showing node groupings. -- $other showPath,+ showPath', showCycle,- showNodes+ showCycle',+ showNodes,+ showNodes',+ -- * Various printing functions.+ blockPrint,+ blockPrint',+ blockPrintList,+ blockPrintList',+ blockPrintWith,+ blockPrintWith', ) where -import Prelude- import Data.Graph.Analysis.Types import Data.Graph.Analysis.Utils import Data.Graph.Inductive.Graph import Data.GraphViz -import System.IO-import System.Exit-import System.Process-import Data.Array.IO-import Control.Concurrent-import Control.Exception---- Import this when the parsing stuff is finished--- import Text.ParserCombinators.PolyLazy+import Data.List(intersperse, unfoldr) -- ----------------------------------------------------------------------------- {- $graphviz- Simple wrappers around the Haskell "Data.GraphViz" library to- turn 'Graph's into basic 'DotGraph's for processing by the Graphviz- application.+ Simple wrappers around the Haskell "Data.GraphViz" library to turn+ 'GraphData's into basic 'DotGraph's for processing by the GraphViz+ suite of applications. -} --- | Turns the graph into 'DotGraph' format with the given title and graph--- attributes. Nodes are labelled, edges aren't.-graphviz :: (Graph g, Show a, Ord b) => String -> g a b -> [Attribute]- -> DotGraph-graphviz t g as = graphToDot g attrs nattrs eattrs- where- attrs = Label t : as- nattrs (_,a) = [Label (show a)]- eattrs _ = []---- | Turns the graph into 'DotGraph' format with the given title and graph--- attributes. 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 -> [Attribute] -> DotGraph-graphvizClusters t g as = clusterGraphToDot g atts assignCluster cas nas eas- where- atts = Label t : as- cas c = [Label (show c)]- nas (_,a) = [Label (nodelabel a)]- eas _ = []+-- | Convert the 'GraphData' into 'DotGraph' format with the given+-- 'Attribute's.+graphviz :: GraphData n e -> [GlobalAttributes]+ -> (LNode n -> Attributes)+ -> (LEdge e -> Attributes) -> DotGraph Node+graphviz = applyDirAlg graphToDot --- | The possible Graphviz outputs, obtained by running /dot -Txxx/.--- Note that it is not possible to choose between output variants,--- and that not all of these may be available on your system.-data GraphvizOutput = Canon- | Cmap- | Cmapx- | Cmapx_np- | Dia- | DotOutput- | Eps- | Fig- | Gd- | Gd2- | Gif- | Gtk- | Hpgl- | Imap- | Imap_np- | Ismap- | Jpe- | Jpeg- | Jpg- | Mif- | Mp- | Pcl- | Pdf- | Pic- | Plain- | PlainExt- | Png- | Ps- | Ps2- | Svg- | Svgz- | Tk- | Vml- | Vmlz- | Vrml- | Vtx- | Wbmp- | Xdot- | Xlib+-- | Convert the clustered 'GraphData' into 'DotGraph' format with the+-- given 'Attribute's. Cluster the nodes based upon their+-- 'ClusterLabel' clusters.+graphvizClusters :: (ClusterLabel cl) => GraphData cl e -> [GlobalAttributes]+ -> (Cluster cl -> [GlobalAttributes])+ -> (LNode (NodeLabel cl) -> Attributes)+ -> (LEdge e -> Attributes) -> DotGraph Node+graphvizClusters g gas = graphvizClusters' g gas assignCluster clusterID -instance Show GraphvizOutput where- show Canon = "canon"- show Cmap = "cmap"- show Cmapx = "cmapx"- show Cmapx_np = "cmapx_np"- show Dia = "dia"- show DotOutput = "dot"- show Eps = "eps"- show Fig = "fig"- show Gd = "gd"- show Gd2 = "gd2"- show Gif = "gif"- show Gtk = "gtk"- show Hpgl = "hpgl"- show Imap = "imap"- show Imap_np = "imap_np"- show Ismap = "ismap"- show Jpe = "jpe"- show Jpeg = "jpeg"- show Jpg = "jpg"- show Mif = "mif"- show Mp = "mp"- show Pcl = "pcl"- show Pdf = "pdf"- show Pic = "pic"- show Plain = "plain"- show PlainExt = "plain-ext"- show Png = "png"- show Ps = "ps"- show Ps2 = "ps2"- show Svg = "svg"- show Svgz = "svgz"- show Tk = "tk"- show Vml = "vml"- show Vmlz = "vmlz"- show Vrml = "vrml"- show Vtx = "vtx"- show Wbmp = "wbmp"- show Xdot = "xdot"- show Xlib = "xlib"+-- | Convert the 'GraphData' into a clustered 'DotGraph' format using+-- the given clustering function and with the given 'Attribute's.+graphvizClusters' :: (Ord c) => GraphData n e -> [GlobalAttributes]+ -> (LNode n -> NodeCluster c l)+ -> (c -> Maybe GraphID)+ -> (c -> [GlobalAttributes]) -> (LNode l -> Attributes)+ -> (LEdge e -> Attributes) -> DotGraph Node+graphvizClusters' = applyDirAlg clusterGraphToDot --- | The available Graphviz commands.-data GraphvizCommand = DotCmd | Neato | TwoPi | Circo | Fdp+-- | A function to convert an 'LNode' to the required 'NodeCluster'+-- for use with the GraphViz library.+assignCluster :: (ClusterLabel cl) => LNode cl+ -> NodeCluster (Cluster cl) (NodeLabel cl)+assignCluster (n,a) = C (cluster a) $ N (n, nodeLabel a) -instance Show GraphvizCommand where- show DotCmd = "dot"- show Neato = "neato"- show TwoPi = "twopi"- show Circo = "circo"- show Fdp = "fdp"+-- | Used to state that GraphViz should use the default 'Attribute's+-- for the given value.+noAttributes :: a -> Attributes+noAttributes = const [] --- | Run the recommended Graphviz command on this graph, saving the result--- to the file provided (note: file extensions are /not/ checked).-runGraphviz :: DotGraph -> GraphvizOutput -> FilePath -> IO Bool-runGraphviz gr t fp = runGraphvizInternal (commandFor gr) gr t fp+-- ----------------------------------------------------------------------------- --- | Run the chosen Graphviz command on this graph, saving the result--- to the file provided (note: file extensions are /not/ checked).-runGraphvizCommand :: GraphvizCommand -> DotGraph -> GraphvizOutput- -> FilePath -> IO Bool-runGraphvizCommand cmd gr t fp = runGraphvizInternal (show cmd) gr t fp+{- $other+ Printing different lists of labels.+ -} --- | This command should /not/ be available outside this module, as--- it isn't safe: running an arbitrary command will crash the programme.-runGraphvizInternal :: String -> DotGraph -> GraphvizOutput -> FilePath- -> IO Bool-runGraphvizInternal cmd gr t fp- = do pipe <- try $ openFile fp WriteMode- case pipe of- (Left _) -> return False- (Right f) -> do file <- graphvizWithHandle cmd gr t (flip squirt f)- hClose f- case file of- (Just _) -> return True- _ -> return False+-- | Print a path, with \"->\" between each element.+showPath :: (Show a) => [a] -> String+showPath = showPath' show -{- |- This function is taken from the /mohws/ project, available under a- 3-Clause BSD license. The actual function is taken from:- <http://code.haskell.org/mohws/src/Util.hs>- It provides an efficient way of transferring data from one 'Handle'- to another.- -}-squirt :: Handle -> Handle -> IO ()-squirt rd wr = do- arr <- newArray_ (0, bufsize-1)- let loop = do- r <- hGetArray rd arr bufsize- if (r == 0)- then return ()- else if (r < bufsize)- then hPutArray wr arr r- else hPutArray wr arr bufsize >> loop- loop+-- | Print a path, with \"->\" between each element.+showPath' :: (a -> String) -> [a] -> String+showPath' _ [] = ""+showPath' f ls = blockPrint' (l:ls'') where- -- This was originally separate- bufsize :: Int- bufsize = 4 * 1024+ -- Can't use blockPrintWith above, as it only takes a per-row spacer.+ (l:ls') = map f ls+ ls'' = map ("-> "++) ls' -{-+-- | Print a cycle: copies the first node to the end of the list,+-- and then calls 'showPath'.+showCycle :: (Show a) => [a] -> String+showCycle = showCycle' show --- Parsing to get graph size... do this later.+-- | Print a cycle: copies the first node to the end of the list,+-- and then calls 'showPath''.+showCycle' :: (a -> String) -> [a] -> String+showCycle' _ [] = ""+showCycle' f ls@(l:_) = showPath' f (ls ++ [l]) -parseGraphviz :: DotGraph -> IO (Maybe DotGraph)-parseGraphviz gr = parseGraphvizInternal (commandFor gr) gr+-- | Show a group of nodes, with no implicit ordering.+showNodes :: (Show a) => [a] -> String+showNodes = showNodes' show -graphvizSizeInternal :: String -> DotGraph -> Maybe (Int,Int)-graphvizSizeInternal cmd gr =+-- | Show a group of nodes, with no implicit ordering.+showNodes' :: (a -> String) -> [a] -> String+showNodes' _ [] = ""+showNodes' f ls = blockPrint' . addCommas+ $ map f ls where- parsed = parseGraphvizInternal cmd gr- getBB = maybe Nothing (find- bb2Rect (Bb r) = r- rectToSize (Rect _ (Point x y)) = (x,y)+ addCommas [] = []+ addCommas [l] = [l]+ addCommas (l:ls') = (l ++ ", ") : addCommas ls' --- | Internal parsing command.-parseGraphvizInternal :: String -> DotGraph -> IO (Maybe DotGraph)-parseGraphvizInternal cmd gr = graphvizWithHandle cmd gr DotOutput parse- where- parse h = do res <- hGetContents h- let gr' = fst $ runParser readDotGraph res- return gr'+-- ----------------------------------------------------------------------------- --}+-- | Attempt to convert the @String@ form of a list into+-- as much of a square shape as possible, using a single+-- space as a separation string.+blockPrint :: (Show a) => [a] -> String+blockPrint = blockPrintWith " " --- | Internal command to run Graphviz and process the output.--- This is /not/ to be made available outside this module.-graphvizWithHandle :: (Show a) => String -> DotGraph -> GraphvizOutput -> (Handle -> IO a)- -> IO (Maybe a)-graphvizWithHandle cmd gr t f- = do (inp, outp, errp, proc) <- runInteractiveCommand command- forkIO $ hPrint inp gr >> hClose inp- forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)- a <- f outp- -- Don't close outp until f finishes.- a `seq` hClose outp- exitCode <- waitForProcess proc- case exitCode of- ExitSuccess -> return (Just a)- _ -> return Nothing- where- command = cmd ++ " -T" ++ (show t)+-- | Attempt to convert a list of @String@s into a single @String@+-- that is roughly a square shape, with a single space as a row+-- separator.+blockPrint' :: [String] -> String+blockPrint' = blockPrintWith' " " --- -----------------------------------------------------------------------------+-- | Attempt to convert the @String@ form of a list into+-- as much of a square shape as possible, separating values+-- with commas.+blockPrintList :: (Show a) => [a] -> String+blockPrintList = blockPrintWith ", " -{- $other- Other visualisations. These are mainly replacements for- the @show@ function.- -}+-- | Attempt to combine a list of @String@s into as much of a+-- square shape as possible, separating values with commas.+blockPrintList' :: [String] -> String+blockPrintList' = blockPrintWith' ", " --- | Print a path, with \"->\" between each element.-showPath :: (Show a) => LNGroup a -> String-showPath [] = ""-showPath lns = blockPrint' (l:ls')+-- | Attempt to convert the @String@ form of a list into+-- as much of a square shape as possible, using the given+-- separation string between elements in the same row.+blockPrintWith :: (Show a) => String -> [a] -> String+blockPrintWith str = blockPrintWith' str . map show++-- | Attempt to convert the combined form of a list of @String@s+-- into as much of a square shape as possible, using the given+-- separation string between elements in the same row.+blockPrintWith' :: String -> [String] -> String+blockPrintWith' sep as = init -- Remove the final '\n' on the end.+ . unlines $ map unwords' lns where- -- Can't use blockPrintWith above, as it only takes a per-row spacer.- (l:ls) = map (show . label) lns- ls' = map ("-> "++) ls+ lsep = length sep+ las = addLengths as+ -- Scale this, to take into account the height:width ratio.+ sidelen :: Double -- Suppress defaulting messages+ sidelen = (1.75*) . sqrt . fromIntegral . sum $ map fst las+ slen = round sidelen+ serr = round $ sidelen/10+ lns = unfoldr (takeLen slen serr lsep) las+ unwords' = concat . intersperse sep --- | Print a cycle: copies the first node to the end of the list,--- and then calls 'showPath'.-showCycle ::(Show a) => LNGroup a -> String-showCycle [] = ""-showCycle lns@(ln:_) = showPath (lns ++ [ln])+-- | Using the given line length and allowed error, take the elements of+-- the next line.+takeLen :: Int -> Int -> Int -> [(Int,String)]+ -> Maybe ([String],[(Int,String)])+takeLen _ _ _ [] = Nothing+takeLen len err lsep ((l,a):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 lsep here to take into account the spacer.+ (as,als') = takeLine (lmax - l - lsep) lsep als --- | Show a group of nodes, with no implicit ordering.-showNodes :: (Show a) => LNGroup a -> String-showNodes [] = ""-showNodes lns = blockPrint' . addCommas- $ map (show . label) lns+-- | Recursively build the rest of the line with given maximum length.+takeLine :: Int -> Int -> [(Int,String)] -> ([String],[(Int,String)])+takeLine len lsep 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- addCommas [] = []- addCommas [l] = [l]- addCommas (l:ls) = (l ++ ", ") : addCommas ls+ ((l,a):als') = als+ -- We subtract lsep here to take into account the spacer.+ len' = len - l - lsep+ (as,als'') = takeLine len' lsep als'
Graphalyze.cabal view
@@ -1,5 +1,5 @@ Name: Graphalyze-Version: 0.5+Version: 0.7.0.0 Synopsis: Graph-Theoretic Analysis library. Description: A library to use graph theory to analyse the relationships inherent in discrete data.@@ -10,21 +10,29 @@ Author: Ivan Lazar Miljenovic Maintainer: Ivan.Miljenovic@gmail.com Extra-Source-Files: TODO-Cabal-Version: >= 1.2+Cabal-Version: >= 1.6 Build-Type: Simple-Tested-With: GHC==6.8.3 -flag small_base- description: Choose the new smaller, split-up base package.+Source-Repository head+ Type: darcs+ Location: http://code.haskell.org/Graphalyze -Library {- if flag(small_base)- Build-Depends: base >= 3, array, containers, directory, filepath,- old-locale, process, random, time- else- Build-Depends: base < 3 - Build-Depends: bktrees, fgl, graphviz >= 2008.9.20, pandoc+Library {+ Build-Depends: base >= 3 && < 5,+ extensible-exceptions,+ array,+ containers,+ directory,+ filepath,+ old-locale,+ process,+ random,+ time,+ bktrees >= 0.2,+ fgl >= 5.4.2.2,+ graphviz >= 2999.6.0.0 && < 2999.7.0.0,+ pandoc Exposed-Modules: Data.Graph.Analysis Data.Graph.Analysis.Types@@ -37,7 +45,9 @@ Data.Graph.Analysis.Reporting Data.Graph.Analysis.Reporting.Pandoc - Ghc-Options: -Wall- Ghc-Prof-Options: -auto-all+ Other-Modules: Data.Graph.Analysis.Internal,+ Paths_Graphalyze + Ghc-Options: -Wall+ Ghc-Prof-Options: -prof -auto-all }