Samples of Graphviz::Gviz

compass.pl

#!/usr/bin/env perl
use strict;
use warnings;

use lib qw(../lib);
use Graphviz::DSL;

my $graph = graph {
    route 'a:n' => 'b:s';
    route 'a:w' => 'b:w';
    route 'a:s' => 'b:n';
    route 'a:e' => 'b:e';
};

$graph->save(path => 'compass', type => 'png');

multiroute.pl

#!/usr/bin/env perl
use strict;
use warnings;

use lib qw(../lib);
use Graphviz::DSL;

use utf8;

my $graph = graph {
    multi_route +{
        'J大K' => {
            '2中P' => {
                '2中P' => '2大K',
                '2大P' => {
                    '小竜巻旋風脚' => '中昇竜拳',
                },
            },
            '2大P' => [qw/波動拳 昇竜拳/],
            '2中K' => {
                '中昇竜' => {
                    'セービングキャンセル' => '滅波動拳',
                }
            },
        },
    };
};

$graph->save(path => 'multiroute', type => 'png');

sample.pl

#!/usr/bin/env perl
use strict;
use warnings;

use lib qw(../lib);
use Graphviz::DSL;

my $graph = graph {
    subgraph {
        name 'cluster_0';
        nodes style => 'filled', color => 'white';
        global style => 'filled', color => 'lightgrey', label => 'process#1';

        route a0 => 'a1';
        route a1 => 'a2';
        route a2 => 'a3';
    };

    subgraph {
        name 'cluster_1';
        nodes style => 'filled';
        global color => 'blue', label => 'process#2';

        route b0 => 'b1';
        route b1 => 'b2';
        route b2 => 'b3';
    };

    route start => [qw/a0 b0/];
    route a1 => 'b3';
    route b2 => 'a3';
    route a3 => [qw/a0 end/];
    route b3 => 'end';

    node 'start', shape => 'Mdiamond';
    node 'end',   shape => 'Mdiamond';
};

$graph->save(path => 'sample', type => 'png');

sample_undirected.pl

#!/usr/bin/env perl
use strict;
use warnings;

use lib qw(../lib);
use Graphviz::DSL;

my $graph = graph {
    type 'graph';

    subgraph {
        name 'cluster_0';
        nodes style => 'filled', color => 'white';
        global style => 'filled', color => 'lightgrey', label => 'process#1';

        route a0 => 'a1';
        route a1 => 'a2';
        route a2 => 'a3';
    };

    subgraph {
        name 'cluster_1';
        nodes style => 'filled';
        global color => 'blue', label => 'process#2';

        route b0 => 'b1';
        route b1 => 'b2';
        route b2 => 'b3';
    };

    route start => [qw/a0 b0/];
    route a1 => 'b3';
    route b2 => 'a3';
    route a3 => [qw/a0 end/];
    route b3 => 'end';

    node 'start', shape => 'Mdiamond';
    node 'end',   shape => 'Mdiamond';
};

$graph->save(path => 'sample_undirect', type => 'png');

subgraph.pl

#!/usr/bin/env perl
use strict;
use warnings;

use lib qw(../lib);
use Graphviz::DSL;

my $graph = graph {
    subgraph {
        name 'cluster_1';
        nodes style => 'filled';
        global color => 'green', label => 'process#1';

        route a0 => 'a1';
        route a1 => 'a2';
        route a2 => 'a3';
    };

    subgraph {
        name 'cluster_2';
        nodes style => 'filled';
        global color => 'pink', label => 'process#2';

        route b0 => 'b1';
        route b1 => 'b2';
        route b2 => 'b3';
    };

    route 'cluster_1' => 'cluster_2';
};

$graph->save(path => 'subgraph', type => 'png');

subway.pl

#!perl
use strict;
use warnings;

use Graphviz::DSL;
use Math::Normalize::Range;
use Text::CSV_XS;
use Math::Round qw/nearest/;

use utf8;

my $csv_file = shift or die "Usage: $0 railway_csv";

my $csv = Text::CSV_XS->new;
open my $fh, '<:encoding(utf8)', $csv_file or die "Can't open $csv_file: $!";

my %rail_line;
$csv->getline($fh); # remove header

my (@longtudes, @latitudes);
while (my $row = $csv->getline($fh)) {
    my $line = $row->[8];
    next unless $line =~ m{大阪市営地下鉄};

    push @longtudes, $row->[11];
    push @latitudes, $row->[12];
    push @{$rail_line{$line}}, $row;
}

close $fh;

my ($lon_min, $lon_max) = minmax(@longtudes);
my ($lat_min, $lat_max) = minmax(@latitudes);

my $svg_normalizer = Math::Normalize::Range->new(target_min => 10, target_max => 60);

my @line_colors = (
    ["御堂筋線" => '#e5171f'], ["谷町線"   => '#522886'], ["四つ橋線" => '#0078ba'],
    ["中央線"   => '#019a66'], ["千日前線" => '#e44d93'], ["堺筋線"   => '#814721'],
    ["今里筋線" => '#ee7b1a'], ["長堀鶴見緑地線" => '#a9cc51'],
);

my $graph = graph {
    name 'Osaka_Subway';
    global label => 'Osaka Municipal Subway', size => 16, layout => 'neato';

    edges arrowhead => 'none', penwidth => 2;
    nodes style => 'filled', fontcolor => 'white';

    while (my ($line, $stations) = each %rail_line) {
        global label => $line;

        my $index = 1;
        my $length = scalar @{$stations};
        for my $station (@{$stations}) {
            my ($id, $name, $seq) = @{$station}[2, 9, 4];
            my $next_id = $seq + 1;

            my $color = '#999999';
            for my $line_color (@line_colors) {
                my $n = $line_color->[0];
                if ($line =~ m{$n}) {
                    $color = $line_color->[1];
                    last;
                }
            }

            my $pos_x = $svg_normalizer->normalize($station->[11], {
                min => $lon_min, max => $lon_max,
            });

            my $pos_y = $svg_normalizer->normalize($station->[12], {
                min => $lat_min, max => $lat_max,
            });

            my $pos = sprintf "%d,%d!", nearest(0.1, $pos_x), nearest(0.1, $pos_y);

            edge [$id, $next_id], color => $color if $index < $length;
            node $id, label => $name, color => $color, pos => $pos;

            $index++;
        }
    }
};

$graph->save(path => "osaka_subway", type => 'svg');

sub minmax {
    my $init = shift;
    my ($min, $max) = ($init, $init);
    for (@_) {
        $min = $_ if $min > $_;
        $max = $_ if $max < $_;
    }
    return ($min, $max);
}