examples/doc/graphs-multigraph.shape

   1 /** This file is part of Shapes.
   2  **
   3  ** Shapes is free software: you can redistribute it and/or modify
   4  ** it under the terms of the GNU General Public License as published by
   5  ** the Free Software Foundation, either version 3 of the License, or
   6  ** any later version.
   7  **
   8  ** Shapes is distributed in the hope that it will be useful,
   9  ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  ** GNU General Public License for more details.
  12  **
  13  ** You should have received a copy of the GNU General Public License
  14  ** along with Shapes.  If not, see <http://www.gnu.org/licenses/>.
  15  **
  16  ** Copyright 2014 Henrik Tidefelt
  17  **/
  18
  19 ##needs ..Shapes..Data / seq-support
  20
  21 ##lookin ..Shapes
  22 ##lookin ..Shapes..Data
  23 ##lookin ..Shapes..Geometry
  24 ##lookin ..Shapes..Layout
  25 ##lookin ..Shapes..Graphics
  26
  27 /** Graph layout function for nodes on a circle.
  28  ** (Ignoring any previous content of node values.)
  29  **/
  30 circleGraphLayout: \ g radius:3cm →
  31 {
  32   delta: 360° / g.node_count
  33   [g.with_node_values [fmap (\ node → (> coords:radius*[dir node.index*delta] <)) g.nodes]]
  34 }
  35
  36 /** Basic rendering of a graph with nodes layout.
  37  **/
  38 renderMultiGraph: \ g →
  39 {
  40   /** Rendering parameters **/
  41   nodeRadius: 0.75 * Text..@size
  42   multiplicityRadius: 0.7 * Text..@size
  43
  44   /** A circle at each node. **/
  45   nodeCircles: [g.nodes.foldl \ s n → (s & [[shift n.value.coords] stroke[][circle nodeRadius]]) null]
  46
  47   /** Node keys. **/
  48   nodeKeys: [g.nodes.foldl \ s n → (s & [[shift n.value.coords] (Text..newText << (String..newString << n.key) ) >> center_x >> [shift (0,~0.5*nodeRadius)]]) null]
  49
  50   /** Draw each multiedge as a straigt line between the nodes. **/
  51   edgePath: \ me →
  52   {
  53     source: me.source.value.coords
  54     target: me.target.value.coords
  55     tmp: source--target
  56     (source + nodeRadius * tmp.begin.T)--(target + nodeRadius * tmp.end.rT)
  57   }
  58
  59   /** Arrow head for directed multiedges. **/
  60   edgeArrow: [ShapesArrow width:4bp ...]
  61
  62   /** A label showing the multiplicity of a multiedge, positioned inside an imaginary circle of radius multiplicityRadius. **/
  63   multiplicityLabel: \ count →
  64     (Text..newText << (String..newString << [String..sprintf `(%d)´ count]) ) >> center_x >> [shift (0,~0.5 * multiplicityRadius)]
  65
  66   /** Stroke an edge path and add a multiplicity label to the side of the stroke. **/
  67   drawMultiEdge: \ me →
  68   {
  69     p: [edgePath me]
  70     sl: [p [Numeric..Math..abs p]/2]
  71     (Traits..@width: 3 * Traits..@width | [stroke p head:[if me.directed? edgeArrow NO_ARROW]])
  72     &
  73     [[shift sl.p + sl.N * multiplicityRadius] [multiplicityLabel me.count]]
  74   }
  75
  76   /** Draw all edges. **/
  77   edgeStrokes: [g.multiedges.foldl \ s me → (s & [drawMultiEdge me]) null]
  78
  79   /** Combine all results. **/
  80   nodeCircles & nodeKeys & edgeStrokes
  81 }
  82
  83 /** Example graph.
  84  **/
  85 g: [graph undirected:true parallel:true
  86       nodes: [list 'a 'b 'c]
  87       edges: [list
  88                (> 'a 'b label:'even <) (> 'a 'b label:'odd <)
  89                (> 'a 'c label:'even <) (> 'a 'c label:'odd <)
  90                (> 'b 'c label:'even <) (> 'b 'c label:'odd <)
  91                (> 'c 'b label:'even <) (> 'c 'b label:'odd <)
  92              ]
  93    ]
  94
  95 /** Apply layout and rendering functions.
  96  **/
  97 Text..@size:9bp & Traits..@width:0.3bp | [renderMultiGraph [circleGraphLayout g]]