diagrams-graphviz-1.4: Graph layout and drawing with GrahpViz and diagrams

Copyright(c) 2014, 2015 Brent Yorgey
LicenseBSD-style (see LICENSE)
Maintainerbyorgey@gmail.com
Safe HaskellNone
LanguageHaskell2010

Diagrams.TwoD.GraphViz

Description

A simple module with some "glue code" necessary for using diagrams and GraphViz (http://www.graphviz.org/) in conjunction. GraphViz is great at laying out graphs but terrible at drawing them, so why not let GraphViz do what it is good at, and use a dedicated drawing library for the actual drawing?

In all the following examples we will make use of this example graph:

hex = mkGraph [0..19]
        (   [ (v, (v+1)`mod`6, ()) | v <- [0..5] ]
         ++ [ (v, v+k, ()) | v <- [0..5], k <- [6,12] ]
         ++ [ (2,18,()), (2,19,()), (15,18,()), (15,19,()), (18,3,()), (19,3,()) ]
        )

The easiest thing to do is to just use the provided simpleGraphDiagram function to create a default diagram quickly:

{-# LANGUAGE NoMonomorphismRestriction #-}

import           Diagrams.Backend.Rasterific.CmdLine
import           Diagrams.Prelude
import           Diagrams.TwoD.GraphViz

main = theGraph >>= defaultMain
  where
    theGraph :: IO (Diagram B)
    theGraph = simpleGraphDiagram Dot hex

Here is how we would produce a similar image, but with more control over the specific ways that things are drawn:

{-# LANGUAGE NoMonomorphismRestriction #-}

import           Diagrams.Backend.Rasterific.CmdLine
import           Diagrams.Prelude
import           Diagrams.TwoD.GraphViz

import           Data.GraphViz
import           Data.GraphViz.Commands

graphvizExample1 = do
  hex' <- layoutGraph Dot hex
  let hexDrawing :: Diagram B
      hexDrawing = drawGraph
                     (const $ place (circle 19))
                     (\_ p1 _ p2 _ p -> arrowBetween' (opts p) p1 p2)
                     hex'
      opts p = with & gaps .~ 16 & arrowShaft .~ (unLoc . head $ pathTrails p)
  return (hexDrawing # frame 1)

There are a few quirks to note.

  • GraphViz seems to assume the circular nodes have radius 19.
  • Note how we draw an arrow for each edge, and use the path computed by GraphViz (which might be curved) to specify the shaft for the arrow.

Here is a slightly modified example, which tells GraphViz not to use any arrowheads on the edges:

{-# LANGUAGE NoMonomorphismRestriction #-}

import           Diagrams.Backend.Rasterific.CmdLine
import           Diagrams.Prelude
import           Diagrams.TwoD.GraphViz

import           Data.GraphViz
import           Data.GraphViz.Attributes.Complete
import           Data.GraphViz.Commands

main = do
  let params :: GraphvizParams Int v e () v
      params = defaultDiaParams
               { fmtEdge = const [arrowTo noArrow] }
  hex' <- layoutGraph' params Dot hex
  let hexDrawing :: Diagram B
      hexDrawing = drawGraph
                     (const $ place (circle 19))
                     (\_ _ _ _ _ p -> stroke p)
                     hex'
  mainWith $ hexDrawing # frame 1
  • The type signature on params is unfortunately necessary; otherwise some ambiguity errors arise.
  • Note how in this simple case we can just draw the path for each edge directly.

Synopsis

Documentation

mkGraph :: Ord v => [v] -> [(v, v, e)] -> Gr v e Source #

Construct a graph from a list of vertex labels (which must be unique) and a list of (directed) edges. The result is suitable as input to layoutGraph.

layoutGraph :: forall gr v e. Graph gr => GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) Source #

Round-trip a graph through an external graphviz layout algorithm, and read back in a version annotated with explicit positioning information. The result is suitable for input to drawGraph or, more directly, to getGraph. The GraphvizCommand should be something like Dot or Neato; to access them you should import Data.GraphViz.Command. For more control over the functioning of graphviz, see layoutGraph'.

layoutGraph' :: (Ord cl, Graph gr) => GraphvizParams Node v e cl l -> GraphvizCommand -> gr v e -> IO (gr (AttributeNode v) (AttributeEdge e)) Source #

Like layoutGraph, but with an extra GraphvizParams parameter controlling various aspects of the graphviz layout process. See defaultDiaParams, and the Data.GraphViz.Attributes and Data.GraphViz.Attributes.Complete modules.

defaultDiaParams :: GraphvizParams Node v e cl v Source #

Some convenient parameters for GraphViz which work better for diagrams than the default. In particular, use circular nodes (instead of the default ovals), and allow cubic splines for edges.

drawGraph :: (Ord v, Semigroup m) => (v -> P2 Double -> QDiagram b V2 Double m) -> (v -> P2 Double -> v -> P2 Double -> e -> Path V2 Double -> QDiagram b V2 Double m) -> Gr (AttributeNode v) (AttributeNode e) -> QDiagram b V2 Double m Source #

Render an annotated graph as a diagram, given functions controlling the drawing of vertices and of edges. The first function is given the label and location of each vertex. The second function, for each edge, is given the label and location of the first vertex, the label and location of the second vertex, and the label and path corresponding to the edge.

getGraph :: Ord v => Gr (AttributeNode v) (AttributeNode e) -> (Map v (P2 Double), [(v, v, e, Path V2 Double)]) Source #

Decompose an annotated, concretely laid-out graph into a map from vertex labels to points and a collection of edges associating vertex and edge labels to Path values. This is used internally by drawGraph, but exported since it may also be useful for more fine-grained control over graph drawing.

simpleGraphDiagram :: (Ord v, Renderable (Path V2 Double) b) => GraphvizCommand -> Gr v e -> IO (QDiagram b V2 Double Any) Source #

Just draw the nodes of the graph as circles and the edges as arrows between them.