TL;DR

On with TASK #2 from The Weekly Challenge #214. Enjoy!

# The challenge

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.

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.


Example 2:

Input: @numbers = (1,2,2,2,2,1)
Output: 20

Remove four 2's first and collect 4 x 4 points.
Now the list is (1,1).
Finally remove the two 1's and collect 2 x 2 points.
So the total points collected is 16 + 4 => 20.


Example 3:

Input: @numbers = (1)
Output: 1


Example 4:

Input: @numbers = (2,2,2,1,1,2,2,2)
Output: 40

Remove two 1's = 2 x 2 points.
Now the list is (2,2,2,2,2,2).
Then reomove six 2's = 6 x 6 points.


# The questions

No questions in particular, except maybe if there are possible assumptions about the length of the inputs. I mean, for short inputs, a brute-forceish solution is definitely viableâ€¦

# The solution

First of all, weâ€™ll transform the inputs in pairs of value and counts. We will keep them in an array with values in even positions (starting at 0) and counts in odd positions. Donâ€™t ask.

Then we will operate on these slots. Those whose value occur only once can be eliminated at any time, so the sooner the better. Those occurring multiple timesâ€¦ will require some search, and weâ€™ll look for them all because time is running!

Perl:

#!/usr/bin/env perl
use v5.24;
use warnings;
use experimental 'signatures';
use Memoize 'memoize';
use Data::Dumper;

say collect_points(@ARGV ? @ARGV : (2, 4, 4, 3, 4, 4, 3, 3, 3, 3, 5, 3));

sub collect_points (@numbers) {
return 0 unless @numbers;
my @slots = ($numbers[0], 1); for my$i (1 .. $#numbers) { if ($numbers[$i - 1] ==$numbers[$i]) {$slots[-1]++;
}
else {
push @slots, $numbers[$i], 1;
}
}
return collect_points_wh(@slots);
}

sub remove_slot ($i, @slots) { splice(@slots,$i, 2);

# check for merge
if ($i > 0 &&$i < @slots && $slots[$i - 2] == $slots[$i]) {
$slots[$i - 1] += $slots[$i + 1];
splice(@slots, $i, 2); } return @slots; } sub collect_points_wh (@slots) { my$score = 0;

while ('necessary') {
my %count_for;

my $i = 0; while ($i < @slots) {
($count_for{$slots[$i]} //= 0)++;$i += 2;
}

my %is_single = map { $_ => 1 } grep {$count_for{$_} == 1 } keys %count_for; last unless scalar keys %is_single;$i = 0;
while ($i < @slots) { if ($is_single{$slots[$i]}) {
$score +=$slots[$i + 1] ** 2; @slots = remove_slot($i, @slots);
}
else {
$i += 2; } } } my$i = 0;
my $best_sub_score = 0; while ($i < @slots) {
my @sub_slots = remove_slot($i, @slots); my$sub_score = collect_points_wh(@sub_slots);
$best_sub_score =$sub_score if $best_sub_score <$sub_score;
$i += 2; }$score += $best_sub_score; return$score;
}


Raku:

#!/usr/bin/env raku
use v6;
sub MAIN (*@args) { put collect-points(@args) }

sub collect-points (@numbers) {
return 0 unless @numbers;
my @slots = @numbers[0], 1;
for 1 ..^ @numbers -> $i { if @numbers[$i - 1] == @numbers[$i] { @slots[*-1]++; } else { @slots.push: @numbers[$i], 1;
}
}
return collect-points-wh(@slots);
}

sub collect-points-wh (@slots) {
my $score = 0; loop { my %count-for; my$i = 0;
while $i < @slots { (%count-for{@slots[$i]} //= 0)++;
$i += 2; } my %is-single = %count-for.keys.grep({ %count-for{$_} == 1 })
.map({ $_ => True }); last unless %is-single.elems;$i = 0;
while $i < @slots { if %is-single{@slots[$i]} {
$score += @slots[$i + 1] ** 2;
@slots = remove-slot($i, @slots); } else {$i += 2;
}
}
}

my $i = 0; my$best-sub-score = 0;
while $i < @slots { my @sub-slots = remove-slot($i, @slots);
my $sub-score = collect-points-wh(@sub-slots);$best-sub-score = $sub-score if$best-sub-score < $sub-score;$i += 2;
}

$score +=$best-sub-score;
return $score; } sub remove-slot ($i, @slots is copy) {
@slots.splice($i, 2); if$i > 0 && $i < @slots && @slots[$i - 2] == @slots[$i] { @slots[$i - 1] += @slots[$i + 1]; @slots.splice($i, 2);
}
return @slots;
}


Wellâ€¦ enough for today, Iâ€™m pretty late so Iâ€™ll better hurry up!

Cheers andâ€¦ stay safe!

Comments? Octodon, , GitHub, Reddit, or drop me a line!