dijkstra.pl (3405B) - raw
1 #!/usr/local/bin/perl 2 3 # 4 # implementation of Dijkstra's algorithm to find the shortest path of 5 # weighted graphs, as demonstrated in Chapter 7 of "Grokking Algorithms" 6 # https://www.manning.com/books/grokking-algorithms 7 # 8 # In this example, variables holding the hashes for the graph, costs and 9 # which nodes have been processed (%graph, %costs, and %processed) are all 10 # global in scope. 11 # 12 13 use warnings; 14 use strict; 15 use v5.22; 16 use Data::Dumper; 17 18 # define the graph to store the neighbors and the cost to get to those 19 # neighbors. We will use a hash of a hash 20 my %graph; 21 $graph{'start'}{'a'} = 6; 22 $graph{'start'}{'b'} = 2; 23 24 # get all the neighbors (keys) of Start: 25 # say join ", " => keys %{$graph{'start'}}; 26 # get weights (values) of those edges: 27 # say join ", " => values %{$graph{'start'}}; 28 # get key-value pairs for neighbors of Start 29 # foreach my $key (sort keys %{$graph{'start'}}) { 30 # say "$key => $graph{'start'}{$key}"; 31 # } 32 33 # add the rest of the nodes and their neighbors to the graph 34 $graph{'a'}{'fin'} = 1; 35 $graph{'b'}{'a'} = 3; 36 $graph{'b'}{'fin'} = 5; 37 38 # define costs table 39 my %costs = ( 40 a => 6, 41 b => 2, 42 fin => 'inf', 43 ); 44 45 # define hash table for the parents 46 my %parents = ( 47 a => 'start', 48 b => 'start', 49 fin => 'none', 50 ); 51 52 # hash to track all of the nodes we have already processed 53 my %processed; 54 55 sub find_lowest_cost_node { 56 # set lowest cost to infinity for initial comparison 57 my $lowest_cost = 'inf'; 58 # set default lowest cost node to None in case none if sound 59 my $lowest_cost_node = 'None'; 60 # for each node in our costs table 61 foreach my $node (keys %costs) { 62 my $cost = $costs{$node}; 63 # check if node is lowest cost so far AND 64 # it has not yet been processed by our main while loop 65 if ($cost < $lowest_cost && !exists $processed{$node}) { 66 # if it is, update our $lowest_cost and $lowest_cost_node 67 $lowest_cost = $cost; 68 $lowest_cost_node = $node; 69 } 70 } 71 # will return None if all nodes have been processed 72 return $lowest_cost_node; 73 } 74 75 my $node = find_lowest_cost_node; 76 77 while ($node ne 'None') { 78 my $cost = $costs{$node}; # cost to get to current node 79 my @neighbors = keys %{$graph{$node}}; # neighbors of node 80 # go through all neighbors of this node 81 foreach my $neighbor (@neighbors) { 82 # calculate new cost of getting to neighbor via this node 83 my $new_cost = $cost + $graph{$node}{$neighbor}; 84 # if it's cheaper to get to this neighbor through this node 85 if ($costs{$neighbor} > $new_cost) { 86 # update new cost for the neighbor 87 $costs{$neighbor} = $new_cost; 88 # the current node becomes the parent of the neighbor 89 $parents{$neighbor} = $node; 90 } 91 } 92 # mark the node as processed 93 $processed{$node} = 1; 94 # find the next node to process 95 $node = find_lowest_cost_node; 96 } 97 98 # @path if our array holding the shortest path 99 # we build it up starting from the end ('fin') and append the coresponding 100 # parent ($parents{$path[0]}) to the FRONT of the array until we reach the 101 # beginning ('start') 102 my @path = ('fin'); 103 unshift @path => $parents{$path[0]} while ($path[0] ne 'start'); 104 say "weight of shortest path is $costs{'fin'}"; 105 say "which is achieved by the following path:"; 106 say join " -> " => @path;