Perl Weekly Challenge 236: Exact Change

These are some answers to the Week 236, Task 1 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 1, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Exact Change

You are asked to sell juice each costs $5. You are given an array of bills. You can only sell ONE juice to each customer but make sure you return exact change back. You only have $5, $10 and $20 notes. You do not have any change in hand at first.

Write a script to find out if it is possible to sell to each customer with correct change.

Example 1

Input: @bills = (5, 5, 5, 10, 20)
Output: true

From the first 3 customers, we collect three $5 bills in order.
From the fourth customer, we collect a $10 bill and give back a $5.
From the fifth customer, we give a $10 bill and a $5 bill.
Since all customers got correct change, we output true.

Example 2

Input: @bills = (5, 5, 10, 10, 20)
Output: false

From the first two customers in order, we collect two $5 bills.
For the next two customers in order, we collect a $10 bill and give back a $5 bill.
For the last customer, we can not give the change of $15 back because we only have two $10 bills.
Since not every customer received the correct change, the answer is false.

Example 3

Input: @bills = (5, 5, 5, 20)
Output: true

Exact Change in Raku

The sell-juice subroutine keeps track of the available change available. It loops on the bills provided by customers and check each time whether the necessary change is available. It also adds the banknote provided by the customer in the %change hash. It returns False when the change is not available. If we get through to the end of the input array, then we return True. Note that for an input of 20, we need to give back 15. We first try to give a 10 and a 5 banknote and, if not possible (no available 10 banknote), then we try to give back three 5 banknotes.

sub sell-juice (@in) {
    # %change stores the stock of bank notes. No need to 
    # count $20 notes but it makes the code more generic
    my %change = '5' => 0, '10' => 0, '20' => 0;
    for @in -> $i {
        %change{$i}++;
        given $i {
            when 5 {next}
            when 10 {
                return False if %change{5} < 1;
                %change{5}--;
                next;
            }
            when 20 {
                if %change{10} > 0 and %change{5} > 0 {
                    %change{10}--; %change{5}--;
                    next;
                } elsif %change{5} >= 3 {
                    %change{5} -= 3; next;
                } else {
                    return False;
                }
            }
        }
    }
    return True;
}

my @tests = <5 5 5 10 20>, <5 5 10 10 20>, <5 5 5 20>;
for @tests -> @test {
    printf "%-15s => ", "@test[]";
    say sell-juice @test;
}

This program displays the following output:

$ raku ./exact-change.raku
5 5 5 10 20     => True
5 5 10 10 20    => False
5 5 5 20        => True

Exact Change in Perl

This is a port to Perl of the above Raku program. The only significant change is that the given ... when construct is replaced with nested if ... then ... else conditionals. Asides from that, please refer to the above section if you need further explanations.

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

sub sell_juice {
    # %change stores the stock of bank notes. No need to 
    # count $20 notes but it makes the code more generic
    my %change = ('5' => 0, '10' => 0, '20' => 0);
    for my $i (@_){
        $change{$i}++;
        next if $i == 5;
        if ($i == 10) {
            return "false" if $change{5} < 1;
            $change{5}--;
            next;
        } elsif ($i == 20) {
            if ($change{10} > 0 and $change{5} > 0) {
                $change{10}--; $change{5}--;
                next;
            } elsif ($change{5} >= 3) {
                $change{5} -= 3; next;
            } else {
                return "false";
            }
        }
    }
    return "true";
}

my @tests = ([<5 5 5 10 20>], [<5 5 10 10 20>], [<5 5 5 20>]);
for my $test (@tests) {
    printf "%-15s => ", "@$test";
    say sell_juice @$test;
}

This program displays the following output:

$ perl exact-change.pl
5 5 5 10 20     => true
5 5 10 10 20    => false
5 5 5 20        => true

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 October 8, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 236: Array Loops

These are some answers to the Week 236, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 1, 2023, at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Array Loops

You are given an array of unique integers.

Write a script to determine how many loops are in the given array.

To determine a loop: Start at an index and take the number at array[index] and then proceed to that index and continue this until you end up at the starting index.

Example 1

Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)
Output: 3

To determine the 1st loop, start at index 0, the number at that index is 4, proceed to index 4, the number at that index is 15, proceed to index 15 and so on until you're back at index 0.

Loops are as below:
[4 15 1 6 13 5 0]
[3 8 7 18 9 16 12 17 2]
[14 11 19 10]

Example 2

Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19)
Output: 6

Loops are as below:
[0]
[1]
[13 9 14 17 18 15 5 8 2]
[7 11 4 6 10 16 3]
[12]
[19]

Example 3

Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17)
Output: 1

Loop is as below:
[9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0]

I may have missed something, but I really don't understand the examples. Let's take example 1:

(4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)

We start with index 0 and obtain, as specified in the example, the following loop:

[4 15 1 6 13 5 0]

But why does the second loop in the example start with 3 (i.e. index 2)? We can start with index 1 (value 6) and obtain the following loop:

(Starting with index 1)
  index   value
    1       6
    6       13
    13      5
    5       0
    0       4
    4       15
    15      1

Similarly, if we start with index 3, we obtain the following loop:

(Starting with index 3)
  index   value
    3       8
    8       7
    7       18
    18      9
    9       16
    16      12
    12      17
    17      2
    2       3

And, with index 4:

(Starting with index 4)
  index   value
    4       15
    15      1
    1       6
    6       13
    13      5
    5       0
    0       4

And so on.

In fact, since values in the given examples seem to be permutations of the input array indexes, starting with any index will lead to a loop, so that with an array of 20 values, we will find 20 possible loops.

So my results will not be the same as those provided with the examples.

Array Loops in Raku

We iterate on every item of the input array as a start value, and for every value, we follow the index until we find a loop. If a loop is found, we increment a counter and, at the end, return the counter to the calling code.

sub find-loops (@in) {
    my $count = 0;
    for 0..@in.end -> $i {
        my $j = $i;
        loop {
            last unless @in[$j].defined;
            # say "\t", $j, "\t", @in[$j];
            ++$count and last if @in[$j] == $i;
            $j = @in[$j];
        }
    }
    return $count;
}

my @tests = 
    (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10),
    (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19),
    (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17),
    (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3);

for @tests -> @test {
    say @test;
    say "\tNumber of loops: ", find-loops @test;
}

This program displays the following output:

$ raku ./array-loops.raku
(4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10)
        Number of loops: 20
(0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19)
        Number of loops: 20
(9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17)
        Number of loops: 20
(0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3)
        Number of loops: 10

Array Loops in Perl

This Perl program works exactly as the above Raku program. Please refer to the previous sections if you need explanations.

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

sub find_loops {
    my @in = @_;
    my $count = 0;
    for my $i (0..$#in) {
        my $j = $i;
        # say $i;
        while (1) {
            last unless defined $in[$j];
            # say "\t", $j, "\t", @in[$j];
            ++$count and last if $in[$j] == $i;
            $j = $in[$j];
        }
    }
    return $count;
}

my @tests = (
    [4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10],
    [0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19],
    [9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17],
    [0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3]);

for my $test (@tests) {
    say "@$test";
    say "\tNumber of loops: ", find_loops @$test;
}

This program displays the following output:

$ perl ./array-loops.pl
4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10
        Number of loops: 20
0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19
        Number of loops: 20
9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17
        Number of loops: 20
0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3
        Number of loops: 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 October 8, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 235: Duplicate Zeros

These are some answers to the Week 235, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on September 24, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Duplicate Zeros

You are given an array of integers.

Write a script to duplicate each occurrence of ZERO in the given array and shift the remaining to the right but make sure the size of array remain the same.

Example 1

Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
Ouput: (1, 0, 0, 2, 3, 0, 0, 4)

Example 2

Input: @ints = (1, 2, 3)
Ouput: (1, 2, 3)

Example 3

Input: @ints = (0, 3, 0, 4, 5)
Ouput: (0, 0, 3, 0, 0)

We don't really know what should happen if keeping the array size leads to the removal of the zero just added. We will assume the added zero is just chopped off, like this:

Input: @ints = (0, 3, 2, 0, 4)
Ouput: (0, 0, 3, 2, 0)

Duplicate Zeros in Raku

The duplicate-zeros subroutine uses the map function to build a new array in which any zero from the input array is repeated and other values are just copied untouched. After that, the subroutine returns a splice of the resulting array having the size of the input array.

sub duplicate-zeros (@in) {
    my @result = map { $_ == 0 ?? |(0, 0) !! $_ }, @in;
    return @result[0..@in.end];
}

for <1 0 2 3 0 4 5 0>,  <1 2 3>, <0 3 0 4 5> -> @test {
    printf "%-18s => ", "@test[]";
    say duplicate-zeros @test;
}

This program displays the following output:

$ raku ./duplicate-zeros.raku
1 0 2 3 0 4 5 0    => (1 0 0 2 3 0 0 4)
1 2 3              => (1 2 3)
0 3 0 4 5          => (0 0 3 0 0)

Duplicate Zeros in Perl

This Perl program does the same thing as the above Raku program. Please refer to the above section for any explanation.

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

sub duplicate_zeros {
    my @result = map { $_ == 0 ? (0, 0) : $_ } @_;
    return @result[0..$#_];
}

for my $test ([<1 0 2 3 0 4 5 0>], 
    [<1 2 3>], [<0 3 0 4 5>]) {
    printf "%-18s => ", "@$test";
    say join " ", duplicate_zeros @$test;
}

This program displays the following output:

$ perl ./duplicate-zeros.pl
1 0 2 3 0 4 5 0    => 1 0 0 2 3 0 0 4
1 2 3              => 1 2 3
0 3 0 4 5          => 0 0 3 0 0

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 October 1, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 235: Remove One

These are some answers to the Week 235, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on September 24, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Remove One

You are given an array of integers.

Write a script to find out if removing ONLY one integer makes it strictly increasing order.

Example 1

Input: @ints = (0, 2, 9, 4, 6)
Output: true

Removing ONLY 9 in the given array makes it strictly increasing order.

Example 2

Input: @ints = (5, 1, 3, 2)
Output: false

Example 3

Input: @ints = (2, 2, 3)
Output: true

Remove One in Raku

We simply iterate over the input array and count the items that are out of order (where @in[$i-1] >= @in[$i]). We return False if the number of such items is more than 1, and True otherwise.

sub can-strictly-increase (@in) {
    my $count = 0;
    for 1..@in.end -> $i {
        $count++ if @in[$i-1] >= @in[$i];
    }
    return $count > 1 ?? False !! True;
}

for <0 2 9 4 6>, <5 1 3 2>, <2 2 3>, <3 3 3> -> @test {
    printf "%-12s => ", "@test[]";
    say can-strictly-increase @test;
}

This program displays the following output:

$ raku ./remove-one.raku
0 2 9 4 6    => True
5 1 3 2      => False
2 2 3        => True
3 3 3        => False

Remove One in Perl

This is a port to Perl of the above Raku program, with absolutely no change except for syntax differences.

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

sub can_strictly_increase {
    my $count = 0;
    for my $i (1..$#_) {
        $count++ if $_[$i-1] >= $_[$i];
    }
    return $count > 1 ? "false" : "true";
}

for my $test ([<0 2 9 4 6>], [<5 1 3 2>], 
              [<2 2 3>], [<3 3 3>]) {
    printf "%-12s => ", "@$test";
    say can_strictly_increase @$test;
}

This program displays the following output:

$ perl ./remove-one.pl
0 2 9 4 6    => true
5 1 3 2      => false
2 2 3        => true
3 3 3        => false

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 October 1, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 234: Unequal Triplets

These are some answers to the Week 234, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 2: Unequal Triplets

You are given an array of positive integers.

Write a script to find the number of triplets (i, j, k) that satisfies num[i] != num[j], num[j] != num[k] and num[k] != num[i].

Example 1

Input: @ints = (4, 4, 2, 4, 3)
Ouput: 3

(0, 2, 4) because 4 != 2 != 3
(1, 2, 4) because 4 != 2 != 3
(2, 3, 4) because 2 != 4 != 3

Example 2

Input: @ints = (1, 1, 1, 1, 1)
Ouput: 0

Example 3

Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28

triplets of 1, 4, 7  = 3x2×2 = 12 combinations
triplets of 1, 4, 10 = 3×2×1 = 6  combinations
triplets of 4, 7, 10 = 2×2×1 = 4  combinations
triplets of 1, 7, 10 = 3x2x1 = 6 combinations

I frankly don't understand the examples 1 and 3.

First, there is nothing saying that the triplets should be in ascending (or any other) order. So, taking example 1, we could add for example the following triplets:

(3, 2, 4) - values 4, 2, 3 (same as triplet (0, 2, 4)
(3, 4, 2) - values 4, 3, 2
(4, 2, 1) - values 3, 2, 4
(4, 1, 2) - values 3, 4, 2
etc.

So, our solutions for the example provided will obviously differ from those given above in the task specification.

Second, we're not asked to output the triplets of indexes, but only the number of triplets. I'll further assume that (0, 2, 4) and (1, 2, 4) are not a valid pair of triplets, because they yield the same values. So we are looking for the number of valid partial permutations of 3 items among the input values. To make sure our permutations are valid, we can simply remove duplicates from the input list.

We don't need to generate the permutations, since there is a mathematical formula that tells us that the number of permutations of r items from an array of n items is computed as follows:

P(n, r) = (n!) / (n - r)!

In our case, since we are looking for triplets, this becomes:

P(n, 3) = (n!) / (n - 3)!

Unequal Triplets in Raku

Based on the above explanations, the count-unequal-triplets subroutine first creates the @unique array with the input values without duplicates, count the unique items and finally uses the math formula above to count the number of unique triplets. Note that the reduction operator together with the multiplication operator (for instance [*] 1..$n) makes it possible to compute directly the factorial of a positive integer (factorial of n in the example).

sub count-unequal-triplets (@in) {
    my @unique = @in.unique;
    my $n = @unique.elems;    # n = count of unique items
    return 0 if $n < 3;
    my $triplet-count = ([*] 2..$n) / ([*] 2..($n - 3));
}

for (4, 4, 2, 4, 3), (1, 1, 1, 1, 1), 
    (4, 7, 1, 10, 7, 4, 1, 1) -> @test {
    printf "%-20s => ", "@test[]";
    say count-unequal-triplets @test;
}

This program displays the following output:

$ raku ./unequal-triplets.raku
4 4 2 4 3            => 6
1 1 1 1 1            => 0
4 7 1 10 7 4 1 1     => 24

Unequal Triplets in Perl

This is a port to Perl of the above Raku program. Compared to the Raku version, we have to define our own fact subroutine to compute the factorial of a positive integer. Otherwise, please refer to the above sections for further explanations.

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

sub fact {
    my $in = shift;
    my $fact = 1;
    $fact *= $_ for 2..$in;
    return $fact;
}

sub count_unequal_triplets {
    my %unique = map { $_ => 1 } @_;
    my $n = scalar keys %unique;    # n = count of unique items
    return 0 if $n < 3;
    my $triplet_count = (fact $n) / (fact $n - 3);
}

for my $test ([4, 4, 2, 4, 3], [1, 1, 1, 1, 1], 
    [4, 7, 1, 10, 7, 4, 1, 1]){
    printf "%-20s => ", "@$test";
    say count_unequal_triplets @$test;
}

This program displays the following output:

$ perl ./unequal-triplets.pl
4 4 2 4 3            => 6
1 1 1 1 1            => 0
4 7 1 10 7 4 1 1     => 24

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 September 24, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.