1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-214/#TASK2
  3 #
  4 # Task 2: Collect Points
  5 # ======================
  6 #
  7 # You are given a list of numbers.
  8 #
  9 # You will perform a series of removal operations. For each operation, you
 10 # remove from the list N (one or more) equal and consecutive numbers, and add
 11 # to your score N × N.
 12 #
 13 # Determine the maximum possible score.
 14 #
 15 ## Example 1:
 16 ##
 17 ## Input: @numbers = (2,4,3,3,3,4,5,4,2)
 18 ## Output: 23
 19 ##
 20 ## We see three 3's next to each other so let us remove that first and collect 3 x 3 points.
 21 ## So now the list is (2,4,4,5,4,2).
 22 ## Let us now remove 5 so that all 4's can be next to each other and collect 1 x 1 point.
 23 ## So now the list is (2,4,4,4,2).
 24 ## Time to remove three 4's and collect 3 x 3 points.
 25 ## Now the list is (2,2).
 26 ## Finally remove both 2's and collect 2 x 2 points.
 27 ## So the total points collected is 9 + 1 + 9 + 4 => 23.
 28 #
 29 ## Example 2:
 30 ##
 31 ## Input: @numbers = (1,2,2,2,2,1)
 32 ## Output: 20
 33 ##
 34 ## Remove four 2's first and collect 4 x 4 points.
 35 ## Now the list is (1,1).
 36 ## Finally remove the two 1's and collect 2 x 2 points.
 37 ## So the total points collected is 16 + 4 => 20.
 38 #
 39 ## Example 3:
 40 ##
 41 ## Input: @numbers = (1)
 42 ## Output: 1
 43 #
 44 ## Example 4:
 45 ##
 46 ## Input: @numbers = (2,2,2,1,1,2,2,2)
 47 ## Output: 40
 48 ##
 49 ## Remove two 1's = 2 x 2 points.
 50 ## Now the list is (2,2,2,2,2,2).
 51 ## Then reomove six 2's = 6 x 6 points.
 52 #
 53 ############################################################
 54 ##
 55 ## discussion
 56 ##
 57 ############################################################
 58 #
 59 # We calculate the maximum by trying to remove consecutive
 60 # same numbers from every position in the array, calculating
 61 # the maximum points we can get with the remaining numbers
 62 # and adding it to the points we generated in this first step.
 63 
 64 use strict;
 65 use warnings;
 66 use Data::Dumper;
 67 
 68 collect_points(2,4,3,3,3,4,5,4,2);
 69 collect_points(1,2,2,2,2,1);
 70 collect_points(1);
 71 collect_points(2,2,2,1,1,2,2,2);
 72 
 73 sub collect_points {
 74    my @numbers = @_;
 75    print "Input: (" . join(",", @numbers) . ")\n";
 76    print "Output: " . maximum_possible(@numbers) . "\n";
 77 }
 78 
 79 sub maximum_possible {
 80    my @numbers = @_;
 81    return 0 unless @numbers;
 82    my $max = 0;
 83    foreach my $i (0..$#numbers) {
 84       # how many points (and which rest) do we get if we remove
 85       # consecutive same numbers starting at position i?
 86       my ($points, @rest) = remove_consecutive($i, @numbers);
 87       my $this = $points + maximum_possible(@rest);
 88       $max = $this if $this > $max;
 89    }
 90    return $max;
 91 }
 92 
 93 sub remove_consecutive {
 94    my ($index, @numbers) = @_;
 95    return (0) unless @numbers;
 96    my $points = 0;
 97    my @rest = ();
 98    if($index > 0) {
 99       if($numbers[$index-1] == $numbers[$index]) {
100          # we've been here already in a previous call,
101          # so we can exit now
102          return (0);
103       }
104    }
105    # currently, we haven't removed anything
106    my $count = 0;
107    # just keep the rest up to the current index
108    @rest = @numbers[0..$index-1];
109    # find the last index that has the same number as the
110    # one at $index
111    my $last_index = $index;
112    foreach my $i ($index..$#numbers) {
113       last if $numbers[$i] != $numbers[$index];
114       $count++;
115       $last_index = $i;
116    }
117    # how many points did we get?
118    $points = $count * $count;
119    # keep the remaining rest of the array.
120    push @rest, @numbers[$last_index+1..$#numbers];
121    return($points, @rest);
122 }