1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-213/#TASK2
  3 #
  4 # Task 2: Shortest Route
  5 # ======================
  6 #
  7 # You are given a list of bidirectional routes defining a network of nodes, as well as source and destination node numbers.
  8 #
  9 # Write a script to find the route from source to destination that passes through fewest nodes.
 10 #
 11 ## Example 1:
 12 ##
 13 ## Input: @routes = ([1,2,6], [5,6,7])
 14 ##        $source = 1
 15 ##        $destination = 7
 16 ##
 17 ## Output: (1,2,6,7)
 18 ##
 19 ## Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6
 20 ## then jump to route [5,6,7] and takes the route 6 -> 7.
 21 ## So the final route is (1,2,6,7)
 22 #
 23 ## Example 2:
 24 ##
 25 ## Input: @routes = ([1,2,3], [4,5,6])
 26 ##        $source = 2
 27 ##        $destination = 5
 28 ##
 29 ## Output: -1
 30 #
 31 ## Example 3:
 32 ##
 33 ## Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8])
 34 ##        $source = 1
 35 ##        $destination = 7
 36 ## Output: (1,2,3,8,7)
 37 ##
 38 ## Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3
 39 ## then jump to route [3,8,9] and takes the route 3 -> 8
 40 ## then jump to route [7,8] and takes the route 8 -> 7
 41 ## So the final route is (1,2,3,8,7)
 42 #
 43 ############################################################
 44 ##
 45 ## discussion
 46 ##
 47 ############################################################
 48 #
 49 # We first search for a potential source, from which we look
 50 # for all possible paths, from which we select shortest one
 51 # We do this by creating all possible permutations of the
 52 # list of paths, then try to walk each of those as follows:
 53 # - find the source in the first path
 54 # - for each possible middle destination in this path, walk
 55 #   to that point, then jump to the next path, searching this
 56 #   middle destination as the new source, and walk from the
 57 #   next path in the same manner.
 58 # - if at some point during this walk we find the final
 59 #   destination, then we have found the shortest path with
 60 #   the current permutation of the original array and keep
 61 #   the found solution, backtracking again to the next
 62 #   permutation
 63 # - in the end pick the first solution with the minimum
 64 #   amount of steps (this only makes a difference if there
 65 #   are indeed multiple paths of the same "length".
 66 
 67 use strict;
 68 use warnings;
 69 
 70 shortest_route(1, 7, [1,2,6], [5,6,7]);
 71 shortest_route(2, 5, [1,2,3], [4,5,6]);
 72 shortest_route(1, 7, [1,2,3], [4,5,6], [3,8,9], [7,8]);
 73 shortest_route(1, 7, [1,2,3], [4,5,6], [3,8,9], [7,8]);
 74 shortest_route(1, 7, [1,2,3], [4,5,6], [3,8,9], [7,8], [3,5,7]);
 75 shortest_route(1, 7, [1,2,3], [4,5,6], [3,8,9], [3,5,7]);
 76 shortest_route(1, 7, [1,2,3], [4,5,6], [3,8,9], [3,5,6,7], [2,7]);
 77 shortest_route(1, 7, [1,2,3,4,5,6,7], [2,7]);
 78 
 79 # This is the "outer" function. It prints the input, calls a
 80 # function to create all permutations of the input array @routes,
 81 # then collects the potential solutions for each of these
 82 # permutations. If nothing was found, the output "-1" is printed.
 83 # Otherwise, the first path with the least amount of steps is
 84 # selected and printed.
 85 sub shortest_route {
 86    my ($source, $destination, @routes) = @_;
 87    # print the input
 88    print "Input: \@routes = ( ";
 89    my $first = 1;
 90    foreach my $elem (@routes) {
 91       print ", " unless $first;
 92       $first = 0;
 93       print "[" . join(",", @$elem) . "]";
 94    }
 95    print " )\n\$source = $source\n\$destination = $destination\n";
 96    # find all possible permutations of the input array @routes
 97    my @permutations = get_permutations(@routes);
 98    my @found_routes = ();
 99    # collect the solutions for each permutation
100    foreach my $p (@permutations) {
101       push @found_routes, find_more_routes($source, $destination, @$p);
102    }
103    # if no solution was found we're done
104    unless(@found_routes) {
105       print "Output: -1\n";
106       return;
107    }
108    # find shortest route
109    my $min = $found_routes[0]->[0];
110    my $min_route = $found_routes[0]->[1];
111    foreach my $elem (@found_routes) {
112       if($elem->[0] < $min) {
113          $min = $elem->[0];
114          $min_route = $elem->[1];
115       }
116    }
117    # print the result
118    print "Output: $min (" . join(",", @$min_route) . ")\n";
119 }
120 
121 # given a permutation of the routes, this function will pick the
122 # source in the first route, then walk to each possible destination
123 # inside this route and use that as an intermediate source to start
124 # from in the next route (which is then a recursive call to the same
125 # function with the start_route eliminated)
126 sub find_more_routes {
127    my ($source, $destination, $start_route, @remaining_routes) = @_;
128    # if there is no start_route we hit the end of recursion since
129    # we're out of routes
130    return () unless $start_route;
131    my @start_route = @$start_route;
132    my @results = ();
133    my $start_position = -1;
134    # find where in the start route the source is
135    foreach my $i (0..$#start_route) {
136       if($start_route[$i] == $source) {
137          $start_position = $i;
138          last;
139       }
140    }
141    # return an empty result set if the source was not found
142    # since all possible solutions will be found by other
143    # permutations, not this one
144    return () if $start_position == -1;
145    # check if the destination is also in the start route
146    my $end_position = -1;
147    foreach my $i (0..$#start_route) {
148       if($start_route[$i] == $destination) {
149          $end_position = $i;
150          last;
151       }
152    }
153    # if we found the destination in the start route we can add
154    # the corresponding path to the solution set. This can be
155    # forward or backward, so check both cases
156    # It is important that this might not be the shortest path
157    # overall. If we have source 1, destination 7 and the routes
158    # [1,2,3,4,5,6,7], [2,7], then (1,2,3,4,5,6,7) is not the
159    # shortest path even though it is in the same single route.
160    # So we just keep the solution, but we keep searching for
161    # other solutions recursively below as well
162    if($end_position != -1) {
163       if($end_position > $start_position) {
164          my $len = $end_position - $start_position;
165          my @path = @start_route[$start_position..$end_position];
166          push @results, [$len, [@path]];
167       } else {
168          my $len = $start_position - $end_position;
169          my @path = reverse @start_route[$end_position..$start_position];
170          push @results, [$len, [@path]];
171       }
172    }
173 
174    # starting from the source in the start route, go forward and backward
175    # to any element in the list, search for all paths with this new source
176    # and the remaining routes and add those results to the temporary length and path
177    # that were found so far. push all found results onto the @results array
178    # We start with the first half of the start_route (destinations that are
179    # before the source in the start_route)
180    foreach my $i (0..$start_position-1) {
181       my $len = $start_position - $i;
182       my @path = reverse @start_route[$i..$start_position]; # path (1,2,3) turns into (3,2,1)
183       last if $i == $end_position; # if we happen to find our final destination we are done
184       my $new_start = $start_route[$i];
185       my @tmp_results = find_more_routes($new_start, $destination, @remaining_routes);
186       foreach my $elem (@tmp_results) {
187          # each solution that we collect has the new length $len (temporary length
188          # inside the start_route) + length of the found solution from the recursive
189          # call. The path is the path inside the start_route (minus the last element
190          # so we don't count the same node twice as it's also the start in the solution
191          # from the recursive call)
192          my @tmp = @path;
193          pop @tmp;
194          push @results, [ $len+$elem->[0], [ @tmp, @{ $elem->[1] } ] ];
195       }
196    }
197    # Now the second half of the start_route where the destinations are after
198    # the source
199    foreach my $i ($start_position+1..$#start_route) {
200       my $len = $i - $start_position;
201       my @path = @start_route[$start_position..$i]; # no need to reverse the path here
202       last if $i == $end_position; # if we happen to find our final destination we are done
203       my $new_start = $start_route[$i];
204       my @tmp_results = find_more_routes($new_start, $destination, @remaining_routes);
205       foreach my $elem (@tmp_results) {
206          # same as above, no need to duplicate that comment
207          my @tmp = @path;
208          pop @tmp;
209          push @results, [ $len+$elem->[0], [ @tmp, @{ $elem->[1] } ] ];
210       }
211    }
212 
213    return @results;
214 }
215 
216 # This helper function gets all permutations of an array and
217 # returns those at once. If we'd have to work on huge arrays,
218 # this should be turned into an iterator which returns
219 # one permutation per call
220 sub get_permutations {
221    my @array = @_;
222    return () unless @array;
223    my @result;
224    foreach my $i (0..$#array) {
225       my @slices = ();
226       push @slices, @array[0..$i-1] if $i > 0;
227       push @slices, @array[$i+1..$#array] if $i < $#array;
228       if(@slices) {
229          foreach my $p (get_permutations(@slices)) {
230             push @result, [ $array[$i], @$p ];
231          }
232       } else {
233          push @result, [ $array[$i] ];
234       }
235    }
236    return @result;
237 }
238