Graphvizでハレルチャートが描けるか?

Graphic

dot言語でがんばってみましたが、限界を感じつつあります。leftyに手を出すか迷ってます。

  • 状態遷移のネストは、subgraphのネストで実現できる。
  • 並列表現を実現するのは、ほぼ無理。
  • subgraphを越えてrank付けするのが難しい。
  • rank付けで見栄えを整えるのが難しい。

状態遷移表データからdotファイルを自動生成するツールを作ってみました。

上の画像は、こんな感じで生成しました:

$ ./stategen.pl displays < harel.txt | dot -Tpng > harel.png

dotファイル自動生成スクリプト

#!/usr/bin/env perl

use strict;

{
    my $name = $ARGV[0];
    graph_gen(state_load(), $name);
    exit(0);
}

sub graph_gen {
    my ($t, $t_name) = @_;

    print "digraph $t_name {\n";
    print "\tlabel = \"$t_name\"\n";
    print "\tlabelloc = t\n";
    print "\tcompound = true;\n";
    while (my ($name, $state) = each %{$t->{$t_name}->{'-states'}}) {
        if (is_nest($t, $t_name, $name)) {
            $state->{'-isnest'} = 1;
            subgraph_gen(1, $t, $t_name, $name);
        } else {
            printf("\t\"%s\" [shape = \"%s\", label = \"%s\"]\n",
                   $t_name . '_' . $name,
                   shape_name($name, $state),
                   $name);
        }
    }
    while (my ($name, $from) = each %{$t->{$t_name}->{'-states'}}) {
        my $from_name;
        my $to_name;

        $from_name = $t_name . '_' . $name;
        foreach my $next (@{$from->{'-next_list'}}) {
            $to_name = $t_name . '_' . $next->{'-name'};
            printf("\t\"%s\" -> \"%s\" [label = \"%s\"]\n",
                   $from_name,
                   $to_name,
                   $next->{'-cond'});
        }
    }
    print "}\n";
}

sub subgraph_gen {
    my ($nest, $t, $super, $t_name) = @_;

    print "\t" x $nest;
    print "subgraph cluster_", $super , '_' , $t_name, " {\n";
    print "\t" x $nest;
    print "\tlabel = \"", $t_name, "\"\n";
    print "\t\"", $super , '_', $t_name, "\" [shape = point]\n";
    while (my ($name, $state) = each %{$t->{$t_name}->{'-states'}}) {
        if (is_nest($t, $t_name, $name)) {
            $state->{'-isnest'} = 1;
            subgraph_gen($nest + 1, $t, $t_name, $name);
        } else {
            print "\t" x $nest;
            printf("\t\"%s\" [shape = \"%s\", label = \"%s\"]\n",
                   $t_name . '_' . $name,
                   shape_name($name, $state),
                   $name);
        }
    }
    while (my ($name, $from) = each %{$t->{$t_name}->{'-states'}}) {
        my $from_name;
        my $to_name;

        $from_name = $t_name . '_' . $name;
        foreach my $next (@{$from->{'-next_list'}}) {
            $to_name = $t_name . '_' . $next->{'-name'};
            print "\t" x $nest;
            printf("\t\"%s\" -> \"%s\" [label = \"%s\"]\n",
                   $from_name,
                   $to_name,
                   $next->{'-cond'});
        }
    }
    print "\t" x $nest;
    print "}\n";
}

sub is_nest {
    my ($t, $super, $name) = @_;

    foreach my $t_name (keys %{$t}) {
        if ($super eq $t_name) {
            next;
        }
        if ($name eq $t_name) {
            return 1;
        }
    }
    return 0;
}

sub shape_name {
    my ($name, $state) = @_;

    if ($state->{'-isfinal'}) {
        return "doublecircle";
    }
    if ($state->{'-isstart'}) {
        return "point";
    }
    if ($name eq 'H') {
        return "circle";
    }
    return "box";
}

sub state_load {
    my $t = {};
    my $tbl;

    while (<STDIN>) {
        s/\x0d\x0a$//;
        s/\x0d$//;
        s/\x0a$//;
        unless ($_) {
            next;
        }
        if (my ($t_name) = /^T:\s*(.*?)\s*$/) {
            $tbl = $t->{$t_name} = {
                '-states' => {},
                '-conds' => []
            };
        } elsif (my ($str) = /^S:\s*(.*?)\s*$/) {
            foreach my $state_str (map {s/^\s+//;s/\s+$//;$_} split /,/, $str) {
                $tbl->{'-states'}->{$state_str} = {
                    '-next_list' => [],
                    '-isfinal' => 0,
                    '-isstart' => 0,
                    '-isnest' => 0
                };
            }
        } elsif (my ($str) = /^s0:\s*(.*?)\s*$/) {
            $str =~ s/^\s+//;
            $str =~ s/\s+$//;
            $tbl->{'-states'}->{$str}->{'-isstart'} = 1;
        } elsif (my ($str) = /^C:\s*(.*?)\s*$/) {
            @{$tbl->{'-conds'}} = map {s/^\s+//;s/\s+$//;$_} split /,/, $str;
        } elsif (my ($str) = /^F:\s*(.*?)\s*$/) {
            foreach my $final_str (map {s/^\s+//;s/\s+$//;$_} split /,/, $str) {
                $tbl->{'-states'}->{$final_str}->{'-isfinal'} = 1;
            }
        } elsif (/^d:$/) {

        } else {
            my ($state, $next, $cond) = map {s/^\s+//;s/\s+$//;$_} split /,/, $_;
            my $next = {'-name' => $next, '-cond' => $cond};
            push @{$tbl->{'-states'}->{$state}->{'-next_list'}}, $next;
        }
    }
    return $t;
}

状態遷移表のフォーマット

T: テーブル名
S: 状態名のリスト
s0: 開始状態
C: 遷移条件名のリスト
F: 終了状態のリスト
d:
遷移元状態名, 遷移先状態名, 遷移条件名
  :

状態遷移表データ

T: displays
S: start, H, time, wait, update, date, stopwatch, chime, alarm2, alarm1, update2, update1
s0: start
C: a, b, c, ^c, d, 2sec in wait, 2min in date,
F:
d:
start, H,
H, time,
time, wait, c
time, date, d
time, alarm1, a
wait, time, ^c
wait, update, 2sec in wait
update, time, b
date, time, d
date, time, 2min in date
stopwatch, time, a
chime, stopwatch, a
alarm2, chime, a
alarm2, update2, c
alarm1, alarm2, a
alarm1, update1, c
update2, alarm2, b
update1, alarm1, b

T: chime
S: start, H, off, on
s0: start
C: d,
F:
d:
start, H,
H, off,
off, on, d
on, off, d

T: alarm2
S: start, H, off, on
s0: start
C: d,
F:
d:
start, H,
H, off,
off, on, d
on, off, d

T: alarm1
S: start, H, off, on
s0: start
C: d,
F:
d:
start, H,
H, off,
off, on, d
on, off, d

参考文献

  1. D. Harel, "Statecharts: A Visual Formalism for Complex Systems", Sci. Comput. Programming 8 (1987), 231-274.
  2. Publications by Prof. David Harel