PWC 213 A fun sort and a run short
Tags: perl, pwc, perlweeklychalleng
Published: 2023-04-24 02:13:36

Week 213 (!) of the [Perl Weekly Challenge](https://theweeklychallenge.org/blog/perl-weekly-challenge-213/) poses two problems that are good exercises in Perl programming.

## Task 1: Fun Sort

This sort is fun in the sense that it's pretty easy to do.

> You are given a list of positive integers.
> Write a script to sort the all even integers first, 
> then all odds in ascending order.

There are three approaches:  (1) sort the whole list with a comparison function that moves all the evens to the front of the list; (2) first separate the odds and evens, sort each group, and then combine the groups; or (3) first sort the whole list, then divide into evens and odds.

My preference is to do it in one sort, but it might be more efficient to partition the list first and do two smaller sorts. The sort efficiency is probably _O(n log(n))_.  Sorting two lists of size _n/2_ will have fewer operations. For instance, if _n_=50, 50log(50) =~ 196, but 2*(25log(25)) =~ 161.  This isn't going to be significant until _n_ gets very large.

### One sort to rule them all

In Perl, `sort` is builtin, and operates by applying a comparison function between pairs of elements, denoted `$a` and `$b`. The comparison function needs to return one of three values: less than 0 if `$a` sorts below `$b`; 0 if `$a` == `$b`; or greater than 0 if `$a` sorts above `$b`.  Perl has a three-way comparison operator that does this for numbers, the `<=>` operator. A very basic numeric sort supplies the comparison function as the first argument to `sort`:
``` perl
sort { $a <=> $b } @list
```

We also need to be able to determine odd and even.  Mathematically, it's the modulo operator.  `n mod 2` is 0 for an even number and 1 for an odd number.  Programmatically, it's the least significant bit of an integer. `n&1` will be 0 for an even number and 1 for an odd number.

We need a comparison which has two conditions:  first, any even number sorts below any odd number; otherwise, sort numerically.  This is expressed with 
``` perl
sort { (($a&1) <=> ($b&1)) || ($a <=> $b) } @list 
```
The check for even and odd will push the even numbers below the odd numbers because the conditions evaluate like this:

|  a  | b    | a&1 | b&1 | a&1 <=> b&1 
|:---:|:----:|:---:|:---:|:-----------:
|even | even |  0  |  0  | 0
|even | odd  |  0  |  1  | -1
|odd  | even |  1  |  0  | 1
|odd  | odd  |  1  |  1  | 0

If that is enough to determine an order, the `||` operator will not even evaluate its right side, but if both numbers are odd or both even, then the second comparison will determine the order.

### Divide and conquer

The second approach is to partition the list into odds and evens before sorting.  The easiest way to select a subset of a list is to use `grep`.  We already know how to determine odd and even: _n&1_ will give us either a 0 or a 1, which are conviently equivalent to _false_ and _true_.
```perl
my @odd = grep { $_ & 1 } @list; 
my @even = grep { $_ & 1) == 0 } @list;
```
It would be fun (and this is Fun Sort, after all) to do it with one pass.  We can do that by using the 0 or 1 as index to an array of lists.
```perl
my @group = ([], []);  # [0] is evens, [1] is odds
push @{$group[$_&1]}, $_ for @list; 
```

It would be programmer-efficient, but somewhat less fun, to use a library module that already does list partitioning.  That would be the `part` function from `List::MoreUtils`.  The whole [List::MoreUtils](https://metacpan.org/pod/List::MoreUtils) module is pretty fun, actually, full of useful functions that you didn't know you needed and won't have to write yourself.
```perl
sub funSort_partB(@list)
{
    use List::MoreUtils qw/part/;
    my @sorted;
    for my $sub ( part { $_ % 2} @list )
    {
        next unless defined $sub;
        push @sorted, sort { $a <=> $b } $sub->@*;
    }
    return \@sorted;
}
```
`part` will return a list of array references.  If there are no even numbers or no odd numbers, one of the partitions may be empty, in which case `part` has an _undef_ element, not an empty list. Hence, the `next` statement.  If we pass that point, then _$sub_ is an array reference, and `$sub->@*` is the de-reference; that is, the list of array elements.  The result of the sort gets pushed to the end of the `@sorted` array -- recall that multiple elements can be pushed at once.

### Conquer and divide

The final approach is to do a simple numeric sort, then partition the resulting sorted list.  We've already lined up all the pieces we need from the first two approaches.  We can use `List::Util::part` after the sort, and then the only missing piece is how to flatten lists of lists into one.
One way is by de-referencing the lists and using a loop to push the elements, as we did in the function above.  The other, less fun, way is to reach for another library function.  How about _List::Flatten::flat_?
```perl
sub funSort_part(@list)
{
    use List::MoreUtils qw/part/;
    use List::Flatten qw/flat/;

    return [ grep { defined } flat part { $_ % 2 } sort { $a <=> $b} @list ];
}
```
Perl is still fun, though. Here we've chained several array operations to avoid having to write loops.  From right to left,
1. _sort_ is a simple numeric sort
1. _part_ separates into even and odd
1. _flat_ joins the array references into one list
1. _grep_ takes care of the problem that one of the sub-lists might be empty
1. wrapping the whole thing in square brackets creates a new array reference that can be returned

The complete code solution is on [Github](https://github.com/boblied/perlweeklychallenge-club/blob/master/challenge-213/bob-lied/perl/ch-1.pl)

## Task 2: Shortest route
Our problem states:
> 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.

and it offers as an example:
```text
Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8])
       $source = 1
       $destination = 7
Output: (1,2,3,8,7)
```
Because of the way the problem is presented, I thought first of intersection of sets, but that's a red herring. If we put all the nodes together and draw edges between them, we'll see that the routes are just subsets of a bigger graph.

![Union of the routes forms a graph](https://dev-to-uploads.s3.amazonaws.com/uploads/articles/7vt0yuxm3vaw3twacbib.jpg)

And if that's what we have, then this is a classic computer science algorithm problem:  shortest path in an undirected graph.  There's an intuitive solution for it, breadth-first search.  It involves going one step out from the start node to all of its neighbers, and then going one step to each of their neighbors, and so on until the destination node is found (or not).

It's not a terribly hard algorithm, but not one I can trivially construct from scratch.  Although Google is your friend here, I took the opportunity for nostalgia.  There's still a copy of Sedgewick's "Algorithms" on my shelf.  It's the 2nd edition from 1988, helpfully presenting the algorithms in Pascal, which was probably a good idea at the time.

```pascal
procedure listbfs;
  var id, k: integer;
    val: array[1..maxV] of integer;
  procedure visit(k: integer);
    var t: link;
    begin
    put(k);
    repeat
      k := get;
      id := id + 1;
      val[k] := id;
      t := adj[k];
      while t <> z do
        begin
        if val[t^.v] = 0 then
          begin put(t^.v); val[t^.v] := -1; end;
        t := t^.next;
        end
      until queueempty;
      end;
  begin
    id := 0; queueinitialize;
    for k := 1 to V do val[k] := 0;
    for k := 1 to V do
      if val[k] = 0 then visit(k)
    end;
```
Well, that was amusing, but we have Perl.

The trick to graph algorithms is finding the right data structure to represent the graph. I decided to make a little _Moo_ class for the graph, where the graph is represented as a collection of nodes in a hash. Each  node has an associated list (array reference) of nearest neighbors.  The graph is built up from  methods that add nodes and edges.

```perl
    sub addNode($self, $n)
    {
        $self->{adj}{$n} //= [];
    }

    sub addEdge($self, $v1, $v2)
    {
        $self->addNode($v1);
        my $neighbors = $self->{adj}{$v1};
        push @{$neighbors}, $v2 unless grep { $_ == $v2 } $neighbors->@*;
        return $self;
    }
```
For the graph from the example, we're going to end up with an adjacency list that looks like:

```perl
adj = { 1 => [2],
        2 => [1,3],
        3 => [2,8],
        4 => [5],
        5 => [4,6],
        6 => [5],
        7 => [8],
        8 => [3,7,9],
        9 => [8], };
```
Iterating over the routes in the input will build up the graph using the object methods:

```perl
my $g = Graph->new;
for my $route ( $segments->@* )
{
    my $v1 = shift @$route;
    $g->addNode($v1);
    while ( @$route )
    {
        my $v2 = shift @$route;
        $g->addEdge($v1,$v2)->addEdge($v2,$v1);
        $v1 = $v2;
    }
}
```
To move across pairs of nodes in a route, I used an idiom to shift the the first element (`$v1`), and then continue to shift a second element (`$v2`) until the array is used up.  There's a function `slide` in the _List::MoreUtils_ module that embodies this algorithm that I could have used.

Notice also that the `addEdge` method returns a reference to the object, which allows me to chain method calls.  Since the graph is bi-directional, I want to add an edge from `$v1` to `$v2` and vice versa.  The chaining idiom makes it (in my opinion) readable to express that.

Once the nodes and edges are available in the graph, we can use the breadth-first search algorithm as the function to find a route.  The algorithm uses an array as a queue (which Perl makes easy to do with its push and shift functions).  As each node is encountered, its neighbors are put on the queue for checking later. Once we stumble over the destination node, we're done.

The main complication in the breadth-first algorithm is that we don't want to get stuck in a loop, so we keep a list of nodes that have already been processed.  I use a hash, `%seen`, for this purpose because it has fast look-up for node names.
```perl
sub route($self, $source, $destination)
{
    return [ $source] if ( $source == $destination );

    # Breadth-first search
    my @path;
    my @queue = ( $source );
    my %seen;

    while ( @queue )
    {
        my $node = shift @queue;
        push @path, $node;

        my $neighbors = $self->{adj}{$node};
        for my $neighbor ( grep { !$seen{$_} } $neighbors->@* )
        {
            if ( $neighbor == $destination )
            {
                return [ @path, $neighbor ];
            }
            push @queue, $neighbor;
        }

        $seen{$node} = true;
    }
    return [];
}
```

I return an empty list to indicate "not found".  The challenge asks us to report -1 for that, but that's easily done in the calling code.  Consistently returning a list simplifies the testing code. The complete code solution is on [Github](https://github.com/boblied/perlweeklychallenge-club/blob/master/challenge-213/bob-lied/perl/ch-2.pl)