Task — Equal Distribution

You are given a list of integers greater than or equal to zero, @list. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print -1.

Please follow the rules as suggested by Neils van Dijke:

• You can only move a value of '1' per move
• You are only allowed to move a value of '1' to a direct neighbor/adjacent cell

Examples

Example 1:
Input: @list = (1, 0, 5)
Output: 4
Move #1: 1, 1, 4
(2nd cell gets 1 from the 3rd cell)
Move #2: 1, 2, 3
(2nd cell gets 1 from the 3rd cell)
Move #3: 2, 1, 3
(1st cell get 1 from the 2nd cell)
Move #4: 2, 2, 2
(2nd cell gets 1 from the 3rd cell)

Example 2:
Input: @list = (0, 2, 0)
Output: -1
It is not possible to make each same.

Example 3:
Input: @list = (0, 3, 0)
Output: 2
Move #1: 1, 2, 0
(1st cell gets 1 from the 2nd cell)
Move #2: 1, 1, 1
(3rd cell gets 1 from the 2nd cell)

Analysis

For this task we are given an ordered list of integers and asked to make 'moves' until all the members of the list are equal. A move comprises subtracting 1 from any cell in the list and adding it to an immediately neighbouring cell. We are asked to return the number of moves requires, or -1 if the task cannot be achieved.

The first thing to note is that if there are $c cells and the sum of their contents is $s, then an answer can only be possible if $s is an integer multiple of $c. If it is, the cells will all end up containing $s / $c. So we can immediately return -1 if $s is not a multiple of $c.

It is clear then that it is always possible to even out the distribution using 'moves' as defined above.

The algorithm I have used goes as follows.

First check that the input meets the $s / $c criterion, and if not, return -1.

Then start at cell 0 and work along to the second-last cell (because if we get all those right then the last cell must be right too).

We know what the target value in each cell is - it's
$s / $c. So if the cell we are looking at:

• contains more than the target, we successively reduce it by 1 and increment the following cell by 1 until the cell we are looking at contains the target value
• contains less than the target, we successively reduce it by 1 and increment the following cell by 1 until the cell we are looking at contains the target value
• contains exactly the target, we do nothing

We count the moves as we go, and the statement of the task only requires us to output that number. So that's it.

However, there is slight wrinkle. Although that algorithm gives numbers of moves which agree with the examples, some of the moves may temporarily leave a cell containing a negative number. For example, for Mohammad's first example it gives this:

Input:  (1, 0, 5)
Output: 4

   Move #1: 2, -1, 5
   Move #2: 2, 0, 4
   Move #3: 2, 1, 3
   Move #4: 2, 2, 2

The rules don't say that this is not allowed, so I am boldly claiming that it is valid.

I also believe, though won't show the proof here, that:

• this algorithm always comes up with the minimum number of moves,
• the moves can always be rearranged such that no cell goes negative, and
• there are multiple alternative sets of a greater number of moves to get to the desired equal distribution.

Try it 

Try running the script with any input:

Your @list =

example: 5, 4, 3, 2, 1

Script

#!/usr/bin/perl

# Peter Campbell Smith - 2022-11-21
# PWC 192 task 2

use v5.28;
use utf8;
use warnings;

my (@tests, $test, $sum, $cells, $cell, $target, $moves, $rubric);

@tests = ([1, 0, 5], [0, 2, 0], [0, 3, 0],
    [6, 6, 0, 0], [0, 6, 6, 0], [0, 0, 6, 6]);

# loop over tests
for $test (@tests) {
    
    # initialise and compute sum of all cells
    $sum = $moves = 0;
    $rubric = '';
    $sum += $_ for (@$test);
    $cells = scalar(@$test);
    say qq[\nInput:  (] . join(', ', @$test) . ')'; 
    
    # test for impossibility (sum not a multiple of the number of cells)
    if ($sum % $cells != 0) {
        say qq[Output: -1];
        next;
    }
    
    # calculate the target - the number that will end up in every cell
    $target = $sum / $cells;
    
    # start at cell 0 and step along to the last but one cell
    for $cell (0 .. $cells - 2) {
        
        # if the cell contents > $target move the surplus, 1 by 1, to the next cell
        while ($test->[$cell] < $target) {
            $test->[$cell] ++;      
            $test->[$cell + 1] --;
            show_move(@$test);
        }
                    
        # if the cell contents < $target move the deficit, 1 by 1, from the next cell
        while ($test->[$cell] > $target) {
            $test->[$cell] --;
            $test->[$cell + 1] ++;
            show_move(@$test);
        }
    }
    
    print qq[Output: $moves\n\n$rubric];
} 

sub show_move {
    
    # add one move to rubric for later output
    $moves ++;
    $rubric .= qq[    Move \#$moves: ] . join(', ', @_) . qq[\n];
}

Output

Input:  (1, 0, 5)
Output: 4

    Move #1: 2, -1, 5
    Move #2: 2, 0, 4
    Move #3: 2, 1, 3
    Move #4: 2, 2, 2

Input:  (0, 2, 0)
Output: -1

Input:  (0, 3, 0)
Output: 2

    Move #1: 1, 2, 0
    Move #2: 1, 1, 1

Input:  (6, 6, 0, 0)
Output: 12

    Move #1: 5, 7, 0, 0
    Move #2: 4, 8, 0, 0
    Move #3: 3, 9, 0, 0
    Move #4: 3, 8, 1, 0
    Move #5: 3, 7, 2, 0
    Move #6: 3, 6, 3, 0
    Move #7: 3, 5, 4, 0
    Move #8: 3, 4, 5, 0
    Move #9: 3, 3, 6, 0
    Move #10: 3, 3, 5, 1
    Move #11: 3, 3, 4, 2
    Move #12: 3, 3, 3, 3

Input:  (0, 6, 6, 0)
Output: 6

    Move #1: 1, 5, 6, 0
    Move #2: 2, 4, 6, 0
    Move #3: 3, 3, 6, 0
    Move #4: 3, 3, 5, 1
    Move #5: 3, 3, 4, 2
    Move #6: 3, 3, 3, 3

Input:  (0, 0, 6, 6)
Output: 12

    Move #1: 1, -1, 6, 6
    Move #2: 2, -2, 6, 6
    Move #3: 3, -3, 6, 6
    Move #4: 3, -2, 5, 6
    Move #5: 3, -1, 4, 6
    Move #6: 3, 0, 3, 6
    Move #7: 3, 1, 2, 6
    Move #8: 3, 2, 1, 6
    Move #9: 3, 3, 0, 6
    Move #10: 3, 3, 1, 5
    Move #11: 3, 3, 2, 4
    Move #12: 3, 3, 3, 3