File: flwa

package info (click to toggle)
algotutor 0.8.6-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 576 kB
  • sloc: perl: 2,563; makefile: 41; php: 24; sh: 1
file content (118 lines) | stat: -rwxr-xr-x 3,611 bytes parent folder | download | duplicates (3)
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;