1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
|
#!/usr/bin/perl -w
# Floyd-Warshall's Algorithm for the All-Pair Shortest Path Problem
# Author: Chao-Kuei Hung http://www.cyut.edu.tw/~ckhung
# License: GPL
#
# This program is part of algotutor. Yet it can also run as a
# stand-alone text mode program that requires no other modules.
# When used as a stand-alone program, it requires as an argument the
# same type of graph file that algotutor uses, like this: flwa lv.gr
use strict;
sub flwa {
my ($gr, $can) = @_;
my ($show, @V, $min, $via, $n, $relay, $src, $tgt, $t, $prev);
$gr = (do $gr)->{-init_data};
@V = sort grep { not /\W/ } keys %$gr;
$n = $#V + 1;
for ($src=0; $src<$n; ++$src) {
for ($tgt=0; $tgt<$n; ++$tgt) {
$min->[$src][$tgt] = ($gr->{$V[$src]}{$V[$tgt]} or "-");
$via->[$src][$tgt] = "-";
}
$min->[$src][$src] = 0;
}
if (ref $can) {
$show = Board->new(-canvas=>$can, -width=>$n+1, -height=>$n+1,
-node_opts=>{ -size=>Vector->new(50,40), -shape=>"rectangle" } );
for ($src=0; $src<$n; ++$src) {
for ($tgt=0; $tgt<$n; ++$tgt) {
$show->cell($src,$tgt)->configure(
-text=>"$min->[$src][$tgt]\n$via->[$src][$tgt]",
-status=>"init");
}
$show->cell($src,$n)->configure(-text=>$V[$src], -status=>"done");
$show->cell($n,$src)->configure(-text=>$V[$src], -status=>"done");
}
$can->set_mark(1);
}
for ($relay=0; $relay<$n; ++$relay) {
$show->cell($relay-1,$relay-1)->configure(-status=>"init")
if (ref $can and $relay >= 1);
print "\n[$V[$relay]]\n ";
for ($tgt=0; $tgt<$n; ++$tgt) { printf "%4s", $V[$tgt]; }
print "\n";
for ($src=0; $src<$n; ++$src) {
for ($tgt=0; $tgt<$n; ++$tgt) {
$t = ($min->[$src][$relay] ne "-" and $min->[$relay][$tgt] ne "-") ?
$min->[$src][$relay] + $min->[$relay][$tgt] : undef;
if (defined $t and ($min->[$src][$tgt] eq "-" or $t < $min->[$src][$tgt])) {
$min->[$src][$tgt] = $t;
$via->[$src][$tgt] = $relay;
$show->cell($src,$tgt)->configure(
-text=>"$min->[$src][$tgt]\n$V[$via->[$src][$tgt]]")
if ref $can;
}
if (ref $can) {
if ($prev) {
$show->cell($prev->{src},$prev->{tgt})->configure(-status=>"init");
$show->cell($prev->{src},$prev->{relay})->configure(-status=>"init");
$show->cell($prev->{relay},$prev->{tgt})->configure(-status=>"init");
}
$show->cell($src,$relay)->configure(-status=>"pending");
$show->cell($relay,$tgt)->configure(-status=>"pending");
$show->cell($src,$tgt)->configure(-status=>"done");
$show->cell($relay,$relay)->configure(-status=>"focus");
$prev = { src=>$src, tgt=>$tgt, relay=>$relay };
$can->set_mark(1);
}
}
printf "%-4s", $V[$src];
for ($tgt=0; $tgt<$n; ++$tgt) { printf "%4s", $min->[$src][$tgt]; }
printf "\n ";
for ($tgt=0; $tgt<$n; ++$tgt) {
printf "%4s", $via->[$src][$tgt] eq "-" ?
"-" : $V[ $via->[$src][$tgt] ];
}
printf "\n";
}
if (ref $can) {
$show->cell($n-1, $n-1)->configure(-status=>"init");
$show->cell($relay,$relay)->configure(-status=>"init");
$can->set_mark(2);
}
}
for ($src=0; $src<$n; ++$src) {
for ($tgt=0; $tgt<$n; ++$tgt) {
next if $src == $tgt;
printf "%8s: ", $min->[$src][$tgt];
print_route(\@V, $via, $src, $tgt);
print "$V[$tgt]\n";
}
}
}
sub print_route {
my ($V, $via, $src, $tgt) = @_;
if ($via->[$src][$tgt] eq "-") {
print "$V->[$src] -> ";
return;
} else {
print_route($V, $via, $src, $via->[$src][$tgt]);
print_route($V, $via, $via->[$src][$tgt], $tgt);
}
}
if ($0 =~ /flwa$/) {
flwa($ARGV[0]);
}
1;
|