Perl Weekly Challenge: Week 213
Challenge 1:
Fun Sort
You are given a list of positive integers.
Write a script to sort the all even integers first then all odds in ascending order.
Example 1
Input: @list = (1,2,3,4,5,6)
Output: (2,4,6,1,3,5)
Example 2
Input: @list = (1,2)
Output: (2,1)
Example 3
Input: @list = (1)
Output: (1)
Raku has a nice method called .classify(). It assigns elements in a list to keys in a hash based
on criteria you set. (It can even create the hash for you with :into.)
@list.classify( { $_ %% 2 ?? 'even' !! 'odd' }, :into( my %class; ) );
Now we can simply create the list of results by appending %class{'even'} and %class{'odd'} making
sure to sort each one in ascending numeric order first. Note the second list has a | in front of it
so the "flat" list elements are added not a list reference.
my @results = %class{'even'}.sort({ $^a <=> $^b });
@results.push(| %class{'odd'}.sort({ $^a <=> $^b }) );
And print out the results in the format used by the examples.
say q{(}, @results.join(q{,}), q{)};
Perl cannot be quite so concise though it comes pretty close.
First we set up lists to store the odd and even numbers.
my @odd;
my @even;
Then we iterate through @list, testing each value if it is even or odd and assigning it to the proper
list.
for my $i (@list) {
if ($i % 2 == 0) {
push @even, $i;
} else {
push @odd, $i;
}
}
@even and @odd are added to @results after being sorted in ascending numeric order.
my @results = sort { $a <=> $b} @even;
push @results, sort { $a <=> $b } @odd;
And @results is printed out in the appropriate format.
say q{(}, (join q{,}, @results), q{)};
Challenge 2:
Shortest Route
You are given a list of bidirectional routes defining a network of nodes, as well as source and destination node numbers.
Write a script to find the route from source to destination that passes through fewest nodes.
Example 1
Input: @routes = ([1,2,6], [5,6,7])
$source = 1
$destination = 7
Output: (1,2,6,7)
Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6
then jump to route [5,6,7] and takes the route 6 -> 7.
So the final route is (1,2,6,7)
Example 2
Input: @routes = ([1,2,3], [4,5,6])
$source = 2
$destination = 5
Output: -1
Example 3
Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8])
$source = 1
$destination = 7
Output: (1,2,3,8,7)
Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3
then jump to route [3,8,9] and takes the route 3 -> 8
then jump to route [7,8] and takes the route 8 -> 7
So the final route is (1,2,3,8,7)
Conceptually this challenge is simple. We have to do a breadth-first search of a graph starting from the node that represents the source upto the node that represents the destination. However getting that concept into code took me longer than it would.
The first problem is getting the input from the command line into a graph structure. I chose to express
the input as the first two parameters being the source and destination and the rest being the routes. Each
route would be a string containing integers separated by spaces. So the beginning of MAIN() looks like this:
sub MAIN(
$source, $destination, *@list
) {
This line takes the strings we got from the command line and transforms them into arrays of integers.
my @routes = @list.map({ $_.split(/\s+/) });
And then all we have to do is:
my @path = findShortestPath(@routes, $source, $destination);
...and we're done. Simple eh? As you've no doubt guessed, there is actually a lot more going on behind
the scenes of findShortestPath().
The first thing it does is create the graph:
sub findShortestPath(@routes, $source, $destination) {
my %graph = makeGraph(@routes);
This was sufficiently involved that I made it into its' own function.
sub makeGraph(@routes) {
In the graph, the keys will be nodes in the graph. They will be encoded as the number of the route, the node is in and the position in the route it is separated by a hyphen. The values will be an array of 0 or more other nodes that this node connects to.
my %graph;
For each route we have...
for 0 ..^ @routes.elems -> $i {
...And each element within that route...
for 0 ..^ @routes[$i].elems -> $j {
By the way, you may be wondering why I used .elems() to find the end of the route instead of .end().
Well, I also use it a few lines below in this function and as a result I was getting a strange error
message The iterator of this Seq is already in use/consumed by another Seq... The message gave some
suggestions as to how to fix it but I was short on time so I just replaced the usage here instead.
Anyway, if this is not the first element, we make a connection to the element before it.
if $j != 0 {
%graph{"$i-$j"}.push("$i-" ~ $j - 1);
}
And if it is not the last element, we make a connection to the element after it. This way we can quickly achieve the bidirectionality the spec requires. (execept the first and last elements which only have one connection each.)
if $j != @routes[$i].end {
%graph{"$i-$j"}.push("$i-" ~ $j + 1);
If it is the last element, there is one more scenario to consider; there could be a condition to a
completely different route. To find this, I call yet another function makeLink().
} else {
my $l = makeLink(@routes, $i, @routes[$i][@routes[$i].end]);
makeLink() looks like this:
sub makeLink(@routes, $currentRoute, $value) {
For each route...
for 0 .. @routes.end -> $i {
If it is the route we are currently in, skip it and move on to the next one.
if $i == $currentRoute {
next;
}
For each element in that route (I ran into the 'iterator already in use' problem again.) ...
for 0 ..^ @routes[$i].elems -> $j {
If we find the value we seek, we return its' position in our special graph key format.
if @routes[$i;$j] == $value {
return "$i-$j";
}
}
}
If we've gone through all the routes and not found the value, we return an empty string to signify an error.
return "";
}
Back to makeGraph(). Unless makeLink() gave an error...
unless $l eq q{} {
...we add two connections to the graph, from this node to the one makeLink() found and from
there back to this one.
%graph{"$i-" ~ @routes[$i].end}.push($l);
%graph{$l}.push("$i-" ~ @routes[$i].end);
}
}
}
}
When we are done with all this, we can return the newly populated graph.
return %graph;
}
Now back in findShortestPath(), the next step is to find where in the graph are $source and $destination.
my $startNode = findKeyFor(@routes, $source);
my $endNode = findKeyFor(@routes, $destination);
This requires yet another function, findKeyFor() which looks like this:
sub findKeyFor(@routes, $target) {
for 0 .. @routes.end -> $i {
for 0 .. @routes[$i].end -> $j {
if @routes[$i;$j] == $target {
return "$i-$j";
}
}
}
return "";
}
Once again we go through all the nodes in every route. If we find one whose value is the same as the target, we return its location in the graph key format or if not, an empty string.
Back in findShortestPath(), if our attempts to find source and destination nodes failed, there is
no point in proceeding so we just return an empty path to signal an error has occured.
if $startNode eq q{} || $endNode eq q{} {
return ();
}
We can finally begin searching for the shortest path. We do this using gather to lazily get
results from the traverse() function. It returns the node it is currently on and the current path.
for gather traverse(%graph, $startNode) -> ($node, @path) {
If the node is Nil it means the search has gone through every node in the graph and failed to find
the destination. We return an empty list at this point to signify failure.
if $node ~~ Nil {
return ();
}
If the node is the $endNode we have success. We can return @path which will be the shortest path
from source to destination.
if $node ~~ $endNode {
return @path;
}
}
}
This is traverse() which does the actual breadth first search:
sub traverse(%graph, $startNode) {
We need to keep track of which nodes have already been visited to prevent cycles.
my %visited;
Also a queue of nodes we need to check. We begin by adding the $startNode to the queue.
my @queue = ( $startNode );
And we also mark the $startNode as visited.
%visited{$startNode} = True;
While there are nodes in the queue...
while @queue.elems {
...We had the node at the top of the queue to the path. I added .flat() to
the end because @queue and @path actually deal with a tree data structure. Every time we have a choice
of a new direction to traverse in the graph, we add a new branch to the tree. .flat() ensures
we only add the tip of the branch to the path not the whole thing.
my @path = @queue.shift.flat;
The node we just added to the path becomes our next node for consideration. my $node = @path[*-1];
We send $node and @path to the gathering function findShortestPath().
take $node, @path;
For each node that this node is connected to...
for %graph{$node}.values -> $v {
...If it hasn't already been visited...
if !%visited{$v} {
...we mark it as visited and add it to the queue in the current branch of our tree.
%visited{$v} = True;
@queue.push((my @next = @path).push($v));
}
}
}
If for some reason the queue becomes totally empty, it means we have traversed all the nodes in the graph.
take Nil, ();
}
Finally, we can get back to MAIN().
findShortestPath() returned either a fully populated path from source to destination or an empty
list if something went wrong. If the latter, we just print -1 and exit the script.
unless @path.elems {
say -1;
exit;
}
The next bit is the way it is for a couple of reasons. First, the path contains positions of elements within routes. We want the values associated with those positions. Secondly, a quirk of the way I have done the search, is that every time there is a jump from one route to another, a node is added to the path twice$mdash;as the last node in the old route and as the first node in the new route. It would be enough in most cases to eliminate the first node in the new route except when you start the path (i.e. in the very first route) when you want to keep the first node.
This problem is solved by removing the first element of the @path. It is split into its' two components,
the route and the element within that route. The route is used to initialize$currentRoute. $route and $elem
together are used to find a position within @routes and the value associated with it which is then added to a new
array @results.
my ($route, $elem) = @path.shift.split(q{-});
my $currentRoute = $route;
my @results = ( @routes[$route;$elem] );
Then the same is done for the rest of @path accept when the $currentRoute changes, the value of that node is not added to @results.
for @path -> $node {
my ($route, $elem) = $node.split(q{-});
if $route == $currentRoute {
@results.push(@routes[$route;$elem]);
} else {
$currentRoute = $route;
}
}
After all this we can print out the results.
say q{(}, @results.join(q{,}), q{)};
}
This is the Perl version. I'll just add a few notes.
I really detest Perls' syntax for complex data structures such as two-dimensional arrays. I eventually get it right but always manage to end up creating bugs along the way.
sub makeLink {
my ($routes, $currentRoute, $value) = @_;
for my $i (0 .. scalar @{$routes} - 1) {
if ($i == $currentRoute) {
next;
}
for my $j (0 .. scalar @{$routes->[$i]} - 1) {
if ($routes->[$i][$j] == $value) {
return "$i-$j";
}
}
}
return "";
}
sub findKeyFor {
my ($routes, $target) = @_;
for my $i (0 .. scalar @{$routes} - 1) {
for my $j (0 .. scalar @{$routes->[$i]} - 1) {
if ($routes->[$i]->[$j] == $target) {
return "$i-$j";
}
}
}
return "";
}
sub makeGraph {
my ($routes) = @_;
my %graph;
for my $i (0 .. scalar @{$routes} - 1) {
for my $j (0 .. scalar @{$routes->[$i]} - 1) {
if ($j != 0) {
push @{$graph{"$i-$j"}}, "$i-" . ($j - 1);
}
my $end = scalar @{$routes->[$i]} - 1;
if ($j != $end) {
push @{$graph{"$i-$j"}}, "$i-" . ($j + 1);
} else {
my $l = makeLink($routes, $i, @{$routes->[$i]}[$end]);
unless ($l eq q{}) {
push @{$graph{"$i-$end"}}, $l;
push @{$graph{$l}}, "$i-$end";
}
}
}
}
return \%graph;
}
Perl doesn't have gather/take built in so the design of traverse() and findShortestPath() has
to be slightly different.
sub traverse {
my ($graph, $startNode, $endNode) = @_;
my %visited;
my @queue = ( [$startNode] );
while (scalar @queue) {
my $path = shift @queue;
my $node = @{$path}[-1];
if ($node eq $endNode) {
return @{$path};
}
for my $v (@{$graph->{$node}}) {
if (!exists $visited{$v}) {
$visited{$v} = undef;
my @next = @{$path};
push @next, $v;
push @queue, \@next;
}
}
}
}
sub findShortestPath {
my ($routes, $source, $destination) = @_;
my $graph = makeGraph($routes);
my $startNode = findKeyFor($routes, $source);
my $endNode = findKeyFor($routes, $destination);
if ($startNode eq q{} || $endNode eq q{}) {
return ();
}
return traverse($graph, $startNode, $endNode);
}
my $source = shift;
my $destination = shift;
my @routes;
In order to prevent all the routes from being mushed into one list, each is added as a list reference.
for my $route (@ARGV) {
push @routes, [ split /\s+/, $route ];
}
my @path = findShortestPath(\@routes, $source, $destination);
unless (scalar @path) {
say -1;
exit;
}
my ($route, $elem) = split q{-}, shift @path;
my $currentRoute = $route;
my @results = ( $routes[$route][$elem] );
for my $node (@path) {
my ($route, $elem) = split q{-}, $node;
if ($route == $currentRoute) {
push @results, $routes[$route][$elem];
} else {
$currentRoute = $route;
}
}
say q{(}, (join q{,}, @results), q{)};