Task — Kill and win

You are given a list of integers. Write a script to get the maximum points. You are allowed to take out (kill) any integer and remove it from the list. If you do that then all integers exactly one-less or one-more would also be removed.

Find out the maximum total of integers removed.

Example 2
Input: @int = (1, 1, 2, 2, 2, 3)
Output: 11

First we delete 2 and that would also delete both the 1's and the 3. Now we have (2, 2). Then we delete another 2 and followed by the third deletion of 2. So the maximum points we get is 11.

Analysis

This is an interesting challenge in that it is difficult to see what implied rules there might be - or not be. If we take the task statement literally, we only get to remove a single integer, plus all the ones which are 1 less or 1 more than that one - and that's the end.

However, example 2 (above) says that we can then delete another, and another, and so on until there are none left, so the answer in that case is always just going to be the sum of the list members, which isn't very interesting.

So I think perhaps the following was intended: you can keep removing numbers and those ± 1, provided there are 1 or more numbers in the ± 1 set. For example, if we have 1, 3, 1 we cannot remove the 3 because there are no 2s or 4s.

This means that my answer for example 2 is 9, by deleting the 3 and thus all the 2s and leaving 1, 1.

So how does my algorithm work? The guts of it is sub kill_one, which take a list as its argument and attempts to delete each number in turn from the list, plus any associated ± 1s. There are 3 possible outcomes:

1. It can't be done because no member of the list has any ± 1s
   (eg 1, 3, 5).
2. It can be done, and that results in a list with 1 or 0 members
   (eg 1, 2, 3).
3. It can be done, and that results in a list with at least 2 members
   (eg 1, 2, 3, 5, 6).

Kill_one returns a score equal to the sum of the members of the list that it has deleted. In case 1 above, that's zero. In case 2 it's the sum of the member it removed and its ± 1s.

In case 3, kill_one then recursively calls itself with the new reduced list as its input. That call returns a score which gets added to the score of the calling instance. It also keeps track of a global $best, which is the highest score it has seen so far, and that in the end is of course the required answer.

There is an easy optimisation possible, which is that if $best reaches the sum of all the original members of the list ($max), the search can stop becuase the total clearly can never exceed that.

That apart, the algorithm works, but it gets quite slow if the number of members in the list exceeds 25 or so. I can think of a few other optimisations that could be applied but in the interests of brevity I haven't taken it any further.

Try it 

Script

#!/usr/bin/perl

use v5.16;       # The Weekly Challenge - 2023-03-27
use utf8;        # Week 210 task 1 - Kill and win
use strict;      # Peter Campbell Smith
use warnings;    # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

my ($best, $max, $j, @test);

kill_and_win(2, 3, 1);
kill_and_win(1, 1, 2, 2, 2, 3);
kill_and_win(1, 3, 5, 7);
kill_and_win(2, 2, 2, 2);
kill_and_win(1, 2, 3, 4, 5, 6, 7, 8, 9, 10);

# harder one - 20 random numbers in 0 .. 15
for $j (0 .. 19) {
    @test[$j] = int(rand(15));
}
kill_and_win(@test);

sub kill_and_win {
    
    # does what the challenge says
    my (@list);
    
    @list = @_;
    $best = 0;
    $max = 0;
    
    # the max possible is the sum of all the list elements and we can stop if we find that
    $max += $_ for @list;
    
    # get the answer and show it
    kill_one(\@list);   
    say qq[\nInput:  \@list = (] . join(', ', @list) . qq[)];
    say qq[Output: $best (max = $max)];
}

sub kill_one {
    
    # finds all options of deleting one entry from list and recurses 
    my ($option, @list, $j, $k, @new_list, $score, $yes);
    @list = @{$_[0]};
    
    # if we've found a solution that scores $max we can stop
    return 0 if $best == $max;
    $score = 0;
    
    # take an element to delete (if possible)
    J: for $j (0 .. scalar @list - 1) {
        
        # is this eligible for deletion as there is at least one ± 1
        $yes = 0;
        K: for $k (0 .. scalar @list - 1) {
            if (abs($list[$j] - $list[$k]) == 1) {
                $yes = 1;
                last K;
            }
        }
        
        # not eligible
        next J unless $yes;
        
        # so we can delete $list[$j]
        $score = $list[$j];
        
        # create a new list omitting $j and any element ± 1 from element $j
        @new_list = ();
        for $k (0 .. scalar @list - 1) {
            next if $j == $k;
            if (abs($list[$j] - $list[$k]) == 1) {
                $score += $list[$k];
                next;
            }
            push(@new_list, $list[$k]);
        }
                
        # if there are still >1 elements in $new_list, recurse
        $score += kill_one(\@new_list) if scalar @new_list > 1;

        # save the score if it's the best so far
        $best = $score if $score > $best;
    }
    return $score;
}

Output

Input:  @list = (2, 3, 1)
Output: 6 (max = 6)

Input:  @list = (1, 1, 2, 2, 2, 3)
Output: 9 (max = 11)

Input:  @list = (1, 3, 5, 7)
Output: 0 (max = 16)

Input:  @list = (2, 2, 2, 2)
Output: 0 (max = 8)

Input:  @list = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Output: 55 (max = 55)

Input:  @list = (1, 11, 0, 6, 9, 14, 14, 11, 11, 0, 12, 9, 0, 7, 11, 12, 4, 8, 14, 3)
Output: 103 (max = 157)