Equalise an Array

The Weekly Challenge 270/2

In the week 270, the second task was really interesting and difficult. Here’s a slightly reformulated version:

We’re given an array of positive integers @ints and two additional integers, $x and $y. We can apply any sequence of the following two operations: 1. Increment one element of @ints. 2. Increment two elements of @ints. The cost of each application of operation 1 is $x, the cost of operation 2 is $y. What’s the minimal cost of a sequence of operations that makes all the elements of @ints equal?

Why do I say it was difficult? I compared all the Perl and Raku solutions I could find in the GitHub repository and none of them gave the same results as mine. It took me several days to find an algorithm that would answer the tricky inputs I generated with a pen and paper, and one more day to optimise it to find the solutions in a reasonable time.

One of the main reasons why my solution is different to the rest of the participants is I didn’t assume we should never increment the maximum element of the array. For example, if we have $x = 10, $y = 1, @ints = (1, 5, 5), we can easily see that getting (5, 5, 5) costs us 40 (4 times incrementing the first element)—but we can do better:

Elements Cost
1 5 50
2 5 61
3 6 62
4 6 73
5 7 74
6 7 85
7 8 86
8 8 97
9 9 98

To find the minimal cost, we’ll do a brute force search. Let’s start with the agenda of the initial state of the array and the total cost of 0. In each step, we’ll take the cheapest state so far from the agenda and transform it to the possible next states, adding them back to the agenda. Once the array consists of the same elements, we’re done.

Applying the second operation ever only makes sense if there are more than two elements in the array and the cost of the first operation is more than a half of the second one (2 * $x > $y).

To optimise the algorithm a bit, we always apply the first operation to the minimal element of the array, and similarly for the second operation, we always increment the two smallest elements. I don’t have a mathematical proof that it’s correct, but initially, I tried incrementing all the elements, and I later compared the results of the optimised algorithm for thousands of generated inputs.

Here’s the final solution together with some test cases. I’d love to see a solution with only a formula instead of the loop, I have a feeling it should exist, but I’ve already spent several days on this and I wasn’t able to find it.


#!/usr/bin/perl
use warnings;
use strict;
use experimental qw( signatures );

sub equalize_array($x, $y, $ints) {
    my @agenda = ([0, [sort { $a <=> $b } @$ints]]);
    my %seen;
    while (1) {
        my ($price, $elements) = @{ shift @agenda };
        if ($elements->[0] == $elements->[-1]) {
            return $price
        }

        my @e = sort { $a <=> $b }
                $elements->[0] + 1, @$elements[1 .. $#$elements];
        push @agenda, [$price + $x, \@e] unless $seen{"@e"}++;

        if (@$elements > 2 && 2 * $x > $y) {
            my @e = sort { $a <=> $b } $elements->[0] + 1,
                                       $elements->[1] + 1,
                                       @$elements[2 .. $#$elements];

            push @agenda, [$price + $y, \@e] unless $seen{"@e"}++;
        }

        @agenda = sort { $a->[0] <=> $b->[0] } @agenda;
    }
}

use Test::More tests => 2 + 17;

is equalize_array(3, 2, [4, 1]), 9, 'Example 1';
is equalize_array(2, 1, [2, 3, 3, 3, 5]), 6, 'Example 2';

is equalize_array(3, 1, [1, 2, 2]), 2, '3 1 [1 2 2]';
is equalize_array(4, 1, [1, 2, 2, 2, 2]), 3, '4 1 [1 2 2 2 2]';
is equalize_array(20, 1, [1, 2, 3, 3]), 21, '20 1 [1 2 3 3]';
is equalize_array(20, 1, [1, 2, 4, 4]), 22, '20 1 [1 2 4 4]';
is equalize_array(1, 7, [2, 2, 3, 5]), 8, '1 7 [2 2 3 5]';
is equalize_array(7, 1, [2, 2, 3, 5]), 4, '7 1 [2 2 3 5]';
is equalize_array(2, 3, [1, 1, 5]), 12, '2 3 [1 1 5]';
is equalize_array(17, 1, [1, 9, 9]), 16, '17 1 [1 9 9]';
is equalize_array(8, 9, [6, 6, 4, 2]), 34, '8 9 [6 6 4 2]';
is equalize_array(6, 1, [2, 5, 5, 6]), 5, '6 1 [2 5 5 6]';
is equalize_array(9, 1, [1, 2, 3, 3, 7]), 12, '9 1 [1 2 3 3 7]';
is equalize_array(7, 3, [1, 4, 7, 7, 7]), 21, '7 3 [1 4 7 7 7]';
is equalize_array(9, 1, [7, 1, 1, 4, 8]), 12, '9 1 [7 1 1 4 8]';
is equalize_array(1, 1, [1, 4, 3, 4, 5, 4, 2, 3, 7]), 15,
    '1 1 [1 4 3 4 5 4 2 3 7]';
is equalize_array(4, 1, [1, 4, 1, 2, 5, 7, 1, 5]), 15,
    '4 1 [1 4 1 2 5 7 1 5]';
is equalize_array(6, 10, [2, 3, 5, 1, 2, 1, 1, 7]), 170,
    '6 10 [2 3 5 1 2 1 1 7]';
is equalize_array(4, 4, [4, 4, 1, 7, 2, 7, 1, 1, 4]), 64,
    '4 4 [4 4 1 7 2 7 1 1 4]';

Leave a comment

About E. Choroba

user-pic I blog about Perl.