# algorithms

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

dijkstra_shortest_path.pl (4989B) - raw

```      1 #!/usr/bin/env perl
2
3 use strict;
4 use warnings;
5 use v5.22;
6
7 # declare our constants
8 # program assumes that the graph (matrix) we want to traverse is composed only
9 # of values between 0 and 9, inclusive.  Therefore, we'll be defining both a
10 # boundary column and row composed of values equal to LIMIT which we can safely
11 # ignore when we are processing the neighbors of a node during our graph
12 # traversal
13 use constant LIMIT => 10;
14
15 sub get_filehandle {
16   if (@ARGV !=1) {
17     die "Usage: \$0 [input-filename]";
18   }
19   my \$input_filename = \$ARGV[0];
20   open my \$filehandle, '<', \$input_filename or
21     die "Could not open input file \$input_filename: \$!";
22   return \$filehandle;
23 }
24
25 sub define_matrix {
26     my \$filehandle = shift;
27     my @matrix     =  map{ [m/\d/g, LIMIT] } <\$filehandle>; # add boundary column
28     my \$columns    =  @{\$matrix[0]};
29     push @matrix   => [ (LIMIT) x \$columns ];               # add boundary row
30     return @matrix;
31 }
32
33 sub init_graph_costs {
34     my \$matrix_ref = shift;
35     my @mat = @{ \$matrix_ref };
36     my %grph;
37     my %csts;
38     my \$r = scalar @mat;                # number of rows
39     my \$c = scalar @{ \$mat[0] };        # number of columns
40     foreach my \$row (0 .. \$r - 2) {
41         foreach my \$col (0 .. \$c - 2) {
42             \$csts{\$row, '-', \$col} = 'inf'; # set initial costs to infinity
43             foreach my \$neighbor ([0, 1], [1, 0], [0, -1], [-1, 0]) {
44                 my \$n_row = \$row + \$neighbor->[0];
45                 my \$n_col = \$col + \$neighbor->[1];
46                 # here we set the weights of each edge between the nodes
47                 # the weight is equal to the "to" node unless we've hit a
48                 # boundary row or column
49                 \$grph{\$row, '-', \$col}{\$n_row, '-', \$n_col} = \$mat[\$n_row][\$n_col]
50                     unless (\$mat[\$n_row][\$n_col] == LIMIT);
51             }
52         }
53     }
54     # initialize the starting edge, from "start" to the first node (0, 0)
55     \$grph{'start'}{0, '-', 0} = \$mat[0][0];
56     # initialize the last edge, from the last node to "end"
57     \$grph{\$r - 2, '-', \$c - 2}{'end'}   = 0;
58     # the "cost" to get to the first node is the value of the first node
59     \$csts{0, '-', 0}          = \$mat[0][0];
60     # set initial cost to get to the "end" node to infinity
61     \$csts{'end'}              = 'inf';
62     return (\%grph, \%csts);
63 }
64
65 sub find_lowest_cost_node {
66     my (\$costs_ref, \$processed_ref) = @_;
67     my %csts = %{ \$costs_ref };
68     my %proc = %{ \$processed_ref };
69     # set lowest cost to infinity for initial comparison
70     my \$lowest_cost = 'inf';
71     # set default lowest cost node to None in case none if sound
72     my \$lowest_cost_node = 'None';
73     # for each node in our costs table
74     foreach my \$node (keys %csts) {
75         my \$cost = \$csts{\$node};
76         # check if node is lowest cost so far AND
77         # it has not yet been processed by our main while loop
78         if (\$cost < \$lowest_cost && !exists \$proc{\$node}) {
79             # if it is, update our \$lowest_cost and \$lowest_cost_node
80             \$lowest_cost      = \$cost;
81             \$lowest_cost_node = \$node;
82         }
83     }
84     # will return None if all nodes have been processed
85     return \$lowest_cost_node;
86 }
87
88 # initialize variables
89 my \$filehandle              = get_filehandle();
90 my @matrix                  = define_matrix(\$filehandle);
91 my (\$graph_ref, \$costs_ref) = init_graph_costs(\@matrix);
92 my %graph                   = %{ \$graph_ref };
93 my %costs                   = %{ \$costs_ref };
94 my %parents;
95 # the parent of the first node will always be "start"
96 \$parents{0, '-', 0}         = 'start';
97 # hash to track all of the nodes we have already processed
98 my %processed;
99 my \$node                    = find_lowest_cost_node(\%costs, \%processed);
100
101 while (\$node ne 'None') {
102     my \$cost = \$costs{\$node}; # cost to get to current node
103     my @neighbors = keys %{\$graph{\$node}}; # neighbors of node
104     # go through all neighbors of this node
105     foreach my \$neighbor (@neighbors) {
106         # calculate new cost of getting to neighbor via this node
107         my \$new_cost = \$cost + \$graph{\$node}{\$neighbor};
108         # if it's cheaper to get to this neighbor through this node
109         if (\$costs{\$neighbor} > \$new_cost) {
110             # update new cost for the neighbor
111             \$costs{\$neighbor} = \$new_cost;
112             # the current node becomes the parent of the neighbor
113             \$parents{\$neighbor} = \$node;
114         }
115     }
116     # mark the node as processed
117     \$processed{\$node} = 1;
118     # find the next node to process
119     \$node = find_lowest_cost_node(\%costs, \%processed);
120 }
121
122 # @path is our array holding the shortest path
123 # we build it up starting from the end ('fin') and append the coresponding
124 # parent (\$parents{\$path[0]}) to the FRONT of the array until we reach the
125 # beginning ('start')
126 my @path = ('end');
127 unshift @path => \$parents{\$path[0]} while (\$path[0] ne 'start');
128 say "weight of shortest path is \$costs{'end'}";
129 say "which is achieved by the following path:";
130 say join " -> " => @path;
```