Osaka Subway with Graph::Gviz

osaka_subway.pl

#!perl
use strict;
use warnings;

use Graph::Gviz;
use Math::Normalize::Range;
use Text::CSV_XS;
use Math::Round qw/nearest/;

use utf8;

my $csv_file = '/home/syohei/Desktop/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 {
    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) {
        name 'Osaka_Subway';
        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", type => 'svg');

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