Graphalyze 0.4 → 0.5
raw patch · 11 files changed
+279/−152 lines, 11 files
Files
- Data/Graph/Analysis.hs +19/−5
- Data/Graph/Analysis/Algorithms.hs +1/−8
- Data/Graph/Analysis/Algorithms/Clustering.hs +43/−56
- Data/Graph/Analysis/Algorithms/Common.hs +7/−7
- Data/Graph/Analysis/Algorithms/Directed.hs +8/−8
- Data/Graph/Analysis/Reporting.hs +66/−22
- Data/Graph/Analysis/Reporting/Pandoc.hs +66/−27
- Data/Graph/Analysis/Types.hs +4/−1
- Data/Graph/Analysis/Utils.hs +55/−14
- Data/Graph/Analysis/Visualisation.hs +9/−3
- Graphalyze.cabal +1/−1
Data/Graph/Analysis.hs view
@@ -29,7 +29,9 @@ -- * Result analysis -- $analfuncts lengthAnalysis,- classifyRoots+ classifyRoots,+ interiorChains,+ applyAlg ) where import Data.Graph.Analysis.Utils@@ -48,7 +50,7 @@ -- | The library version. version :: String-version = "0.4"+version = "0.5" {- | This represents the information that's being passed in that we want@@ -99,7 +101,7 @@ addLabel (x,y) = (x,y,()) -- The valid edges in the graph. graphEdges = catMaybes $ map validEdge (relationships params)- -- Validate an edge+ -- Validate a node validNode l = case (findNode l) of (Just n) -> Just (n,l) _ -> Nothing@@ -153,9 +155,21 @@ classifyRoots :: (Eq a) => GraphData a -> ([LNode a], [LNode a], [LNode a]) classifyRoots gd = (areWanted, notRoots, notWanted) where- g = graph gd wntd = wantedRoots gd- rts = rootsOf g+ rts = applyAlg rootsOf gd areWanted = intersect wntd rts notRoots = wntd \\ rts notWanted = 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 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
@@ -13,11 +13,9 @@ -- $algorithms module Data.Graph.Analysis.Algorithms.Common, module Data.Graph.Analysis.Algorithms.Directed,- module Data.Graph.Analysis.Algorithms.Clustering,- applyAlg+ module Data.Graph.Analysis.Algorithms.Clustering ) where -import Data.Graph.Analysis.Types import Data.Graph.Analysis.Algorithms.Common import Data.Graph.Analysis.Algorithms.Directed import Data.Graph.Analysis.Algorithms.Clustering@@ -28,8 +26,3 @@ 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
@@ -14,7 +14,6 @@ ( -- * Clustering Algorithms -- ** Non-deterministic algorithms -- $chinesewhispers- Whispering, chineseWhispers, -- ** Spatial Algorithms -- $relneighbours@@ -22,21 +21,21 @@ -- * Graph Collapsing -- $collapsing CNodes(..),- collapseGraph+ collapseGraph,+ trivialCollapse,+ cNodes ) where 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.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@@ -45,7 +44,7 @@ -- ----------------------------------------------------------------------------- {- $chinesewhispers- The Chinese Whispering Algorithm.+ The Chinese Whispers Algorithm. This is an adaptation of the algorithm described in: Biemann, C. (2006): Chinese Whispers - an Efficient Graph Clustering@@ -59,40 +58,29 @@ (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.-+ * Explicitly shuffle the node order for each iteration. 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).+ 2. Sort the nodes into some random order. Each node joins the+ most popular cluster in its neighbourhood (where popularity+ is defined as the sum of the node weightings in that cluster). 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+ Chinese Whispers is @O(number of edges)@.+-} -- | 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)+ -> gr (GenCluster a) b+chineseWhispers g gr = reCluster . fst $ fixPointBy eq whispering (gr',g) where eq = equal `on` fst ns = nodes gr@@ -105,57 +93,43 @@ -- | 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 :: (RandomGen g, DynGraph gr) => (gr (GenCluster a) b,g)+ -> Node -> (gr (GenCluster 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))+whisper :: (RandomGen g, Graph gr) => gr (GenCluster a) b -> g+ -> Context (GenCluster a) b -> (g,Context (GenCluster a) b)+whisper gr g (p,n,al,s) = (g',(p,n,al { clust = w' },s)) where (w',g') = case (neighbors gr n) of- [] -> (whisp al,g)+ [] -> (clust 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+-- | Choose which cluster to pick by taking the one with maximum number of+-- nodes. If more than one has the same maximum, choose one -- randomly.-chooseWhisper :: (RandomGen g) => g -> [LNode (Whispering a)]+chooseWhisper :: (RandomGen g) => g -> [LNode (GenCluster a)] -> (Int,g)-chooseWhisper g lns = pick maxWspWgts+chooseWhisper g lns = pick maxWsps 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+ whisps = map (second length) . groupElems clust $ map label lns+ maxWsps = map fst . snd . head $ groupElems (negate . snd) whisps -- | Convert the graph into a form suitable for the Chinese Whispers algorithm.-addWhispers :: (DynGraph gr) => gr a b -> gr (Whispering a) b+addWhispers :: (DynGraph gr) => gr a b -> gr (GenCluster 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-+ augment (p,n,l,s) = (p,n, GC { clust = n, nLbl = l }, s) {- @@ -207,7 +181,8 @@ 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.+ then Graphviz makes the apparent clusters more obvious. The actual+ algorithm is @O(n^2)@, where /n/ is the number of 'Node's in the graph. -} -- | The renamed CLUSTER algorithm. Attempts to cluster a graph by using@@ -216,7 +191,7 @@ -> gr (GenCluster a) b relativeNeighbourhood g = setCluster cMap g where- cMap = createLookup . concatMap rn $ componentsOf g+ cMap = createLookup $ rn g rn g' = nbrCluster rng where rng :: Gr () Int@@ -260,7 +235,7 @@ lune = intersect (rgnFor l1) (rgnFor l2) -- | Performs the actual clustering algorithm on the RNG.-nbrCluster :: (DynGraph gr) => gr a Int -> [[Node]]+nbrCluster :: (DynGraph gr) => gr a Int -> [NGroup] nbrCluster g | numNodes == 1 = [ns] -- Can't split up a single node. | eMax < 2*eMin = [ns] -- The inter-cluster relative neighbours@@ -310,6 +285,10 @@ -- | A collapsed node contains a list of nodes that it represents. data CNodes a = CN [LNode a] +-- | The 'LNode's stored in a 'CNodes'.+cNodes :: CNodes a -> [LNode a]+cNodes (CN lns) = lns+ -- | 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@@ -322,6 +301,15 @@ cg = makeCollapsible g interestingParts = [cliquesIn', cyclesIn', chainsIn'] +-- | 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+ lns = labels cg+ -- | Allow the graph to be collapsed. makeCollapsible :: (DynGraph gr) => gr a b -> gr (CNodes a) b makeCollapsible = nlmap (CN . return)@@ -337,7 +325,6 @@ (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'
Data/Graph/Analysis/Algorithms/Common.hs view
@@ -138,7 +138,7 @@ isClique _ [] = False isClique gr ns = null . foldl1' intersect .- map ((\\ ns) . corecursive gr) $ ns+ map ((\\ ns) . twoCycle gr) $ ns -- | Find all regular subgraphs of the given graph. findRegular :: (Graph g) => g a b -> [[Node]]@@ -156,7 +156,7 @@ regularOf :: (Graph g) => g a b -> Node -> [[Node]] regularOf gr n = map (n:) (alsoRegular gr crs) where- crs = corecursive gr n+ crs = twoCycle gr n -- | Recursively find all regular subgraphs only containing nodes -- in the given list.@@ -166,21 +166,21 @@ alsoRegular g (n:ns) = [n] : rs ++ (alsoRegular g ns) where rs = map (n:) (alsoRegular g $ intersect crn ns)- crn = corecursive g n+ crn = twoCycle 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)+twoCycle :: (Graph g) => g a b -> Node -> [Node]+twoCycle 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+isRegular g ns = all allTwoCycle split where -- Node + Rest of list split = zip ns tns' tns' = tail $ tails ns- allCorecursive (n,rs) = null $ rs \\ (corecursive g n)+ allTwoCycle (n,rs) = null $ rs \\ (twoCycle g n) -- ----------------------------------------------------------------------------- {- $cycles
Data/Graph/Analysis/Algorithms/Directed.hs view
@@ -94,19 +94,19 @@ -- | Find all leaves of the graph. leavesOf :: (Graph g) => g a b -> LNGroup a-leavesOf = endBy pre+leavesOf = endBy suc -- | Find all leaves of the graph. leavesOf' :: (Graph g) => g a b -> NGroup-leavesOf' = endBy' pre+leavesOf' = endBy' suc -- | Returns @True@ if this 'LNode' is a leaf. isLeaf :: (Graph g) => g a b -> LNode a -> Bool-isLeaf = endNode pre+isLeaf = endNode suc -- | Returns @True@ if this 'Node' is a leaf. isLeaf' :: (Graph g) => g a b -> Node -> Bool-isLeaf' = endNode' pre+isLeaf' = endNode' suc -- ----------------------------------------------------------------------------- @@ -116,19 +116,19 @@ -- | Find all singletons of the graph. singletonsOf :: (Graph g) => g a b -> LNGroup a-singletonsOf = endBy pre+singletonsOf = endBy neighbors -- | Find all singletons of the graph. singletonsOf' :: (Graph g) => g a b -> NGroup-singletonsOf' = endBy' pre+singletonsOf' = endBy' neighbors -- | Returns @True@ if this 'LNode' is a singleton. isSingleton :: (Graph g) => g a b -> LNode a -> Bool-isSingleton = endNode pre+isSingleton = endNode neighbors -- | Returns @True@ if this 'Node' is a singleton. isSingleton' :: (Graph g) => g a b -> Node -> Bool-isSingleton' = endNode' pre+isSingleton' = endNode' neighbors -- -----------------------------------------------------------------------------
Data/Graph/Analysis/Reporting.hs view
@@ -21,13 +21,15 @@ today, tryCreateDirectory, createGraph,- maximumSize+ createSize,+ unDotPath ) where import Data.GraphViz import Data.GraphViz.Attributes import Data.Graph.Analysis.Visualisation +import Data.Maybe import Data.Time import Control.Exception import System.Directory@@ -49,14 +51,17 @@ instance of 'DocumentGenerator'. -} data Document = Doc { -- | Document location- rootDirectory :: FilePath,- fileFront :: String,+ rootDirectory :: FilePath,+ fileFront :: String,+ -- | The sub-directory of 'rootDirectory',+ -- where graphs are to be created.+ graphDirectory :: FilePath, -- | Pre-matter- title :: DocInline,- author :: String,- date :: String,+ title :: DocInline,+ author :: String,+ date :: String, -- | Main-matter- content :: [DocElement]+ content :: [DocElement] } -- | Represents the class of document generators.@@ -81,20 +86,22 @@ | Enumeration [DocElement] | Itemized [DocElement] | Definition DocInline DocElement- | DocImage DocInline Location | GraphImage DocGraph- deriving (Show) +-- | Inline elements of a document. data DocInline = Text String | BlankSpace | Grouping [DocInline] | Bold DocInline | Emphasis DocInline | DocLink DocInline Location- deriving (Show)+ | DocImage DocInline Location -type DocGraph = (FilePath,DocInline,DotGraph)+-- | Let the 'DocumentGenerator' instance apply extra settings, such as size.+type AttrsToGraph = [Attribute] -> DotGraph +type DocGraph = (FilePath,DocInline,AttrsToGraph)+ -- ----------------------------------------------------------------------------- {- $utilities@@ -124,20 +131,57 @@ isRight _ = False -- | Attempts to creates a png file (with the given filename in the--- given directory) and - if successful - returns a 'DocImage' link.-createGraph :: FilePath -> DocGraph -> IO (Maybe DocElement)-createGraph fp (fn,inl,dg) = do created <- runGraphviz dg output filename'- if created- then return (Just img)- else return Nothing+-- given directory) from the graph using the given attributes.+-- 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]+ -> 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+ Nothing -> rt eImg+ (Just as') -> do rt =<< gI as' DocLink fn' (toImg eImg) eImg+ else return Nothing where+ fn' = fn ++ "-large"+ i2e i = Just (i,Paragraph [i])+ rt = return . fmap snd+ 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++-- | Create the inline image/link from the given DocGraph.+graphImage :: FilePath -> FilePath -> [Attribute]+ -> (DocInline -> Location -> DocInline)+ -> DocGraph -> IO (Maybe DocInline)+graphImage fp gfp as link (fn,inl,ag)+ = do created <- runGraphviz dg output filename'+ if created+ then return (Just img)+ else return Nothing+ where+ dg = ag as+ fn' = unDotPath fn ext = "png" output = Png- filename = fn <.> ext+ filename = gfp </> fn' <.> ext filename' = fp </> filename loc = File filename- img = DocImage inl loc+ img = link inl loc --- | The recommended maximum size for graphs.-maximumSize :: Attribute-maximumSize = Size 15 10+-- | 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)++-- | Replace all @.@ with @-@ in the given 'FilePath', since some output+-- formats (e.g. LaTeX) don't like extraneous @.@'s in the filename.+unDotPath :: FilePath -> FilePath+unDotPath = map replace+ where+ replace '.' = '-'+ replace c = c
Data/Graph/Analysis/Reporting/Pandoc.hs view
@@ -27,6 +27,7 @@ -- TODO : the ability to create multiple files. import Data.Graph.Analysis.Reporting+import Data.GraphViz.Attributes(Attribute) import Data.List import Data.Maybe@@ -43,25 +44,28 @@ -} pandocHtml :: PandocDocument-pandocHtml = PD { writer = writeHtmlString- , extension = "html"- , header = "" -- Header will be included+pandocHtml = pd { writer = writeHtmlString+ , extension = "html"+ , header = "" -- Header will be included+ , extGraphSize = Just $ defaultWidth * 10 } pandocLaTeX :: PandocDocument-pandocLaTeX = PD { writer = writeLaTeX+pandocLaTeX = pd { writer = writeLaTeX , extension = "tex" , header = defaultLaTeXHeader+ -- 4.5" should be less than \textwidth in LaTeX.+ , graphSize = 4.5 } pandocRtf :: PandocDocument-pandocRtf = PD { writer = writeRTF+pandocRtf = pd { writer = writeRTF , extension = "rtf" , header = defaultRTFHeader } pandocMarkdown :: PandocDocument-pandocMarkdown = PD { writer = writeMarkdown+pandocMarkdown = pd { writer = writeMarkdown , extension = "text" , header = "" }@@ -72,11 +76,33 @@ Pandoc definition. -} -data PandocDocument = PD { writer :: WriterOptions -> Pandoc -> String- , extension :: FilePath- , header :: String+-- | Definition of a Pandoc Document. Size measurements are in inches,+-- and a 6:4 ratio is used for width:length.+data PandocDocument = PD { -- | The Pandoc document style+ writer :: WriterOptions -> Pandoc -> String,+ -- | The file extension used+ 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 } +-- | Some default sizes. Note that all other fields of 'PandocDocument'+-- still need to be defined.+pd :: PandocDocument+pd = PD { writer = undefined,+ extension = undefined,+ header = undefined,+ graphSize = defaultWidth,+ extGraphSize = Nothing+ }++defaultWidth :: Double+defaultWidth = 10+ instance DocumentGenerator PandocDocument where createDocument = createPandoc docExtension = extension@@ -91,24 +117,32 @@ -- | Used when traversing the document structure. data PandocProcess = PP { secLevel :: Int , filedir :: FilePath+ , graphdir :: FilePath+ , grSize :: [Attribute]+ , eGSize :: Maybe [Attribute] } -- | Start with a level 1 heading. defaultProcess :: PandocProcess defaultProcess = PP { secLevel = 1- , filedir = ""+ , graphdir = undefined+ , filedir = undefined+ , grSize = undefined+ , eGSize = undefined } -- | Create the document. createPandoc :: PandocDocument -> Document -> IO (Maybe FilePath) createPandoc p d = do created <- tryCreateDirectory dir+ -- If the first one fails, so will this one.+ tryCreateDirectory $ dir </> gdir if (not created) then failDoc else do elems <- multiElems pp (content d) case elems of Just es -> do let es' = htmlAuthDt : es- pd = Pandoc meta es'- doc = convert pd+ pnd = Pandoc meta es'+ doc = convert pnd wr <- tryWrite doc case wr of (Right _) -> success@@ -116,12 +150,18 @@ Nothing -> failDoc where dir = rootDirectory d+ gdir = graphDirectory d auth = author d dt = date d meta = makeMeta (title d) auth dt -- Html output doesn't show date and auth anywhere by default. htmlAuthDt = htmlInfo auth dt- pp = defaultProcess { filedir = dir }+ createSize' = return . createSize+ pp = defaultProcess { filedir = dir+ , graphdir = gdir+ , grSize = createSize' (graphSize p)+ , eGSize = fmap createSize' (extGraphSize p)+ } opts = writerOptions { writerHeader = (header p) } convert = (writer p) opts file = dir </> (fileFront d) <.> (extension p)@@ -144,7 +184,7 @@ htmlInfo auth dt = RawHtml html where heading = "<h1>Document Information</h1>"- html = unlines [heading,htmlize auth, htmlize dt]+ html = unlines [heading, htmlize auth, htmlize dt] htmlize str = "<blockquote><p><em>" ++ str ++ "</em></p></blockquote>" -- | Link conversion@@ -153,13 +193,14 @@ loc2target (File file) = (file,"") -- | Conversion of simple inline elements.-inlines :: DocInline -> [Inline]-inlines (Text str) = [Str str]-inlines BlankSpace = [Space]-inlines (Grouping grp) = concat . intersperse [Space] $ map inlines grp-inlines (Bold inl) = [Strong (inlines inl)]-inlines (Emphasis inl) = [Emph (inlines inl)]-inlines (DocLink inl loc) = [Link (inlines inl) (loc2target loc)]+inlines :: DocInline -> [Inline]+inlines (Text str) = [Str str]+inlines BlankSpace = [Space]+inlines (Grouping grp) = concat . intersperse [Space] $ map inlines grp+inlines (Bold inl) = [Strong (inlines inl)]+inlines (Emphasis inl) = [Emph (inlines inl)]+inlines (DocLink inl loc) = [Link (inlines inl) (loc2target loc)]+inlines (DocImage inl loc) = [Image (inlines inl) (loc2target loc)] {- | Conversion of complex elements. The only reason it's in the IO monad is@@ -195,11 +236,10 @@ xdef = fmap (return . (,) x') def' return (fmap (return . DefinitionList) xdef) -elements _ (DocImage inl loc) = do let img = Image (inlines inl)- (loc2target loc)- return $ Just [Plain [img]]--elements p (GraphImage dg) = do el <- createGraph (filedir p) dg+elements p (GraphImage dg) = do el <- createGraph (filedir p)+ (graphdir p)+ (grSize p)+ (eGSize p) dg case el of Nothing -> return Nothing Just img -> elements p img@@ -210,7 +250,6 @@ 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]])
Data/Graph/Analysis/Types.hs view
@@ -69,7 +69,10 @@ nodelabel :: a -> String -- | A generic cluster-label type.-data GenCluster a = GC Int a+data GenCluster a = GC { clust :: Int+ , nLbl :: a+ }+ deriving (Eq,Show) instance (Show a) => ClusterLabel (GenCluster a) Int where cluster (GC c _) = c
Data/Graph/Analysis/Utils.hs view
@@ -16,8 +16,10 @@ module Data.Graph.Analysis.Utils ( -- * Graph functions -- ** Data extraction+ -- $extracting node, label,+ labels, edge, eLabel, addLabels,@@ -30,21 +32,28 @@ mkSimple, nlmap, -- ** Graph layout- -- | These next two are re-exported from "Data.GraphViz"+ -- $spatial+ -- These next two are re-exported from "Data.GraphViz" AttributeNode, AttributeEdge, dotizeGraph, toPosGraph, getPositions, -- ** Cluster functions+ -- $cluster createLookup, setCluster, assignCluster,+ reCluster,+ reClusterBy,+ clusterCount, -- * List functions+ -- $list single, longerThan, addLengths, longest,+ lengthSort, groupElems, sortMinMax, blockPrint,@@ -84,21 +93,25 @@ -- ----------------------------------------------------------------------------- --- | Extracting data from graphs.+-- $extracting Extracting data from graphs. -- | The node number of an 'LNode'. node :: LNode a -> Node node = fst --- | The label of an 'LNode'+-- | The label of an 'LNode'. label :: LNode a -> a label = snd +-- | The labels of all nodes in a tree.+labels :: (Graph g) => g a b -> [a]+labels = map label . labNodes+ -- | Extract the 'Edge' from the 'LEdge'. edge :: LEdge b -> Edge edge (n1,n2,_) = (n1,n2) --- | The label of an 'LEdge'+-- | The label of an 'LEdge'. eLabel :: LEdge b -> b eLabel (_,_,b) = b @@ -121,7 +134,7 @@ -- ----------------------------------------------------------------------------- --- | Manipulating graphs.+-- Manipulating graphs. {- | Make the graph undirected, i.e. for every edge from A to B, there@@ -139,7 +152,7 @@ dupEdges (p,n,l,s) = (ps',n,l,ps) where ps = nub $ p ++ s- ps' = snd $ partition isLoop ps+ ps' = filter (not . isLoop) ps isLoop (_,n') = n == n' -- | This is a pseudo-inverse of 'undir': any edges that are both successor@@ -170,9 +183,12 @@ -- ----------------------------------------------------------------------------- -{- |+{- $spatial Spatial positioning of graphs. Use the 'graphToGraph' 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,@@ -209,11 +225,11 @@ -- ----------------------------------------------------------------------------- --- | Cluster utility functions.+-- $cluster Cluster utility functions. -- | Create a cluster-lookup 'IntMap'. createLookup :: [[Node]] -> IntMap Int-createLookup = IMap.fromList . concatMap addCluster . zip [1..]+createLookup = IMap.fromList . concatMap addCluster . zip [1..] . lengthSort where addCluster (k,ns) = map (flip (,) k) ns @@ -228,9 +244,32 @@ 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+reCluster g = reClusterBy cs' g+ where+ cnts = IMap.toList $ clusterCount g+ cPop = map fst $ sortBy (flip compare `on` snd) cnts+ cs' = IMap.fromList $ zip cPop [1..]++-- | Change the cluster values using the given lookup 'IntMap'.+reClusterBy :: (DynGraph g) => IntMap Int -> g (GenCluster a) b+ -> g (GenCluster a) b+reClusterBy m = nmap newClust+ where+ 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+clusterCount = ufold incMap IMap.empty+ where+ incMap (_,_,l,_) = IMap.insertWith ins (clust l) 1+ ins _ c = c + 1+ -- ----------------------------------------------------------------------------- --- | List utility functions.+-- $list List utility functions. -- | Return true if and only if the list contains a single element. single :: [a] -> Bool@@ -248,9 +287,11 @@ -- | Returns the longest list in a list of lists. longest :: [[a]] -> [a]-longest = snd . maximumBy (compare `on` fst)- . addLengths+longest = head . lengthSort +lengthSort :: [[a]] -> [[a]]+lengthSort = map snd . sortBy (flip compare `on` fst) . addLengths+ -- | Group elements by the given grouping function. groupElems :: (Ord b) => (a -> b) -> [a] -> [(b,[a])] groupElems f = map createGroup@@ -392,7 +433,7 @@ -- ----------------------------------------------------------------------------- --- | Statistics functions.+-- Statistics functions. -- | An efficient mean function by Don Stewart, available from: -- <http://cgi.cse.unsw.edu.au/~dons/blog/2008/05/16#fast>@@ -422,7 +463,7 @@ -- ----------------------------------------------------------------------------- --- | Other utility functions.+-- Other utility functions. -- | Find the fixed point of a function with the given initial value. fixPoint :: (Eq a) => (a -> a) -> a -> a
Data/Graph/Analysis/Visualisation.hs view
@@ -181,7 +181,7 @@ runGraphvizCommand cmd gr t fp = runGraphvizInternal (show cmd) gr t fp -- | This command should /not/ be available outside this module, as--- it isn't safe: running an arbitrary command will crash the program.+-- it isn't safe: running an arbitrary command will crash the programme. runGraphvizInternal :: String -> DotGraph -> GraphvizOutput -> FilePath -> IO Bool runGraphvizInternal cmd gr t fp@@ -283,5 +283,11 @@ showCycle lns@(ln:_) = showPath (lns ++ [ln]) -- | Show a group of nodes, with no implicit ordering.-showNodes :: (Show a) => LNGroup a -> String-showNodes = blockPrintList . map label+showNodes :: (Show a) => LNGroup a -> String+showNodes [] = ""+showNodes lns = blockPrint' . addCommas+ $ map (show . label) lns+ where+ addCommas [] = []+ addCommas [l] = [l]+ addCommas (l:ls) = (l ++ ", ") : addCommas ls
Graphalyze.cabal view
@@ -1,5 +1,5 @@ Name: Graphalyze-Version: 0.4+Version: 0.5 Synopsis: Graph-Theoretic Analysis library. Description: A library to use graph theory to analyse the relationships inherent in discrete data.