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