1: #!/usr/bin/perl 
   2: 
   3: # Hello All!
   4: # This is my first real perl code, all I coded before, were # the examples out of the Llama-Book! (-;
   5: # So PLEASE give me some hint (-;
   6: 
   7: # This little program uses the Dijkstra-Algorith to find the # shortest route through a given graph.
   8: # The graph has to be orientated and weighted(damn, I am not # native so this are maybe are the wrong expressions.
   9: 
  10: # The program in the current state needs the Graph in a 
  11: # Input file for which the user is asked. 
  12: # At the moment the nodes of the graph should be 
  13: # alphabetically sorted with s as the initial point, a
  14: # and z the goal!
  15: 
  16: # A sample Graph-file is provided below...
  17: 
  18: use strict;
  19: 
  20: my (
  21:     $s, $v, $vstar, $graphfile,
  22:     @route, @S, @V, @sortnachdist,
  23:     %distance, %previous
  24:     );
  25: 
  26: # (V are all Nodes, S the ones where a shortest route to is 
  27: # already found, the program finishes when z is in S)
  28: 
  29: sub bowlength
  30: # This sub goes through the graph-file and searches if there # is a connection between the two points. 
  31: # If there isn't any, a large number is used, to prevent the # program from using this route!
  32: {
  33:     my($s,$v)=@_;
  34:     seek(GRAPH,0,0);
  35:     while(<GRAPH>)
  36:     {	
  37: 	return $1 if (/$s:(\d):$v/); 	
  38:     }
  39:     return 99999;
  40: }
  41: 
  42: 
  43: 
  44: sub includes
  45: # This is something I am absolutely unsure about!
  46: # Isn't there any way in Perl to find out if an Array #includes a certain element?? (as default, i mean)
  47: {
  48:     my($a,@b)=@_;
  49:     foreach (@b)
  50:     {
  51: 	return 1 if $_ eq $a;
  52:     }
  53: }
  54: 
  55: sub V_without_S
  56: # For the noed which have to be examined
  57: {
  58:     my @c;   
  59:     foreach (@V)
  60:     {
  61: 	push(@c, $_) unless &includes($_,@S);
  62:     }
  63:     return (@c);
  64: }
  65: 
  66: 
  67: $s="s";
  68: $distance{$s}=0;
  69: push(@S,"s");
  70: 
  71: print "Graph-File:";
  72: chomp($graphfile=<STDIN>);
  73: 
  74: open GRAPH, "< $graphfile" 
  75:     or die "Could not open graph-description: $!"; 
  76: 
  77: seek(GRAPH,0,0);
  78: while(<GRAPH>)
  79: {	
  80:     push(@V, $1) if ((/(\w+):\d+:\w+/)&&((&includes($1,@V)-1)));
  81:     push(@V, $1) if ((/\w+:\d+:(\w+)/)&&((&includes($1,@V)-1)));
  82: }
  83: 
  84: # So, this is juste the Dijkstra Algorithm itself!
  85: # I took a Algorithmic-Description out of a book!
  86: # (Das Geheimnis des kürzesten Weges)
  87: # (its german, and exept the Dijkstra-Algorith-Description 
  88: # absolutely boring!!-we HAD to read it)
  89: 
  90: # Maybe some short lines about the Dijkstra Algorithm..
  91: # It finds the shortest way trough a given graph, by 
  92: # examining local nodes, and going to the node
  93: # which has the lowest value. It is not bound to one route, # and will jump between different routes
  94: # (depending on the graph) until it reaches the goal. 
  95: # But when he reaches it, it is sure that it has the lowest # value! Too prevent loosing the knowledge about 
  96: # the other routes, we need the %previous hash... 
  97: # I hope this helps you understanding better what it does!
  98:   
  99: 
 100: foreach $v (grep {$_ ne $s} (@V))
 101: {
 102:     $distance{$v} = &bowlength($s,$v);
 103:     $previous{$v}=$s;
 104: }
 105: 
 106: while($S[-1] ne "z")
 107: {
 108:     @sortnachdist = sort({$distance{$a}<=>$distance{$b}} (&V_without_S)); 
 109:     $vstar = shift @sortnachdist;
 110:     push(@S,$vstar);
 111:     foreach $v (&V_without_S)
 112:     {
 113: 	if ($distance{$vstar} + &bowlength($vstar,$v) < $distance{$v})
 114: 	{
 115: 	    $distance{$v}=$distance{$vstar}+&bowlength($vstar,$v);
 116: 	    $previous{$v}=$vstar;
 117: 	}
 118:     }    
 119: }
 120: 
 121: push(@route, "z");
 122: $_="z";
 123: until ($_ eq "s")
 124: {
 125:     $_=$previous{$_};
 126:     push(@route,$_);
 127: }
 128: print "The shortest route is:\n";
 129: print join " -> ", reverse @route;
 130: print "\nAnd its length is $distance{z}.\n";
 131: 
 132: # And now a sample graph!
 133: # If you would draw it, you would make the s point.
 134: # Then a line with value 3 to a and one with value 5 to b
 135: # From a a line with value 1 to b .... and so on!
 136: # If you find a graph where the algorithm(or more likely my # code) fails please contact me!
 137: # Oh yes, you should copy this line sinto a plain text-file # and remove the #'s (-;
 138: 
 139: #s:3:a
 140: #s:5:b
 141: #a:1:b
 142: #a:10:c
 143: #a:11:d
 144: #b:3:a
 145: #b:2:c
 146: #b:3:d
 147: #c:2:d
 148: #c:7:e
 149: #c:12:f
 150: #d:15:a
 151: #d:7:b
 152: #d:2:f
 153: #e:11:d
 154: #e:2:z
 155: #f:3:e
 156: #f:2:z