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.

Peter made the task appears simpler and easy to follow by his simple discussion. Bonus you get to play with his solution. Well done.

Try it 

#!/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;
    }
}

46 lines of code

Output from script

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)