algorithms

Repository of programs that demonstrate basic algorithms I've been learning
git clone git://git.samirparikh.com/algorithms
Log | Files | Refs | README

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;