All scripts and input files required to generate these examples are available in the GraphViz2 repo.
# Annotation: Demonstrates the transitive 6-net, also known as Heawood's graph.
#
# Reverse-engineered from graphs/directed/Heawood.gv from the Graphviz distro for V 2.26.3.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2 -> new(
global => {name => 'Heawood'},
graph => {rankdir => 'TB'},
);
$graph->default_edge(color => 'black');
$graph->default_node(
fontname => "Arial",
shape => "circle",
width => "0.50000",
height => "0.50000",
color => "black",
);
$graph->add_edge(from => $_, to => ($_ + 1) ) for 0 .. 12;
$graph -> add_edge(from => 13, to => 0);
$graph -> add_edge(from => 0, to => 5, len => 2.5);
$graph -> add_edge(from => 2, to => 7, len => 2.5);
$graph -> add_edge(from => 4, to => 9, len => 2.5);
$graph -> add_edge(from => 6, to => 11, len => 2.5);
$graph -> add_edge(from => 8, to => 13, len => 2.5);
$graph -> add_edge(from => 10, to => 1, len => 2.5);
$graph -> add_edge(from => 12, to => 3, len => 2.5);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec->catfile('html', "Heawood.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates empty strings for node names and labels.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph -> add_node(name => '', label => ''); # Same as add_node().
$graph -> add_node(name => 'Anonymous label 1', label => '');
$graph -> add_node(name => 'Anonymous label 2', label => '');
$graph -> add_edge(from => '', to => ''); # This uses the name '', and hence the first node.
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "anonymous.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates calling circo instead of dot.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {
rankdir => 'TB',
page => '8.25,10.75',
rotate => '90',
margin => '0.125',
size => '8.25,10.75'
},
node => {shape => 'oval'},
);
$graph -> add_edge(from => 'Here', to => 'There');
$graph -> add_edge(from => 'There', to => 'Everywhere');
$graph -> add_edge(from => 'Everywhere', to => 'Here');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "circo.$format");
$graph->run(driver => 'circo', format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a cluster.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {clusterrank => 'local', compound => 1, rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph -> push_subgraph(name => 'cluster_Europe', graph => {
bgcolor => 'grey', label => 'Europe'
});
$graph -> add_node(name => 'London', color => 'blue');
$graph -> add_node(
name => 'Paris', color => 'green', label => 'City of\nlurve',
);
$graph -> add_edge(from => 'London', to => 'Paris');
$graph -> add_edge(from => 'Paris', to => 'London');
$graph -> pop_subgraph;
$graph -> add_node(name => 'New York', color => 'yellow');
$graph -> add_edge(from => 'London', to => 'New York', label => 'Far');
$graph -> push_subgraph(name => 'cluster_Australia', graph => {
bgcolor => 'grey', label => 'Australia',
});
$graph -> add_node(name => 'Victoria', color => 'blue');
$graph -> add_node(name => 'New South Wales', color => 'green');
$graph -> add_node(name => 'Tasmania', color => 'red');
$graph -> add_edge(from => 'Victoria', to => 'New South Wales');
$graph -> add_edge(from => 'Victoria', to => 'Tasmania');
$graph -> pop_subgraph;
$graph -> add_edge(
from => 'Victoria',
to => 'London',
ltail => 'cluster_Australia',
lhead => 'cluster_Europe',
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "cluster.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a HTML label without a table.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = 1;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {
label => "HTML label demo # $id - Using \\< ... \\>",
rankdir => 'TB',
},
node => {shape => 'oval'},
);
$graph -> default_node(shape => 'circle', style => 'filled');
$graph -> default_edge(arrowsize => 4);
$graph -> add_node(name => 'Carnegie', shape => 'circle');
$graph -> add_node(name => 'Carnegie', color => 'red');
$graph -> default_node(style => 'rounded');
$graph -> add_node(
name => 'Murrumbeena',
shape => 'doublecircle',
color => 'green',
label =>
'<Murrumbeena<br/><font color="#0000ff">Victoria</font><br/>Australia>',
);
$graph -> add_node(
name => 'Oakleigh',
shape => 'record',
color => 'blue',
label => ['West Oakleigh', 'East Oakleigh'],
);
$graph -> add_edge(
from => 'Murrumbeena',
to => 'Carnegie',
arrowsize => 2,
label => '<Bike<br/>Train<br/>Stroll>',
);
$graph -> default_edge(arrowsize => 1);
$graph -> add_edge(
from => 'Murrumbeena',
to => 'Oakleigh:port1',
color => 'brown',
label => '<Meander<br/>Promenade<br/>Saunter>',
);
$graph -> add_edge(
from => 'Murrumbeena',
to => 'Oakleigh:port2',
color => 'green',
label => '<Drive<br/>Run<br/>Sprint>',
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "html.labels.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a HTML label with a table.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = 2;
my $graph = GraphViz2->new(
global => {directed => 1},
graph => {
label => "HTML label demo # $id - Using \\<\\<table\\> ... " .
"\\</table\\>\\>",
},
);
$graph->add_node(
label => q|
<<table bgcolor = 'white'>
<tr>
<td bgcolor = 'palegreen'>The green node is the start node</td>
</tr>
<tr>
<td bgcolor = 'lightblue'>Lightblue nodes are for lexeme attributes</td>
</tr>
<tr>
<td bgcolor = 'orchid'>Orchid nodes are for lexemes</td>
</tr>
<tr>
<td bgcolor = 'goldenrod'>Golden nodes are for actions</td>
</tr>
<tr>
<td bgcolor = 'firebrick1'>Red nodes are for events</td>
</tr>
</table>>
|,
name => 'Legend',
shape => 'plaintext',
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "html.labels.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates HTML labels with newlines and double-quotes.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = 3;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "HTML label demo # $id - Fixing newlines", rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph -> add_node(name => 'One', label => '
<One<br/><font color="#0000ff">Blue</font><br/>>
');
$graph -> add_node(name => 'Two', label => '<
Two<br/><font color="#00ff00">Green</font><br/>
>');
$graph -> add_node(name => 'Three', color => 'red', label => '
<<table border="1"><tr><td align="left">Three</td></tr><tr align="right"><td>Red</td></tr></table>>
');
$graph -> add_node(name => 'Four', color => 'magenta', label => '<
<table border="1"><tr><td align="left">Four<br />magenta</td></tr></table>
>');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "html.labels.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates Y-shaped edges between 3 nodes.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my %junction = (color => 'grey', shape => 'point', width => 0);
# Note: arrowhead is case-sensitive (i.e. arrowHead does not work).
my %headless_arrow = (arrowhead => 'none');
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {shape => 'oval', style => 'filled'},
);
# Node set 1:
$graph->add_node(name => 'Carnegie', color => 'aquamarine');
$graph->add_node(name => 'Murrumbeena', color => 'bisque');
$graph->add_node(name => 'Oakleigh', color => 'blueviolet');
$graph->add_node(name => 'one', %junction); # 1st of 2 junction nodes
$graph->add_edge(from => 'Murrumbeena', to => 'one', %headless_arrow);
$graph->add_edge(from => 'Carnegie', to => 'one', %headless_arrow);
$graph->add_edge(from => 'one', to => 'Oakleigh');
# Node set 2:
$graph->add_node(name => 'Ashburton', color => 'lawngreen');
$graph->add_node(name => 'Chadstone', color => 'coral');
$graph->add_node(name => 'Waverley', color => 'crimson');
$graph->add_node(name => 'two', %junction); # 2nd of 2 junction nodes
$graph->add_edge(from => 'Ashburton', to => 'two', %headless_arrow);
$graph->add_edge(from => 'Chadstone', to => 'two', %headless_arrow);
$graph->add_edge(from => 'two', to => 'Waverley');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec->catfile('html', "jointed.edges.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates non-cluster subgraphs via a macro.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
sub macro {
my($graph, $name, $node_1, $node_2) = @_;
$graph->push_subgraph(
name => $name,
graph => {label => $name},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => $node_1, shape => 'hexagon');
$graph->add_node(name => $node_2, color => 'orange');
$graph->add_edge(from => $node_1, to => $node_2);
$graph->pop_subgraph;
}
my $id = '1';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "Macro demo $id - Non-cluster sub-graphs", rankdir => 'TB'},
);
macro($graph, 'One', 'Chadstone', 'Waverley');
macro($graph, 'Two', 'Hughesdale', 'Notting Hill');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "macro.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates linked non-cluster subgraphs via a macro.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
sub macro {
my ($graph, $name, $node_1, $node_2) = @_;
$graph->push_subgraph(
name => $name,
graph => {label => $name},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => $node_1, shape => 'hexagon');
$graph->add_node(name => $node_2, color => 'orange');
$graph->add_edge(from => $node_1, to => $node_2);
$graph->pop_subgraph;
}
my $id = '2';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "Macro demo $id - Linked non-cluster sub-graphs", rankdir => 'TB'},
node => {shape => 'oval'},
);
macro($graph, 'One', 'Chadstone', 'Waverley');
macro($graph, 'Two', 'Hughesdale', 'Notting Hill');
$graph->add_edge(from => 'Chadstone', to => 'Notting Hill', minlen => 2);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "macro.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates cluster subgraphs via a macro.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
sub macro {
my ($graph, $name, $node_1, $node_2) = @_;
$graph->push_subgraph(
name => $name,
graph => {label => $name},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => $node_1, shape => 'hexagon');
$graph->add_node(name => $node_2, color => 'orange');
$graph->add_edge(from => $node_1, to => $node_2);
$graph->pop_subgraph;
}
my $id = '3';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "Macro demo $id - Cluster sub-graphs", rankdir => 'TB'},
);
macro($graph, 'cluster 1', 'Chadstone', 'Waverley');
macro($graph, 'cluster 2', 'Hughesdale', 'Notting Hill');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "macro.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
$graph->run(format => 'dot'); # leave here as a canary so test "run"
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates linked cluster subgraphs via a macro.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
sub macro {
my ($graph, $name, $node_1, $node_2) = @_;
$graph->push_subgraph(
name => $name,
graph => {label => $name},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => $node_1, shape => 'hexagon');
$graph->add_node(name => $node_2, color => 'orange');
$graph->add_edge(from => $node_1, to => $node_2);
$graph->pop_subgraph;
}
my $id = '4';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "Macro demo $id - Linked cluster sub-graphs", rankdir => 'TB'},
);
macro($graph, 'cluster 1', 'Chadstone', 'Waverley');
macro($graph, 'cluster 2', 'Hughesdale', 'Notting Hill');
$graph -> add_edge(from => 'Chadstone', to => 'Notting Hill', minlen => 2);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "macro.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates compound cluster subgraphs via a macro.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
sub macro {
my ($graph, $name, $node_1, $node_2) = @_;
$graph->push_subgraph(
name => $name,
graph => {label => $name},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => $node_1, shape => 'hexagon');
$graph->add_node(name => $node_2, color => 'orange');
$graph->add_edge(from => $node_1, to => $node_2);
$graph->pop_subgraph;
}
my $id = '5';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {
compound => 'true',
label => "Macro demo $id - Compound cluster sub-graphs",
rankdir => 'TB',
},
);
macro($graph, 'cluster 1', 'Chadstone', 'Waverley');
macro($graph, 'cluster 2', 'Hughesdale', 'Notting Hill');
$graph->add_edge(
from => 'Chadstone',
to => 'Notting Hill',
lhead => 'cluster 2',
ltail => 'cluster 1',
minlen => 2,
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "macro.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a graph with a 'plaintext' shape.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = 3;
my $html_template = <<'EOF';
<html>
<head><title>Demo %1$s - A server-side image map</title></head>
<body><h1 align = 'center'>Demo %1$s - A server-side image map</h1></body>
</html>
EOF
my $file_main = "gen.map.$id.1.html";
my $file_2 = "gen.map.$id.2.html";
my $file_3 = "gen.map.$id.3.html";
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {
directed => 1,
name => 'mainmap',
},
graph => {rankdir => 'TB'},
im_meta => {
URL => $file_main, # Note: URL must be in caps.
},
node => {shape => 'oval'},
);
$graph->add_node(name => 'source', URL => $file_2);
$graph->add_node(name => 'destination');
$graph->add_edge(from => 'source', to => 'destination', URL => $file_3);
if (@ARGV) {
my($format) = shift || 'png';
my $output_file = shift || "map.$id.$format";
(my $volume, my $dirname) = File::Spec->splitpath($output_file);
my($im_format) = shift || 'imap';
my $im_output_file = shift || File::Spec->catpath($volume, $dirname, "gen.map.$id.map");
$graph->run(format => $format, output_file => $output_file, im_format => $im_format, im_output_file => $im_output_file);
for ($file_main, $file_2, $file_3) {
open my $fh, '>', File::Spec->catpath($volume, $dirname, $_) or die "$_: $!";
print $fh sprintf $html_template, $_;
}
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a graph with a 'plaintext' shape.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = 4;
my $html_template = <<'EOF';
<html>
<head><title>Demo %1$s - A server-side image map</title></head>
<body><h1 align = 'center'>Demo %1$s - A server-side image map</h1></body>
</html>
EOF
my $file_main = "gen.map.$id.1.html";
my $file_2 = "gen.map.$id.2.html";
my $file_3 = "gen.map.$id.3.html";
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {
directed => 1,
name => 'mainmap',
},
graph => {rankdir => 'TB'},
im_meta => {
URL => $file_main, # Note: URL must be in caps.
},
node => {shape => 'oval'},
);
$graph->add_node(name => 'source', URL => $file_2);
$graph->add_node(name => 'destination');
$graph->add_edge(from => 'source', to => 'destination', URL => $file_3);
if (@ARGV) {
my($format) = shift || 'svg';
my $output_file = shift || "map.$id.$format";
my($im_format) = shift || 'cmapx';
(my $volume, my $dirname) = File::Spec->splitpath($output_file);
my $im_output_file = shift || File::Spec->catpath($volume, $dirname, "gen.map.$id.map");
$graph -> run(format => $format, output_file => $output_file, im_format => $im_format, im_output_file => $im_output_file);
for ($file_main, $file_2, $file_3) {
open my $fh, '>', File::Spec->catpath($volume, $dirname, $_) or die "$_: $!";
print $fh sprintf $html_template, $_;
}
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates graphing a Perl regular expression.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
use GraphViz2::Parse::Regexp;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {color => 'blue', shape => 'oval'},
);
my $g = GraphViz2::Parse::Regexp->new(graph => $graph);
my $re = '^(([abcd0-9])|(foo)n?)x*y{1,2}';
$g->create(regexp => $re);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "parse.regexp.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
local our $TODO = 'seems to vary by Perl version';
my $gd = GraphViz2::Parse::Regexp::to_graph($re);
my $gvre = GraphViz2::Parse::Regexp->new(as_graph => $gd);
Test::Snapshot::is_deeply_snapshot($gvre->graph->dot_input, 'dot file');
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates graphing a Set::FA::Element's state transition table.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
use GraphViz2::Parse::STT;
sub read_file {
open my $fh, '<:encoding(UTF-8)', $_[0] or die "$_[0]: $!";
local $/;
<$fh>;
}
my $stt = read_file(File::Spec->catfile('t', 'sample.stt.2.dat'));
my $g = GraphViz2::Parse::STT->new(stt => $stt, mode => 're_structs');
if (@ARGV) {
my $format = shift || 'svg';
my $output_file = shift || File::Spec->catfile('html', "parse.stt.$format");
my $mode = shift; # default in the module
my $graph = GraphViz2->from_graph(GraphViz2::Parse::STT::graphvizify($g->as_graph, $mode));
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($g->graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates graphing a byacc-style grammar.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
use GraphViz2::Parse::Yacc;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1, combine_node_and_port => 0},
graph => {concentrate => 1, rankdir => 'TB'},
node => {color => 'blue', shape => 'oval'},
);
my $g = GraphViz2::Parse::Yacc->new(graph => $graph);
$g->create(file_name => File::Spec->catfile('t', 'calc3.output'));
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "parse.yacc.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates graphing a yapp-style grammar.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
use GraphViz2::Parse::Yapp;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1, combine_node_and_port => 0},
graph => {concentrate => 1, rankdir => 'TB'},
node => {color => 'blue', shape => 'oval'},
);
my $g = GraphViz2::Parse::Yapp->new(graph => $graph);
$g->create(file_name => File::Spec -> catfile('t', 'calc.output'));
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "parse.yapp.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a graph with a 'plaintext' shape.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new;
$graph->add_node(name => 'Murrumbeena', shape => 'plaintext');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "plaintext.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates (1) newlines and double-quotes in node names and labels, (2) justification.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
global => {directed => 1},
graph => {rankdir => 'LR'},
node => {shape => 'oval'},
);
$graph->add_node(name => "Embedded\\nnewline\\nnode\\nname");
$graph->add_node(
name => "Embedded newline label name",
label => "Embedded\\nnewline\\nlabel",
);
$graph->add_node(name => "Embedded\\ndouble-quote\\nnode\\nname\\n\\\"");
$graph->add_node(
name => "Embedded\\double-quote\\label",
label => qq|Embedded\\ndouble-quote\\nlabel\\n\"|,
);
$graph->add_node(
name => 'Line justification 1',
label => "A short line\\rA much longer line",
);
$graph->add_node(
name => 'Line justification 2',
label => "A much longer line\\rA short line",
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "quote.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates subgraphs used to rank nodes horizontally (succinct version of code).
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {shape => 'oval'},
subgraph => {rank => 'same'},
);
$graph->add_node(name => 'Carnegie', shape => 'circle');
$graph->add_node(name => 'Chadstone', shape => 'circle', color => 'red');
$graph->add_node(name => 'Malvern', shape => 'box', color => 'green');
$graph->add_node(name => 'Murrumbeena', shape => 'doublecircle', color => 'orange');
$graph->add_node(name => 'Oakleigh', color => 'blue');
$graph->add_edge(from => 'Chadstone', to => 'Oakleigh', arrowhead => 'odot');
$graph->add_edge(from => 'Malvern', to => 'Carnegie', arrowsize => 2);
$graph->add_edge(from => 'Malvern', to => 'Oakleigh', color => 'brown');
# a and b are arbitrary values. All that's happening is that all nodes
# in @{$rank{a} } will be in the same horizontal line, and likewise for b.
my %rank = (a => [qw(Malvern Prahran)], b => [qw(Oakleigh Murrumbeena)]);
for my $key (sort keys %rank) {
$graph->push_subgraph;
$graph->add_node(name => $_) for @{$rank{$key} };
$graph->pop_subgraph;
}
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec->catfile('html', "rank.sub.graph.1.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Nested records using strings as labels.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = '1';
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => "Record demo $id - Nested records using strings as labels"},
node => {shape => 'record'},
);
$graph->add_node(name => 'struct1::x', label => '<f0> left|<f1> mid dle|<f2> right');
$graph->add_node(name => 'struct2', label => '<f0> one|<f1> two');
$graph->add_node(
name => 'struct3',
label => "hello\\nworld |{ b |{c|<here> d|e}| f}| g | h",
);
$graph->add_edge(from => 'struct1::x:f1', to => 'struct2:f0', color => 'blue');
$graph->add_edge(from => 'struct1::x:f2', to => 'struct3:here', color => 'red');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec->catfile('html', "record.$id.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Nested records using an arrayref of hashrefs as labels.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = '2';
my $graph = GraphViz2->new(
global => {directed => 1, combine_node_and_port => 0},
graph => {label => "Record demo $id - Nested records using an arrayref of hashrefs as labels"},
node => {shape => 'record'},
);
$graph->add_node(name => 'struct1', label => '<f0> left|<f1> mid dle|<f2> right');
$graph->add_node(name => 'struct2', label => '<f0> one|<f1> two');
$graph->add_node(name => 'struct3', label => [
{ text => "hello\\nworld" },
[
{ text => 'b' },
[
{ text => 'c{|}<>""' },
{ text => 'd', port => 'here' },
{ text => 'e' },
],
{ text => 'f' },
],
{ text => 'g' },
{ text => 'h' },
]);
$graph->add_edge(from => 'struct1', tailport => 'f1', to => 'struct2', headport => 'f0', color => 'blue');
$graph->add_edge(from => 'struct1', tailport => 'f2', to => 'struct3', headport => 'here', color => 'red');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "record.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Deeply nested records using nested array-refs.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = '3';
my $graph = GraphViz2->new(
global => {directed => 1, combine_node_and_port => 0, record_shape => 'record'},
graph => {
label => "Record demo $id - Deeply nested records " .
"using nested array-refs"
},
);
$graph->add_node(name => 'Alphabet', label => [
{ port => 'port_a', text => 'a:port_a' },
[
{ port => 'port_b', text => 'b:port_b' },
'c',
[
{ port => 'port_d', text => 'd:port_d' },
'e',
'f',
[
'g',
{ port => 'port_h', text => 'h:port_h' },
'i',
'j',
[
'k',
'l',
'm',
{ port => 'port_n', text => 'n:port_n' },
'o',
'p',
],
'q',
'r',
{ port => 'port_s', text => 's:port_s' },
't',
],
'u',
'v',
{ port => 'port_w', text => 'w:port_w' },
],
'x',
{ port => 'port_y', text => 'y:port_y' },
],
'z',
]);
$graph -> add_edge(
from => 'Alphabet', tailport => 'port_a', to => 'Alphabet', headport => 'port_n', color => 'maroon',
);
$graph -> add_edge(
from => 'Alphabet', tailport => 'port_b', to => 'Alphabet', headport => 'port_s', color => 'blue',
);
$graph -> add_edge(
from => 'Alphabet', tailport => 'port_d', to => 'Alphabet', headport => 'port_w', color => 'red',
);
$graph -> add_edge(
from => 'Alphabet', tailport => 'port_y', to => 'Alphabet', headport => 'port_h', color => 'green',
);
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "record.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Set record-style node labels and shapes in various ways.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $id = '4';
my $graph = GraphViz2->new(
global => {directed => 1},
graph => {label => "Record demo $id - Set record shapes in various ways"},
node => {color => 'magenta'},
);
$graph->add_node(name => 'One', label => []);
$graph->add_node(name => 'Two', label => ['Left', 'Right']);
$graph->add_node(name => 'Three', color => 'black', label => ['Good', 'Bad'], shape => 'record');
$graph->add_node(name => 'Four', label => [
{
text => '{Big',
},
{
text => 'Small}',
},
]);
$graph->add_node(name => 'Five', label => [
{
text => '{Yin',
},
{
text => 'Yang}',
},
], shape => 'record');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "record.$id.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a subgraph (with a frame because the subgroup is called cluster_*).
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => 'sub.graph.pl', rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph->add_node(name => 'Carnegie', shape => 'circle');
$graph->add_node(name => 'Murrumbeena', shape => 'doublecircle', color => 'green');
$graph->add_node(name => 'Oakleigh', color => 'blue');
$graph->add_edge(from => 'Murrumbeena', to => 'Carnegie', arrowsize => 2);
$graph->add_edge(from => 'Murrumbeena', to => 'Oakleigh', color => 'brown');
$graph->push_subgraph(
name => 'cluster_1',
graph => {label => 'Child'},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => 'Chadstone', shape => 'hexagon');
$graph->add_node(name => 'Waverley', color => 'orange');
$graph->add_edge(from => 'Chadstone', to => 'Waverley');
$graph->pop_subgraph;
$graph->default_node(color => 'cyan');
$graph->add_node(name => 'Malvern');
$graph->add_node(name => 'Prahran', shape => 'trapezium');
$graph->add_edge(from => 'Malvern', to => 'Prahran');
$graph->add_edge(from => 'Malvern', to => 'Murrumbeena');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "sub.graph.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates clusters with and without frames.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey', penwidth => 3},
global => {directed => 1},
graph => {label => 'Demo of 3 subgraphs (2 being clusters), and 1 frame', rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph->add_node(name => 'One', color => 'red', shape => 'circle');
$graph->add_node(name => 'Two', color => 'green', shape => 'doublecircle');
$graph->add_edge(from => 'One', to => 'Two', color => 'maroon');
$graph->push_subgraph(
graph => {label => 'Child the First'},
name => 'cluster First subgraph',
node => {color => 'magenta', shape => 'diamond'},
subgraph => {pencolor => 'white'}, # Required because name =~ /^cluster/.
);
$graph->add_node(name => 'Three'); # Default color and shape.
$graph->add_node(name => 'Four', color => 'orange', shape => 'rectangle');
$graph->add_edge(from => 'Three', to => 'Four');
$graph->pop_subgraph;
$graph->push_subgraph(
graph => {label => 'Child the Second'},
name => 'cluster Second subgraph',
node => {color => 'magenta', shape => 'diamond'},
subgraph => {pencolor => 'purple'}, # Required because name =~ /^cluster/.
);
$graph->add_node(name => 'Five', color => 'blue'); # Default shape.
$graph->add_node(name => 'Six', color => 'orange', shape => 'rectangle');
$graph->add_edge(from => 'Five', to => 'Six');
$graph->pop_subgraph;
$graph->push_subgraph(
name => 'Third subgraph',
graph => {label => 'Child the Third'},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => 'Seven', color => 'blue', shape => 'doubleoctagon');
$graph->add_node(name => 'Eight', color => 'orange', shape => 'rectangle');
$graph->add_edge(from => 'Seven', to => 'Eight');
$graph->pop_subgraph;
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "sub.graph.frames.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a subsubgraph.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => 'sub.sub.graph.pl', rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph->add_node(name => 'Carnegie', shape => 'circle');
$graph->add_node(name => 'Murrumbeena', shape => 'doublecircle', color => 'green');
$graph->add_node(name => 'Oakleigh', color => 'blue');
$graph->add_edge(from => 'Murrumbeena', to => 'Carnegie', arrowsize => 2);
$graph->add_edge(from => 'Murrumbeena', to => 'Oakleigh', color => 'brown');
$graph->push_subgraph(
name => 'cluster_subgraph_1',
graph => {label => 'Child'},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => 'Chadstone', shape => 'hexagon');
$graph->add_node(name => 'Waverley', color => 'orange');
$graph->add_edge(from => 'Chadstone', to => 'Waverley');
$graph->push_subgraph(
name => 'cluster_2',
graph => {label => 'Grandchild'},
node => {color => 'blue3', shape => 'triangle'},
);
$graph->add_node(name => 'Glen Waverley', shape => 'pentagon');
$graph->add_node(name => 'Mount Waverley', color => 'darkslategrey');
$graph->add_edge(from => 'Glen Waverley', to => 'Mount Waverley');
$graph->pop_subgraph;
$graph->pop_subgraph;
$graph->default_node(color => 'cyan');
$graph->add_node(name => 'Malvern');
$graph->add_node(name => 'Prahran', shape => 'trapezium');
$graph->add_edge(from => 'Malvern', to => 'Prahran');
$graph->add_edge(from => 'Malvern', to => 'Murrumbeena');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "sub.sub.graph.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates a trivial 3-node graph, with colors.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph->default_node(shape => 'circle', style => 'filled');
$graph->default_edge(arrowsize => 4);
$graph->add_node(name => 'Carnegie', shape => 'circle');
$graph->add_node(name => 'Carnegie', color => 'red');
$graph->default_node(style => 'rounded');
$graph->add_node(name => 'Murrumbeena', shape => 'doublecircle', color => 'green');
$graph->add_node(name => 'Oakleigh', shape => 'oval', color => 'blue');
$graph->add_edge(from => 'Murrumbeena', to => 'Carnegie', arrowsize => 2);
$graph->default_edge(arrowsize => 4);
$graph->add_edge(from => 'Murrumbeena', to => 'Oakleigh', color => 'brown');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "trivial.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates named and unnamed subgraphs.
use strict;
use warnings;
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {label => 'Named and unnamed subgraphs', rankdir => 'TB'},
);
$graph->push_subgraph(
graph => {label => 'Subgraph One'},
node => {color => 'magenta', shape => 'diamond'},
);
$graph->add_node(name => 'Chadstone', shape => 'hexagon');
$graph->add_node(name => 'Waverley', color => 'orange');
$graph->add_edge(from => 'Chadstone', to => 'Waverley');
$graph->pop_subgraph;
$graph->push_subgraph;
$graph->add_node(name => 'Glen Waverley', color => 'blue3', shape => 'pentagon');
$graph->add_node(name => 'Mount Waverley', color => 'darkslategrey', shape => 'rectangle');
$graph->add_edge(from => 'Glen Waverley', to => 'Mount Waverley');
$graph->pop_subgraph;
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "unnamed.sub.graph.$format");
$graph -> run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
# Annotation: Demonstrates utf8 chars in labels.
use strict;
use utf8;
use warnings;
use warnings qw(FATAL utf8); # Fatalize encoding glitches.
use File::Spec;
use GraphViz2;
my $graph = GraphViz2->new(
edge => {color => 'grey'},
global => {directed => 1},
graph => {rankdir => 'TB'},
node => {shape => 'oval'},
);
$graph->add_node(name => 'Zero', label => 'The Orient Express');
$graph->add_node(name => 'One', label => 'Reichwaldstraße');
$graph->add_node(name => 'Two', label => 'Böhme');
$graph->add_node(name => 'Three', label => 'ʎ ʏ ʐ ʑ ʒ ʓ ʙ ʚ');
$graph->add_node(name => 'Four', label => 'Πηληϊάδεω Ἀχιλῆος');
$graph->add_node(name => 'Five', label => 'ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ');
$graph->add_edge(from => 'Zero', to => 'One');
$graph->add_edge(from => 'Zero', to => 'Three');
$graph->add_edge(from => 'One', to => 'Two');
$graph->add_edge(from => 'Three', to => 'Four');
$graph->add_edge(from => 'Two', to => 'Five', label => 'Label has a ☃');
$graph->add_edge(from => 'Four', to => 'Five', label => 'Label has a ✔');
if (@ARGV) {
my($format) = shift || 'svg';
my($output_file) = shift || File::Spec -> catfile('html', "utf8.1.$format");
$graph->run(format => $format, output_file => $output_file);
} else {
# run as a test
require Test::More;
require Test::Snapshot;
Test::Snapshot::is_deeply_snapshot($graph->dot_input, 'dot file');
Test::More::done_testing();
}
|
Author
|
|
|
Date
|
2021-01-09
|
|
OS
|
Debian V 8.10
|
|
Perl
|
5.32.0
|