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;