1: #!/usr/bin/perl
   2: # Ed Dijkstra's Shortest-Path, by pope
   3: #
   4: # Demonstrates practical uses of Infinity
   5: # (http://www.perl.com/CPAN-local/doc/FMTEYEWTK/is_numeric.html).
   6: # Feed a file consisting neighbourhood matrices like shown below to 
   7: # this script:
   8: #
   9: #  0, 50, 10, 40, 45, ~
  10: #  ~,  0, 15,  ~, 10, ~
  11: # 20,  ~,  0, 15,  ~, ~
  12: #  ~, 20,  ~,  0, 35, ~
  13: #  ~,  ~,  ~, 30,  0, ~
  14: #  ~,  ~,  ~,  3,  ~, 0
  15: #
  16: # Tilde is used to represent unavailable route (infinite distance in 
  17: # mathematical sense).
  18: 
  19: use strict;
  20: use vars qw(@m %state $FINISH $opt_s);
  21: use Getopt::Std;
  22: 
  23: BEGIN { $FINISH = 0 }
  24: 
  25: sub sum {
  26:     my $s;
  27:     while (@_ > 1) { $s += $m[shift()]->[$_[0]] }
  28:     $s;
  29: }
  30: 
  31: sub output {
  32:     my %s = @_;
  33:     print "The shortest route from ", $opt_s, " to: \n";
  34:     for (keys(%{$s{array}})) {
  35:         print "$_ is: ", join(", ", @{$state{array}->{$_}->{r}}), 
  36:             " with distance: ", $state{array}->{$_}->{d}, "\n";
  37:     }       
  38: }
  39: 
  40: # eat command line argument
  41: 
  42: getopts('s:');
  43: defined(my $start = $opt_s) or die "Usage: $0 -s start_node matrices_file";
  44: 
  45: while (<>) { next if /^\s*$/;s/\s//g;s/~/Infinity/g;push @m, [split(/,\s*/, $_)] }
  46: 
  47: {
  48: my ($cnt, $cnt1);
  49: %state = (  node  => undef,
  50:             track => undef,
  51:             array => {map {$cnt++ => $_ } 
  52:                       map { {s => 0, d => $_, r => [$start, $cnt1++]} } 
  53:                       @{$m[$start]}} 
  54:          );
  55: }
  56: 
  57: my $loop = 0;
  58: 
  59: while (not $FINISH) {
  60:     my ($cnt, $cnt1);
  61: 
  62: # select the unselected
  63:     my @min = grep {/\d/}
  64:            map {!$state{array}->{$_}->{s} ? $_ : undef} 
  65:            sort { 
  66:                 my $aa = $state{array}->{$a}->{d};
  67:                 my $bb = $state{array}->{$b}->{d};
  68:                 $aa <=> $bb; 
  69:                 } 
  70:            keys(%{$state{array}});
  71: 
  72: # set node, track and s 
  73:     @state{'node','track'} = ($min[0], $state{array}->{$min[0]}->{r});
  74:     $state{array}->{$min[0]}->{s} = 1;
  75: 
  76: # prepare the state for the next loop
  77:     for (@min) {
  78:         if ( (my $nd = sum(@{$state{track}}, $_)) < 
  79:             $state{array}->{$_}->{d}) {
  80:             $state{array}->{$_}->{d} = $nd;
  81:             $state{array}->{$_}->{r} = [@{$state{track}}, $_];
  82:         }
  83:     }
  84:     $FINISH = 1 if (++$loop >= @{$m[0]} ); 
  85: }
  86: output(%state);