Task — Collect points

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.

Analysis

My approach to this task is not the most efficient, but it works.

First I convert the list into a series of 'elements', each comprised 1 or more of the same number. So 1, 2, 2, 3, 3, 3, 3 contains 3 elements, 1x1, 2x2 and 4x3.

I then loop over all the possible ways of omitting one element from the list, so for the example above I have 3 trials: 1x1 and 2x2, 1x1 and 4x3, 2x2 and 4x3. If this omission results in the elements either side of the omitted one having the same value - eg 3x4 and 2x4 - then I merge them into one element - eg 5x4.

I then do that recursively until each branch results in a single element, accumulating the best total and the sequence of deletions as I go.

This works fine for Mohammad's examples, but it does quickly get slow as the number of elements increases.

Try it 

Script

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-04-24
use utf8;     # Week 214 task 2 - Collect points
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

my ($best_score, $best_explain);

collect_points(2, 4, 3, 3, 3, 4, 5, 4, 2);
collect_points(1, 2, 2, 2, 2, 1);
collect_points(1);
collect_points(2, 2, 2, 1, 1, 2, 2, 2);
collect_points(3, 1, 4, 1, 5, 9, 2, 6, 5, 3);

sub collect_points {
    
    my (@points, $last, $k, @elements, $j, $e);
    
    # initialise
    @points = @_;
    $best_score = 0;
    $best_explain = '';
    
    # convert list to elements: $elements[$k][0] is the number 
    # of consecutive occurrences of $elements[$k][1]
    $last = -1;
    $k = -1;
    for ($j = 0; $j < scalar @points; $j ++) {
        if ($points[$j] == $last) {
            $elements[$k][0] ++;
        } else {
            $elements[++ $k][0] = 1;
            $elements[$k][1] = $points[$j];
        }
        $last = $points[$j];
    }   

    # analyse list and show results
    analyse(0, '', @elements);
    say qq[\nInput:  \@numbers = (] . join(', ', @points) . qq[)];
    say qq[Output: $best_score (] . substr($best_explain, 0, -2) . qq[)];
}

sub analyse {
    
    # successively removes 1 element and recurses until only 1 is left
    
    my (@elements_in, $score_in, $explain_in, $last_element, $score, $explain,
        $k, $start, @elements_out, @save);
    
    # get arguments and initialise
    $score_in = $_[0];
    $explain_in = $_[1];
    @elements_in = @_[2 .. scalar @_ - 1];
    for $k (0 .. scalar @elements_in - 1) {
        $save[$k] = $elements_in[$k];
    }
    $last_element = scalar @elements_in - 1;
    $score = 0;
    
    # try eliminating each element in turn
    F: for $k (0 .. $last_element) {
        @elements_in = @save;
        $score = $score_in + $elements_in[$k][0] ** 2;
        $explain = qq[$explain_in$elements_in[$k][0]x$elements_in[$k][1], ];

        # return if this is the last element
        if ($last_element == 0) {
            if ($score > $best_score) {
                $best_score = $score;
                $best_explain = $explain;
            }
            last F;
        }
        
        # merge newly adjacent equal-value elements if appropriate
        $start = $k + 1;
        if ($k != 0 and $k != $last_element
            and $elements_in[$k - 1][1] == $elements_in[$k + 1][1]) {
            $elements_in[$k - 1][0] += $elements_in[$k + 1][0];
            $start = $k + 2;
        }
        
        # create reduced list
        @elements_out = ();
        push(@elements_out, @elements_in[0 .. $k - 1]) unless $k == 0;
        push(@elements_out, @elements_in[$start .. $last_element]) unless $start > $last_element;
        
        # recurse
        analyse($score, $explain, @elements_out);
        $elements_in[$k - 1][0] -= $elements_in[$k + 1][0] if $start == $k + 2;
    }
}

Output

Input:  @numbers = (2, 4, 3, 3, 3, 4, 5, 4, 2)
Output: 23 (3x3, 1x5, 3x4, 2x2)

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

Input:  @numbers = (1)
Output: 1 (1x1)

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

Input:  @numbers = (3, 1, 4, 1, 5, 9, 2, 6, 5, 3)
Output: 16 (1x4, 2x1, 1x9, 1x2, 1x6, 2x5, 2x3)