laurent_r

These are some answers to task 2 of the Week 223 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 2: Box Coins

You are given an array representing box coins, @box.

Write a script to collect the maximum coins until you took out all boxes. If we pick box[i] then we collect the coins $box[i-1] * $box[i] * $box[i+1]. If $box[i+1] or $box[i-1] is out of bound then treat it as 1 coin.

Example 1:

Input: @box = (3, 1, 5, 8)
Output: 167

Step 1: pick box [i=1] and collected coins 3 * 1 * 5 => 15.  Boxes available (3, 5, 8).
Step 2: pick box [i=1] and collected coins 3 * 5 * 8 => 120. Boxes available (3, 8).
Step 3: pick box [i=0] and collected coins 1 * 3 * 8 => 24.  Boxes available (8).
Step 4: pick box [i=0] and collected coins 1 * 8 * 1 => 8.   No more box available.

Example 2:

Input: @box = (1, 5)
Output: 10

Step 1: pick box [i=0] and collected coins 1 * 1 * 5 => 5. Boxes available (5).
Step 2: pick box [i=0] and collected coins 1 * 5 * 1 => 5. No more box available.

When we have more than three items, the best seems to take the smallest item, since other items will be used again (possibly several times), so it is good to keep the largest item when we can.

Box Coins in Raku

I must admit that this program is a little bit clunky and that there may very well be better ways to solve this task, but I don't have enough time to work more on that.

sub collect (@box is copy) {
    my $collected = 0; 
    while @box.elems > 3 {
        my $min = min (0..@box.end), :by( {@box[$_]});
        $collected += ((@box[$min-1 ] // 1) * @box[$min] * (@box[$min+1 ] // 1));
        @box = (@box[0..^$min, $min^.. @box.end]).flat;
    } 
    $collected += [*] @box;
    $collected += ((@box[0] ) * (@box[2] // 1)) if @box.elems == 3; 
    $collected +=  max @box;
    return $collected;
}
my @tests = (3, 1, 5, 8), (1, 5);
for @tests -> @test {
    print "@test[]".fmt("%-10s => ");
    say collect @test;
}

This program displays the following output:

$ raku ./box-coins.raku
3 1 5 8    => 167
1 5        => 10

Box Coins in Perl

This is essentially a port to Perl of the Raku program above, except that we had to write our own min_index and max subroutines.

use strict;
use warnings;
use feature 'say';

sub min_index {
    my @in = @_;
    my $min = 0;
    for my $i (0..$#in) {
        $min = $i if $in[$i] < $in[$min];
    }
    return $min;
}
sub max {
    my $max = 0;
    for (@_) {
        $max = $_ if $_ > $max;
    }
    return $max;
}
sub collect {
    my @box = @_;
    my $collected = 0; 
    while (@box > 3) {
        my $min = min_index @box;
        $collected += (($box[$min-1 ] // 1) * $box[$min] * ($box[$min+1 ] // 1));
        @box = @box[0..$min-1, $min+1.. $#box];
    } 
    $collected += $box[0] * ($box[1] // 1) * ($box[2] // 1) ;
    $collected += (($box[0] ) * ($box[2] // 1)) if @box == 3; 
    $collected +=  max(@box);
    return $collected;
}
for my $test  ([3, 1, 5, 8], [1, 5]) {
    printf "%-15s => ", "@$test";
    say collect @$test;
}

This program displays the following output:

$ perl ./box-coins.pl
3 1 5 8         => 167
1 5             => 10

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on July 9, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.