PWC 214 (1) Rank Score, (2) Collect Points, (3) ..., (4) Profit!
Tags: perl, pwc, perlweeklychallenge
Published: 2023-04-28 20:05:19

Another week, another weekly challenge. For week 214, we get to practice indirection, and an opportunity for recursion.

## Task 1:  Rank Score

Task 1, [Rank Score](https://theweeklychallenge.org/blog/perl-weekly-challenge-214/#TASK1) is to assign medals to players in a contest.
```text
You are given a list of scores (>=1).

Write a script to rank each score in descending order.
First three will get medals i.e. G (Gold), S (Silver) 
and B (Bronze). Rest will just get the ranking number.

Using the standard model of giving equal scores equal rank,
then advancing that number of ranks.
```
We are also given an example so that we can infer how to treat ties:
```text
Input: @scores = (2,5,2,1,7,5,1)
Output: (4,S,4,6,G,S,6)
```
We need to preserve the order of the players in the `@scores` array.  We're going to need the information that the highest score (gold) is in position 5, the next two (silver) are in positions 1 and 6, and so on.

It is a cliche that all problems in computer science are solved by adding a level of indirection, and that is true here. The first indirection is that we want to sort not the scores themselves, but the indexes of the scores.
```perl
@position = sort { } 0 ..$#scores
```
and the condition for sorting will be a comparison of the scores at that index. The sort is in descending order, so that the index of the highest score (gold) will be at the front of the list.
```perl
@position = sort { @scores[$b] <=> @scores[$a] } 0 .. $#scores
```
Taking a simpler example, let's look at `@scores = (1,2,4,3,5)`.  Our sort will give us a mapping between the index in `@scores` and the assignment of the rank:
```perl
                  [0] [1] [2] [3] [4]
        @score = ( 1   2   4   3   5 )
-->  @position = ( 4   3   1   2   0 )
#GOAL: @ranked = ( 5   4   S   B   G )
```
This tells us that the gold medal winner is at `@position[0]`, which is index 4 in `@score`.  Therefore, we will assign 'G' to position 4 in the ranked score:
```perl
@ranked[ @position[0] ] = 'G';
```
If we have to keep track of gold, silver, and bronze as well as checking for ties, a lot of convoluted logic is going to emerge. Time for another indirection. Let's set up the possible ranks in advance.  The rankings will be 1 to the size of `@score`, except that the first three places will be 'G', 'S', and 'B'.  Let's also set up a cursor in this ranking list, which will start at gold.
```perl
my @rank = ( qw(G S B), 4 .. (@score) );
my $r = 0;
```
Now we will iterate over the `@position` array.  If we find a tie, we don't move `$r`; but if the subsequent score is different, then we can update the `$r` cursor to jump ahead in `@rank`. 
```perl
# The first position is always gold.
my $place = $position[0];
$ranked[ $place ] = $rank[$r];

for my $index ( 1 .. $#position )
{
    my $next = $position[$index];
    if ( $score[$next] < $score[$place] )
    {
        # Lower score, so advance rank
        $r = $index;
    }
    $ranked[$next] = $rank[$r];
    $place = $next;
}
```
The complete code is in [Github](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-214/bob-lied/perl/ch-1.pl).

## Task 2: Collect Points
[The second task](https://theweeklychallenge.org/blog/perl-weekly-challenge-214/#TASK2) is a classic problem of searching for an optimal answer.
```text
You are given a list of numbers.
You will perform a series of removal operations.
For each operation, you remove from the list N (one or more)
equal and consecutive numbers, and add to your score N × N.
Determine the maximum possible score.
```
We are given a few examples to expound on the idea
```text
Example 1: Input: @numbers = (2,4,3,3,3,4,5,4,2) Output: 23
   We see three 3's next to each other so let us remove
   that first and collect 3 x 3 points.
   So now the list is (2,4,4,5,4,2).
   Let us now remove 5 so that all 4's can be next to each
   other and collect 1 x 1 point.
   So now the list is (2,4,4,4,2).
   Time to remove three 4's and collect 3 x 3 points.
   Now the list is (2,2).
   Finally remove both 2's and collect 2 x 2 points.
   So the total points collected is 9 + 1 + 9 + 4 => 23.
```
This is a naturally recursive problem. At each step, we remove a span of equal numbers, then repeat the same logic with a smaller list of numbers, while accruing a total score.

Recursion can sometimes be problematic.  We need to be certain that the recursion will terminate, and that the recursion will not go so deep that it runs out of memory.  We're safe here. Since each step removes at least one number from the list, we will eventually terminate when the list is down to one or zero members. How deep will the recursion go?  The worst case is that all N numbers in the list are unique, so that we have to repeat the process N times.  For lists in the dozens to hundreds, probably even thousands, that recursion should be safe.

So, onward.  First of all, we need to be able to find spans of numbers that are the same, so that we can remove them from the list.  Let's represent a span as a pair of (position, length).
Then we can write a subroutine that gives us a list of such pairs for any array of numbers.
```perl
  # Return pairs of [offset, length] for each span of equal values in list
  sub findSpan($list)
  {
      my $listLength = @$list;
      if    ( $listLength == 0 ) { return [] }
      elsif ( $listLength == 1 ) { return [ [0, 1] ] }
  
      my @span;
  
      my $beg = my $end = 0;
      my $len = 1;
      while ( $end < $listLength )
      {
          while ( $end < $list->$#* && $list->[$end+1] == $list->[$end] )
          {
              $end++;
              $len++;
          }
          push @span, [ $beg, $len ];
          $beg = ++$end;
          $len = 1;
      }
      return \@span;
  }

```
Our function dispatches a couple of trivial cases first, and then makes one pass over the list, extending the span while the values remain the same, and starting a new span when the value changes.  The return value will be a reference to an array, where each element of the array is a reference to a (position, length) pair.  For example, for the list `(1,2,2,2,2,1)`, the set of spans would look like:
```perl
# [0][1][2][3][4][5]
#  1  2  2  2  2  1
[ [0, 1], # position 0, length 1 (1)
  [1, 4], # position 1, length 4 (2,2,2,2)
  [5, 1], # position 5, length 1 (1)
]
```
With that function available to us, the logic of collection will be simpler.  For each span, calculate the score of the span (which is just the length squared), then remove it and recursively call the same routine again.  That will find spans in the smaller list, and then try to remove each of those in turn.

The recursive collect subroutine needs to have a base case that terminates the recursion.  That happens when the list is empty, or has just one element left.  We can also slightly optimize and also stop the recursion when there are only two elements left, since that score is easy to calculate.
```perl
sub _collect($list, $scoreSoFar)
{
    my $numLen = @$list;
    if    ( $numLen == 0 ) { return $scoreSoFar; }
    elsif ( $numLen == 1 ) { return $scoreSoFar + 1; }
    elsif ( $numLen == 2 )
    {
        return $scoreSoFar + ($list->[0] == $list->[1] ? 4 : 2);
    }
  . . .
```
Now we can find the set of spans that might be removed, and try each one in turn.
```perl
    my $spanList = findSpan($list);

    my $bestScore = 0;
    for my $span ( @$spanList )
    {
        my ($beg, $length) = $span->@*;
        my $score = $length * $length;

        # Remove the span from the list and recurse
        my @copy = $list->@*;
        
        splice(@copy, $beg, $length);

        $score = _collect(\@copy, $score);
        if ( $score  > $bestScore )
        {
            $bestScore = $score;
        }
    }
    return $scoreSoFar + $bestScore;
}
```
The `splice` function is very handy here, because it does the list manipulation for us.  We have to be careful to operate on a copy of the list, however, since `splice` will change the array, and we need it intact for the next iteration.

The other tricky bit in the algorithm is accumulating the score. We pass the score into each recursive call, effectively stacking it up and returning it up the stack when we finally reach the empty list.  At each level in the recursion, we save only the best score from each possible span removal.

A slightly harder problem would be to record the sequence of moves that achieves the best score.  That would use a similar technique, building a stack of moves that are passed to each recursive call through a reference to an array.  The best move at each level would be added to the stack.

The code for Task 2 is in in [Github](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-214/bob-lied/perl/ch-2.pl).