laurent_r

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

Task 1: Divisible Pairs

You are given list of integers @list of size $n and divisor $k.

Write a script to find out count of pairs in the given list that satisfies the following rules.

The pair (i, j) is eligible if and only if
a) 0 <= i < j < len(list)
b) list[i] + list[j] is divisible by k

Example 1

Input: @list = (4, 5, 1, 6), $k = 2
Output: 2

Example 2

Input: @list = (1, 2, 3, 4), $k = 2
Output: 2

Example 3

Input: @list = (1, 3, 4, 5), $k = 3
Output: 2

Example 4

Input: @list = (5, 1, 2, 3), $k = 4
Output: 2

Example 5

Input: @list = (7, 2, 4, 5), $k = 4
Output: 1

Divisible Pairs in Raku

We use 2-item combinations of indice between 0 and the index of the last item of the list to satisfy rule (a). Then we increment $count if the sum of the two items is divisible by the input divisor.

for (2, <4 5 1 6>), (2, <1 2 3 4>),
    (3, <1 3 4 5>), (4, <5 1 2 3>),
    (4, <7 2 4 5>), (2, < 1 2 3 4 5 6 7 >)
        -> ($k, @test) {
    my $count = 0;
    for (0..@test.end).combinations(2) -> @comb {
        $count++ if (@test[@comb[0]] + @test[@comb[1]]) %% $k;
    }
    say "$k  (@test[])  -> ", $count;
}

This script displays the following output:

$ raku ./divisible-pairs.raku
2  (4 5 1 6)  -> 2
2  (1 2 3 4)  -> 2
3  (1 3 4 5)  -> 2
4  (5 1 2 3)  -> 2
4  (7 2 4 5)  -> 1
2  (1 2 3 4 5 6 7)  -> 9

Divisible Pairs in Perl

This is essentially the same approach as the Raku program above, except that we generate the combinations with two nested for loops.

use strict;
use warnings;
use feature qw/say/;

for my $test ([2, [<4 5 1 6>]], [2, [<1 2 3 4>]],
    [3, [<1 3 4 5>]], [4, [<5 1 2 3>]],
    [4, [<7 2 4 5>]], [2, [< 1 2 3 4 5 6 7 >]]) {
    my $k = $test->[0];
    my @list = @{$test->[1]};
    my $count = 0;
    for my $i (0..$#list) {
        for my $j (($i+1) .. $#list) {
            ++$count if ($list[$i] + $list[$j]) % $k == 0;
        }
    }   
    say "$k  (@list)  -> ", $count;
}

This script displays the following output:

$ perl  ./divisible-pairs.pl
2  (4 5 1 6)  -> 2
2  (1 2 3 4)  -> 2
3  (1 3 4 5)  -> 2
4  (5 1 2 3)  -> 2
4  (7 2 4 5)  -> 1
2  (1 2 3 4 5 6 7)  -> 9

Task 2: Total Zero

You are given two positive integers $x and $y.

Write a script to find out the number of operations needed to make both ZERO. Each operation is made up either of the followings:

$x = $x - $y if $x >= $y

or

$y = $y - $x if $y >= $x (using the original value of $x)

Example 1

Input: $x = 5, $y = 4
Output: 5

Example 2

Input: $x = 4, $y = 6
Output: 3

Example 3

Input: $x = 2, $y = 5
Output: 4

Example 4

Input: $x = 3, $y = 1
Output: 3

Example 5

Input: $x = 7, $y = 4
Output: 5

This problem could certainly be solved with simple mathematical analysis, but I suspect we might end up with enough edge cases to make the program more complicated than a simple brute-force approach, i.e. iteratively computing the successive values of $x and $y.

Total Zero in Raku

sub to-zero ($x, $y) {
    return $x >= $y ?? ($x - $y, $y) !! ($x, $y - $x);
}

for <5 4>, <4 6>, <2 5>, <3 1>, <7 4>, <9 1> -> @test {
    my ($x, $y) = @test;
    my $count = 0;
    while ($x and $y ) {
        ($x, $y) = to-zero $x, $y;
        $count++;
    }
    say "@test[] -> $count";
}

This script displays the following output:

$ raku ./total-zero.raku
5 4 -> 5
4 6 -> 3
2 5 -> 4
3 1 -> 3
7 4 -> 5
9 1 -> 9

Total Zero in Perl

This a port to Perl of the Raku program above.

use strict;
use warnings;
use feature qw/say/;

sub to_zero  {
    my ($x, $y) = @_;
    return $x >= $y ? ($x - $y, $y) : ($x, $y - $x);
}

for my $test ([5, 4], [4, 6], [2, 5], [3, 1], [7, 4], [9, 1]) {
    my ($x, $y) = @$test;
    my $count = 0;
    while ($x and $y ) {
        ($x, $y) = to_zero $x, $y;
        $count++;
    }
    say "@$test -> $count";
}

This script displays the following output:

$ perl ./total-zero.pl
5 4 -> 5
4 6 -> 3
2 5 -> 4
3 1 -> 3
7 4 -> 5
9 1 -> 9

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 November 6, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.