#!/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;