These are some answers to the Week 245, 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 December 3, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Sort Language

You are given two arrays of languages and its popularity.

Write a script to sort the language based on popularity.

Example 1

Input: @lang = ('perl', 'c', 'python')
       @popularity = (2, 1, 3)
Output: ('c', 'perl', 'python')

Example 2

Input: @lang = ('c++', 'haskell', 'java')
       @popularity = (1, 3, 2)
Output: ('c++', 'java', 'haskell')

Sort Language in Raku

On reading the assignment, I initially thought for a minute or so that it would be quite easy to sort one array (@lang) in accordance with the values of another one (@popularity). But it immediately came to my mind that, in fact, you don't even need to actually sort anything. You can just use the second array (@popularity) as an index slice for the first one (@lang), so that we avoid the algorithmic complexity of a sort procedure and return directly the languages in the proper order. The sort-lang subroutine is thus a simple one-liner. Note that the input popularity is given with values starting at 1, whereas array or list indices start at 0, so we need the map {$_ - 1} expression to convert popularities into array indices.

sub sort-lang (@lang, @pop) {
    return ~ @lang[map {$_ - 1}, @pop];
}

my @tests = 
    { lang => <perl c python>, pop => (2, 1, 3)},
    { lang => <c++ haskell java>, pop  => (1, 3, 2)};

for @tests -> %test {
    printf "%-20s", "%test<lang> => ";
    say sort-lang %test<lang>, %test<pop>;
}

This program displays the following output:

$ raku ./sort-language.raku
perl c python =>    c perl python
c++ haskell java => c++ java haskell

Sort Language in Perl

This is a port to Perl of the Raku program above, and we are using array slices just like in the Raku implementation. Please refer to the previous section for any explanation.

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

sub sort_lang {
    my @lang = @{$_[0]};
    my @pop  = @{$_[1]};
    return join " ",  @lang[map {$_ - 1} @pop];
}

my @tests = 
    ({ lang => [<perl c python>],    pop => [2, 1, 3]},
     { lang => [<c++ haskell java>], pop => [1, 3, 2]});

for my $test (@tests) {
    printf "%-22s", "@{$test->{lang}} => ";
    say sort_lang $test->{lang}, $test->{pop};
}

This program displays the following output:

$ perl ./sort-language.pl
perl c python =>      c perl python
c++ haskell java =>   c++ java haskell

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

These are some answers to the Week 244, 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 November 26, 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: Group Hero

You are given an array of integers representing the strength.

Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest.

Example 1

Input: @nums = (2, 1, 4)
Output: 141

Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8
Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1
Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64
Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4
Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32
Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16
Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16

Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141

Group Hero in Raku

This task is fairly straight forward in Raku, using the built-in combinations, max, and min methods. Note that we also use the built-in postfix ² operator to find the square of a number.

sub group-hero (@in) {
    my $sum = 0;
    for @in.combinations: 1..@in.elems -> @comb {
        $sum += @comb.max² * @comb.min;
    }
    return $sum;
}  

for <2 1 4>, <4 1 5 2> -> @test {
    printf "%-10s => ", "@test[]";
    say group-hero @test;
}

This program displays the following output:

$ raku ./group-hero.raku 7
2 1 4      => 141
4 1 5 2    => 566

Group Hero in Perl

Here, we cannot port simply the Raku program to Perl, because Perl lacks the combinations, max, and min functions. As I stated many times, I eschew using on-the-shelf modules in coding challenge, because using ready-made products is not the essence of a challenge (but I would of course do so in real life programming). We are looking for combinations, but are actually using only pairs of items for calculations. So, I decided to first sort the input array and hand-pick the first and last items of any combination.

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

sub group_hero {
    # Caution: this works only with input arrays of 3 items
    my @in = sort { $a <=> $b } @_;
    my $sum = 0;
    $sum += $_ * $_ * $_ for @in;
    my ($i, $j) = (0, 0);

    for $j (0..$#in) {
        for $i (1..$#in) {  #gap
            next unless defined $in[$j + $i];
            $sum += $in[$j] * $in[$j + $i] * $in[$j + $i];
        }
    }
    $sum += $in[0] * $in[$#in] * $in[$#in];
    return $sum;
}

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

This works well with input arrays of three items:

$ perl ./group-hero.pl
2 1 4      => 141

but this wouldn't work with arrays having more than three elements. As I don't have time right now to solve this issue, I'll leave it at that, and may come back to it later if I find the time to suggest a better more generic solution. Three nested loops (instead of two) should probably do the trick, and it shouldn't be too difficult, but I can't do it today. Later this week if possible.

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

These are some answers to the Week 244, 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 November 26, 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: Count Smaller

You are given an array of integers.

Write a script to calculate the number of integers smaller than the integer at each index.

Example 1

Input: @int = (8, 1, 2, 2, 3)
Output: (4, 0, 1, 1, 3)

For index = 0, count of elements less than 8 is 4.
For index = 1, count of elements less than 1 is 0.
For index = 2, count of elements less than 2 is 1.
For index = 3, count of elements less than 2 is 1.
For index = 4, count of elements less than 3 is 3.

Example 2

Input: @int = (6, 5, 4, 8)
Output: (2, 1, 0, 3)

Example 3

Input: @int = (2, 2, 2)
Output: (0, 0, 0)

Count Smaller in Raku

It is quite straight forward. First, we sort the input array to reduce the number of comparisons done in the inner loop. I'm not sure whether this is faster, and I don't really care, as the input is so small that it makes little difference anyway. We then loop over the input array, and, for each item, we count the number of items that are less than such said item.

sub count-smaller (@in) {
    my @result;
    my @sorted = @in.sort;
    for @in -> $i {
        my $count = 0;
        for @sorted -> $j {
            last if $j >= $i;
            $count++;
        }
        push @result, $count;
    }
    return @result;
}

for <8 1 2 2 3>, <6 5 4 8>, <2 2 2> -> @test {
    printf "%-12s => ", "@test[]";
    say "" ~ count-smaller @test;
}

This program displays the following output:

$ raku ./count-smaller.raku
8 1 2 2 3    => 4 0 1 1 3
6 5 4 8      => 2 1 0 3
2 2 2        => 0 0 0

Count Smaller in Perl

This is a port to Perl of the above Raku program, and it works exactly the same way.

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

sub count_smaller {
    my @in = @_;
    my @result;
    my @sorted = sort {$a <=> $b } @in;
    for my $i (@in) {
        my $count = 0;
        for my $j (@sorted) {
            last if $j >= $i;
            $count++;
        }
        push @result, $count;
    }
    return @result;
}

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

This program displays the following output:

$ perl ./count-smaller.pl
8 1 2 2 3    => 4 0 1 1 3
6 5 4 8      => 2 1 0 3
2 2 2        => 0 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 December 3, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Spoiler Alert: This weekly challenge deadline is due in a bit more than a day from now (on November 19, 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: Floor Sum

You are given an array of positive integers (>=1).

Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division.

Example 1

Input: @nums = (2, 5, 9)
Output: 10

floor(2 / 5) = 0
floor(2 / 9) = 0
floor(5 / 9) = 0
floor(2 / 2) = 1
floor(5 / 5) = 1
floor(9 / 9) = 1
floor(5 / 2) = 2
floor(9 / 2) = 4
floor(9 / 5) = 1

Example 2

Input: @nums = (7, 7, 7, 7, 7, 7, 7)
Output: 49

Floor Sum in Raku

Here, I wish to use the combinations method to generate pairs from which to compute the divisions and their floor. However, combinations does not return any item combined with itself. Since the floor division of an item combined with itself will always yield 1, we will get for this specific case a total floor division count equal to the number of items in the input array. So we initialize $count with the number of items in the input array.

The other slight problem with the combinations method is that combinations don't care about the order of the items. The 2 5 and 5 2 combinations are deemed to be the same. Taking the first example provided in the task specification, (2, 5, 9), would output the following combinations: (2, 5), (2, 9), and (5, 9). We would miss the inverted pairs, (5, 2), (9, 2) and (9, 5). My solution below is to compute floor division both ways. In general, only one will yield a strictly positive item (the other one will be 0), except that this is not true when two items of the input array are equal, because they yield then twice 1.

sub floor-sum (@in) {
    my $count = @in.elems; 
    for @in.combinations: 2 -> @pair {
        $count +=  floor(@pair[0]/@pair[1]) 
               + floor(@pair[1]/@pair[0]);
    }
    return $count;
}

for <2 5 9>, <4 9 3 2>, <7 7 7 7 7 7 7> -> @test {
    printf "%-15s => ", "@test[]";
    say floor-sum @test;
}

This program displays the following output:

$ raku ./floor-sum.raku
2 5 9           => 10
4 9 3 2         => 17
7 7 7 7 7 7 7   => 49

Floor Sum in Perl

Since there is no core combinations function in Perl, we'll implement it with standard nested loops. With proper bounds for the loops, we will generate all the desired pairs and need not worry about the special cases found in Raku.

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

sub floor_sum {
    my @in = @_;
    my $end = $#in;
    my $count = 0;
    for my $i (0..$end) {
        for my $j (0..$end) {
            $count += int($in[$i] / $in[$j]) ;
        }
    }
    return $count;
}

for my $test ([<2 5 9>], [<4 9 3 2>], [<7 7 7 7 7 7 7>]) {
    printf "%-15s => ", "@$test";
    say floor_sum @$test;
}

This program displays the following output:

$ perl ./floor-sum.pl
2 5 9           => 10
4 9 3 2         => 17
7 7 7 7 7 7 7   => 49

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

These are some answers to the Week 243, 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 November 19, 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: Reverse Pairs

You are given an array of integers.

Write a script to return the number of reverse pairs in the given array.

A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].

Example 1

Input: @nums = (1, 3, 2, 3, 1)
Output: 2

(1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
(3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1

Example 2

Input: @nums = (2, 4, 3, 5, 1)
Output: 3

(1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
(2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
(3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1

Reverse Pairs in Raku

Although we could possibly use Raku built-in functions such as permutations and combinations, I found that using a doubly nested loop provides a better and finer control on the implementation of the specification of reverse pairs.

sub count-reverse-pairs (@in) {
    my $count = 0;
    for 0..^@in.end -> $i {
        for $i+1..@in.end -> $j {
            $count++ if @in[$i] > 2 * @in[$j];
        }
    }
    return $count;
}

for <1 3 2 3 1>, <2 4 3 5 1> -> @test {
    print "@test[] => ";
    say count-reverse-pairs @test;
}

This program displays the following output:

$ raku ./reverse-pairs.raku
1 3 2 3 1 => 2
2 4 3 5 1 => 3

Reverse Pairs in Perl

This is a port to Perl of the above Raku program.

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

sub count_reverse_pairs {
    my @in = @_;
    my $end = $#in;
    my $count = 0;
    for my $i (0..$end-1) {
        for my $j ($i..$end) {
            $count++ if $in[$i] > 2 * $in[$j];
        }
    }
    return $count;
}

for my $test ([qw<1 3 2 3 1>], [qw<2 4 3 5 1>]) {
    print "@$test => ";
    say count_reverse_pairs @$test;
}

This program displays the following output:

$ perl ./reverse-pairs.pl
1 3 2 3 1 => 2
2 4 3 5 1 => 3

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

These are some answers to the Week 242, 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 November 12, 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: Flip Matrix

You are given n x n binary matrix.

Write a script to flip the given matrix as below.

1 1 0
0 1 1
0 0 1

a) Reverse each row

0 1 1
1 1 0
1 0 0

b) Invert each member

1 0 0
0 0 1
0 1 1

Example 1

Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])
Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])

Example 2

Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])
Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])

Flip Matrix in Raku

The flip-matrix subroutine simply traverses the rows of the input matrix, reverses them and inverts each item of the row. It could easily be done in a single code line, but we kept two lines to better express the two steps of the process.

sub flip-matrix (@input) {
    my @in = @input;
    my @out;
    for @in -> @row {
        my @rev = @row.reverse;
        push @out, map { $_ eq '0' ?? 1 !! 0 }, @rev;
    }
    return @out;
}
for (<1 1 0>, <0 1 1>, <0 0 1>), 
    (<1 1 0>, <1 0 1>, <0 0 0>),
    (<1 1 0 0>, <1 0 0 1>, <0 1 1 1>, <1 0 1 0>)
    -> @test {
    say @test, " => ", flip-matrix @test;  
}

This program displays the following output:

$ raku ./flip-matrix.raku
((1 1 0) (0 1 1) (0 0 1)) => [(1 0 0) (0 0 1) (0 1 1)]
((1 1 0) (1 0 1) (0 0 0)) => [(1 0 0) (0 1 0) (1 1 1)]
((1 1 0 0) (1 0 0 1) (0 1 1 1) (1 0 1 0)) => [(1 1 0 0) (0 1 1 0)
    (0 0 0 1) (1 0 1 0)]

Flip Matrix in Perl

This is a port to Perl of the above Raku program. Again, the flip_matrix subroutine traverses the rows of the input matrix, reverses them and inverts each item of the row. It is slightly more complicated than the Raku version because it is a bit of a pain in the neck to display properly references to nested arrays. This is the reason for which we added a helper subroutine, stringify_matrix, to display both the input and the output matrices.

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

sub stringify_matrix {
    my @in = @_;
    my $out = "";
    $out .=  "(@$_) " for @in;
    return $out;
}

sub flip_matrix {
    my @in = @_;
    my @out;
    for my $row (@in) {
        my @rev = reverse @$row;
        push @out, [map { $_ eq '0' ? 1 : 0 } @rev];
    }
    return @out;
}
for my $test ([[<1 1 0>], [<0 1 1>], [<0 0 1>]], 
    [[<1 1 0>], [<1 0 1>], [<0 0 0>]],
    [[<1 1 0 0>], [<1 0 0 1>], [<0 1 1 1>], [<1 0 1 0>]]) {
    print stringify_matrix @$test; 
    say " => ", stringify_matrix flip_matrix @$test;  
}

This program displays the following output:

$ perl ./flip-matrix.pl
(1 1 0) (0 1 1) (0 0 1)  => (1 0 0) (0 0 1) (0 1 1)
(1 1 0) (1 0 1) (0 0 0)  => (1 0 0) (0 1 0) (1 1 1)
(1 1 0 0) (1 0 0 1) (0 1 1 1) (1 0 1 0)  => (1 1 0 0) (0 1 1 0) 
    (0 0 0 1) (1 0 1 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 November 19, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 242, 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 November 12, 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: Missing Members

You are given two arrays of integers.

Write a script to find out the missing members in each other arrays.

Example 1

Input: @arr1 = (1, 2, 3)
       @arr2 = (2, 4, 6)
Output: ([1, 3], [4, 6])

(1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
(2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).

Example 2

Input: @arr1 = (1, 2, 3, 3)
       @arr2 = (1, 1, 2, 2)
Output: ([3])

(1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since they are same, keep just one.
(1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).

Note that I consider the output of example 2 slightly wrong, as I believe it should be made clearer that we get an empty array. So, I think it should rather be something like ([3], []).

Missing Members in Raku

Here we use the set difference operator,infix%E2%88%96). Note that when its arguments are simple arrays or lists, they are implicitly converted to sets prior to the execution of the set difference operator. We don't need explicit conversion. This leads to a very simple one-line solution.

sub diff (@a, @b) {
    return map {.keys}, @a (-) @b, @b (-) @a;
}

for (<1 2 3>, < 2 4 6>), (<1 2 3 3>, <1 1 2 2>) -> @test {
    printf "%-8s - %-8s => ", "@test[0]", "@test[1]";
    say diff @test[0], @test[1];
}

This program displays the following output:

$ raku ./missing-members.raku
1 2 3    - 2 4 6    => ((3 1) (4 6))
1 2 3 3  - 1 1 2 2  => ((3) ())

Missing Members in Perl

The Perl solution is quite different. Since Perl has no sets (and therefore no set difference operator), we'll use hashes to find manually items that are in one array and not in the other one, leading so a significantly longer, but not really more complicated, solution. What makes to Perl solution slightly more complex is the need to pass around references to arrays, rather than simple arrays, to avoid the array flattening feature of Perl. We simplify sightly this by returning solutions as ready-to-be-printed stings, rather than Perl data structures.

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

sub diff {
    my ($aref, $bref) = @_;
    my %a = map {$_ => 1} @$aref;
    my %b = map {$_ => 1} @$bref;
    my $adif = [grep { not exists $b{$_} } keys %a];
    my $bdif = [grep { not exists $a{$_} } keys %b];
    return "(@$adif) (@$bdif)";
}

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

This program displays the following output:

$ perl ./missing-members.pl
1 2 3      - 2 4 6      => (1 3) (4 6)
1 2 3 3    - 1 1 2 2    => (3) ()

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